[Runtime] Fixes #99

[Runtime] Fixes #99

//
// Copyright (c) XSharp B.V.  All Rights Reserved.
// Licensed under the Apache License, Version 2.0.
// See License.txt in the project root for license information.
//

USING XSharp
USING System.Text
USING System.Globalization
USING System.Collections.Generic

#define MAXDIGITS               30
#define MAXDECIMALS             15

INTERNAL STATIC CLASS ConversionHelpers
	STATIC INTERNAL usCulture AS CultureInfo
	STATIC PRIVATE formatStrings AS Dictionary<INT, STRING>
	STATIC CONSTRUCTOR
		usCulture := CultureInfo{"en-US"}
		formatStrings := Dictionary<INT, STRING>{}

	STATIC METHOD GetFormatString(nLen AS INT, nDec AS INT) AS STRING
		LOCAL nKey AS INT
		LOCAL cFormat AS STRING
		nKey := nLen * 100 + nDec
		IF formatStrings:ContainsKey(nKey)
			RETURN formatStrings[nKey]
		ENDIF
		IF nDec != 0
			cFormat := "0."
			cFormat := cFormat:PadRight(nDec+2, c'0')	// 2 extra for the 0 + Dot
		ELSE
			cFormat := "0"
		ENDIF
		cFormat := cFormat:PadLeft(nLen, c'#')
		cFormat := "{0," + nLen:ToString()+":"+cFormat+"}"
		formatStrings:Add(nKey, cFormat)
		RETURN cFormat

	PRIVATE CONST NOCHAR := c'\0' AS CHAR
	STATIC METHOD NextChar(c AS STRING, nIndex REF INT) AS CHAR
		LOCAL cChar AS CHAR
		LOCAL lStart := nIndex == -1 AS LOGIC
		DO WHILE TRUE
			nIndex ++
			IF nIndex >= c:Length
				RETURN NOCHAR
			END IF
			cChar := c[nIndex]
			IF cChar == c'E'
				RETURN NOCHAR
			END IF
			IF cChar >= c'0' .AND. cChar <= c'9'
				IF cChar == c'0' .AND. lStart
					nIndex ++
					LOOP
				END IF
				RETURN cChar
			END IF
		END DO

	STATIC METHOD AdjustPrecision(cNum15 AS STRING, cNum17 AS STRING) AS STRING
		LOCAL cDiff15 := "0", cDiff17 := "0" AS STRING
		LOCAL cResult AS STRING
		LOCAL c15,c17 AS CHAR
		LOCAL n15,n17 AS INT
		LOCAL nMatch AS INT
		LOCAL lDiff  AS LOGIC
		n15 := n17 := -1
		nMatch := 0
		cResult := cNum15
		lDiff := FALSE
		DO WHILE TRUE
			c15 := NextChar(cNum15 , REF n15)
			c17 := NextChar(cNum17 , REF n17)
			IF c15 == NOCHAR .OR. c17 == NOCHAR
				IF lDiff
					EXIT
				ELSE
					RETURN cNum15
				END IF
			ELSEIF c15 == c17
				nMatch ++
			ELSE
				IF nMatch >= 14
					IF nMatch < 17
						lDiff := TRUE
						cResult := cResult:Substring(0, n15) + c17:ToString() + cResult:Substring(n15 + 1)
						nMatch ++
						cDiff15 += c15:ToString()
						cDiff17 += c17:ToString()
					ELSE
						EXIT
					END IF
				ELSE
					RETURN cNum15
				END IF
			END IF
		END DO

		// if the difference of the two numbers is the minimum one, then it was probably just a rounding issue in "G17" representation
		IF Math.Abs( Int32.Parse(cDiff15) - Int32.Parse(cDiff17) ) == 1
			RETURN cNum15
		END IF
	RETURN cResult

	STATIC METHOD FormatNumber(n AS REAL8, nLen AS INT, nDec AS INT) AS STRING
		LOCAL cFormat AS STRING
		LOCAL result AS STRING
		cFormat := GetFormatString(nLen, nDec)
        // G17 returns all 17 relevant digits for a REAL8
        // See https://docs.microsoft.com/en-us/dotnet/api/system.double.tostring?view=netframework-4.7.2
		result := String.Format(usCulture, cFormat, n)
		IF nLen > 15 .AND. result:Length >= 15
			result := AdjustPrecision(result, n:ToString("G17", usCulture))
		END IF
/*      IF result:EndsWith("0") .AND. nDec > 0 .AND. nLen > 15
            VAR cTemp := n:ToString("G17", usCulture)
            VAR parts := cTemp:Split(<CHAR>{c'.'}, StringSplitOptions.RemoveEmptyEntries)
            IF parts:Length > 1
                // If the G17 format contains a decimal part, fetch it.
                VAR cDec := parts[1+ __ARRAYBASE__]
                VAR cInt := parts[0+ __ARRAYBASE__]

				// could end up being represented in exp format. For example
				// Str3(70.00 - 65.01 - 4.99,16,2)
				// causes cTemp above to have a value of "-5.3290705182007514E-15"
	            LOCAL nExp AS INT
	            nExp := cDec:IndexOf('E')
	            IF nExp != -1
	            	IF cDec[nExp + 1] == '-'
	            		LOCAL cExp AS STRING
	            		cExp := System.String{'0', Int32.Parse(cDec:Substring(nExp + 2))}
	            		cDec := cExp + iif(cInt[0] == '-' , cInt:SubString(1) , cInt) + cDec
	            		cInt := iif(cInt[0] == '-' , "-0" , "0")
	            	END IF
	            END IF

                parts := result:Split(<CHAR>{c'.'}, StringSplitOptions.RemoveEmptyEntries)
                VAR cOldDec := parts[1+ __ARRAYBASE__]
                IF cDec:Length > cOldDec:Length
                    cDec := cDec:SubString(0, cOldDec:Length)
                ELSEIF cDec:Length < cOldDec:Length
                    cDec := cDec:PadRight(cOldDec:Length,c'0')
                ENDIF
                result := parts[0+ __ARRAYBASE__] + "." + cDec
            ENDIF
        ENDIF*/
		IF result:Length > nLen
			LOCAL nSepIndex AS INT
			nSepIndex := result:IndexOf(usCulture:NumberFormat:NumberDecimalSeparator)
			IF nSepIndex != -1 .AND. nSepIndex <= nLen
				result := result:Substring(0, nLen)
			ELSE
				result := Replicate("*", (DWORD) nLen)
			END IF
		ENDIF
		RETURN result

	STATIC METHOD FormatNumber(n AS INT64, nLen AS INT, nDec AS INT) AS STRING
		LOCAL cFormat AS STRING
		LOCAL result AS STRING
		cFormat := GetFormatString(nLen, 0)
		result := String.Format(usCulture, cFormat, n)
		IF result:Length > nLen
			result := Replicate("*", (DWORD) nLen)
		ENDIF
		RETURN result

	STATIC METHOD AdjustDecimalSeparator(cString AS STRING) AS STRING
		IF cString:IndexOf(".") >= 0
			VAR wSep   := SetDecimalSep()
			IF wSep != 46
				cString := cString:Replace(c'.', (CHAR) wSep)
			ENDIF
		ENDIF
		RETURN cString

	STATIC METHOD GetSignificantWholeDigits(r AS REAL8) AS INT
		LOCAL nRet := IIF(r < 0.0 , 1 , 0) AS INT
		r := Math.Floor(Math.Abs(r))
		DO WHILE r > 0.0
			nRet ++
			r := r /10.0
			r := Math.Floor(r)
		END DO
	RETURN nRet

END CLASS

	///
	/// Convert a value to a hexadecimal string.
	///
	/// <param name="uValue">A string or Numeric value.</param>
	/// <returns>A string with the hex representation of the value
	/// </returns>
FUNCTION AsHexString(uValue AS USUAL) AS STRING
	LOCAL result AS STRING
	IF uValue:IsString
		result := C2Hex( (STRING) uValue)
	ELSEIF uValue:IsNumeric
        IF uValue:IsInt64
		    result := String.Format("{0:X}", (INT64) uValue)
        ELSE
            result := String.Format("{0:X}", (INT) uValue)
        ENDIF
	ELSE
		result := ""
	ENDIF
	RETURN result

	///
	/// Convert a value to a right-padded string.
	///
	/// <param name="u">The value to be converted.</param>
	/// <param name="dwLen">The length of the padded string.</param>
	/// <returns>A right-padded string of length dwLen containing the converted value.
	/// </returns>
FUNCTION AsPadr(u AS USUAL,dwLen AS DWORD) AS STRING
	RETURN PadR(AsString(u), dwLen)

/// <exclude />
FUNCTION _AsString(u AS USUAL) AS STRING
	RETURN	 AsString(u)

///
/// Convert a value to a string.
///
/// <param name="u">The value to be converted.</param>
/// <returns>A string containing the converted value.  Please note that this is NOT the same as the .Net ToString(). AsString() tries to emulate the VO Behaviour as correctly as possible.
/// </returns>
FUNCTION AsString(u AS USUAL) AS STRING
	LOCAL result AS STRING
	DO CASE
		CASE u:IsString
			result := (STRING) u
		CASE u:IsNumeric
			result := NTrim(u)
		CASE u:IsSymbol
			result := Symbol2String( (SYMBOL) u)
		CASE u:IsDate
			result := DToC( (DATE) u)
		CASE u:IsArray
			VAR aValue := (ARRAY) u
			//  {[0000000003]0x025400FC}
			IF aValue == NULL_ARRAY
				result := "{[0000000000]0x00000000}"
			ELSE
				VAR cHashCode := String.Format("{0:X8}", aValue:GetHashCode())
				result := "{["+STRING.Format("{0:D10}",aValue:Length)+"]0x"+cHashCode+"}"
			ENDIF

		CASE u:IsObject
			LOCAL oValue := u AS OBJECT
			IF oValue == NULL_OBJECT
				result := "{(0x0000)0x00000000} CLASS "
			ELSE
				VAR oType := oValue:GetType()
				VAR nSize := oType:GetFields():Length *4
				VAR cHashCode := String.Format("{0:X8}", oValue:GetHashCode())
				result := "{(0x"+String.Format("{0:X4}", nSize)+")0x"+cHashCode+"} CLASS " + oType:Name:ToUpperInvariant()
			ENDIF
		OTHERWISE
			result := u:ToString()
	ENDCASE
	RETURN result

	///
	/// Convert a string or a Psz to a Symbol.
	///
	/// <param name="u">The Usual holding a string or Psz</param>
	/// <returns>
	/// The Symbol representing the given string or Psz.
	/// </returns>
FUNCTION AsSymbol(u AS USUAL) AS SYMBOL
	RETURN SYMBOL{(STRING)u, TRUE}

	///
	/// Create a descending order key value.
	///
	/// <param name="uValue"></param>
	/// <returns>
	/// </returns>
FUNCTION Descend(uValue AS USUAL) AS USUAL
	IF uValue:isString
		RETURN _descendingString( (STRING) uValue)
	ELSEIF uValue:IsLogic
		RETURN ! (LOGIC) uValue
	ELSEIF uValue:IsLong
		RETURN 0 - (INT) uValue
	ELSEIF uValue:IsInt64
		RETURN 0 - (INT64) uValue
	ELSEIF uValue:IsFloat
		RETURN 0 - (__Float) uValue
	ELSEIF uValue:IsDate
		RETURN 5231808 - (DWORD)(DATE) uValue
	ENDIF
	RETURN uValue

INTERNAL FUNCTION _descendingString(s AS STRING) AS STRING
	VAR sb  := StringBuilder{s}
	VAR nlen := s:Length-1
	LOCAL i AS INT
	FOR i := 0 TO nlen
		IF sb[i] < 256
			sb[i] := (CHAR) (255 - sb[i])
		ENDIF
	NEXT
	RETURN sb:ToString()

///
/// Create a descending order key value. The parameter is also changed
///
/// <param name="uValue"></param>
/// <returns>
/// </returns>
FUNCTION DescendA(uValue REF USUAL) AS USUAL
	uValue := Descend(uValue)
	RETURN uValue

///
/// Convert a numeric expression to a left-trimmed string.
///
/// <param name="n">A Usual with a numeric or date value</param>
/// <returns>
/// </returns>
FUNCTION NTrim(n AS USUAL) AS STRING
	LOCAL ret AS STRING
	SWITCH n:_UsualType
	CASE __usualType.Int64
	CASE __usualType.Long
      ret := ConversionHelpers.FormatNumber( (INT64) n, (INT) RuntimeState.Digits, 0):Trim()
	CASE __UsualType.Date
      ret := AsString( n )
    CASE __UsualType.Float
	CASE __UsualType.Decimal
      ret := ConversionHelpers.AdjustDecimalSeparator(_Str1(  (FLOAT) n )):Trim()
    OTHERWISE
      THROW Error.DataTypeError( __FUNCTION__, NAMEOF(n), 1, n)
   END SWITCH
   RETURN ret

/// Pad values with fill characters on the right.
/// <param name="uValue">Value to pad</param>
/// <param name="nLength">Length of result string. </param>
/// <param name="cPad">Pad character to use. Defaults to the space character.</param>
/// <returns>The string padded to the requested length. When the value is longer than the requested length
/// then the string will be truncated to that length.</returns>
FUNCTION Pad( uValue AS USUAL, nLength AS INT, cPad := " " AS STRING ) AS STRING
	RETURN PadR( uValue, nLength, cPad )

/// <inheritdoc cref="M:XSharp.RT.Functions.Pad(XSharp.__Usual,System.Int32,System.String)" />
FUNCTION Pad( uValue AS USUAL, nLength AS DWORD, cPad := " " AS STRING ) AS STRING
	RETURN PadR( uValue, (INT) nLength, cPad )

/// Pad values with fill characters on both the right and left.
/// <inheritdoc cref="M:XSharp.RT.Functions.Pad(XSharp.__Usual,System.Int32,System.String)" />
FUNCTION PadC( uValue AS USUAL, nLength AS INT, cPad := " " AS STRING ) AS STRING
	// If they send in an empty string then change to " "
	IF cPad == NULL .OR. cPad :Length == 0
		cPad := " "
	ENDIF

	LOCAL ret     AS STRING
	LOCAL retlen  AS INT

	IF uValue:isNumeric
		ret := NTrim( uValue)
	ELSE
		ret := uValue:ToString()
	ENDIF
	retlen := ret:Length

	IF retlen > nLength
		ret := ret:Remove( nLength )
	ELSE
		ret := ret:PadLeft( ( nLength - retlen ) / 2, cPad[0] ):PadRight( nLength, cPad[0] )
	ENDIF

	RETURN ret

/// Pad values with fill characters on both the right and left.
/// <inheritdoc cref="M:XSharp.RT.Functions.Pad(XSharp.__Usual,System.Int32,System.String)" />
FUNCTION PadC( uValue AS USUAL, nLength AS DWORD, cPad := " " AS STRING ) AS STRING
	RETURN PadC( uValue, (INT) nLength, cPad )

/// Pad values with fill characters on the left.
/// <inheritdoc cref="M:XSharp.RT.Functions.Pad(XSharp.__Usual,System.Int32,System.String)" />
FUNCTION PadL( uValue AS USUAL, nLength AS INT, cPad := " " AS STRING ) AS STRING
	// If they send in an empty string then change to " "
	IF cPad == NULL .OR. cPad :Length == 0
		cPad := " "
	ENDIF
	LOCAL ret AS STRING
	IF uValue:IsNumeric
		ret := NTrim( uValue)
	ELSE
		ret := uValue:ToString()
	ENDIF
	RETURN IIF( ret:Length > nLength, ret:Remove( nLength ), ret:PadLeft( nLength, cPad[0] ) )

/// Pad values with fill characters on the left.
/// <inheritdoc cref="M:XSharp.RT.Functions.Pad(XSharp.__Usual,System.Int32,System.String)" />
FUNCTION PadL( uValue AS USUAL, nLength AS DWORD, cPad := " " AS STRING ) AS STRING
	RETURN PadL( uValue, (INT) nLength, cPad )

/// <inheritdoc cref="M:XSharp.RT.Functions.Pad(XSharp.__Usual,System.Int32,System.String)" />
FUNCTION PadR( uValue AS USUAL, nLength AS DWORD, cPad := " " AS STRING ) AS STRING
	RETURN PadR( uValue, (INT) nLength, cPad )

/// <inheritdoc cref="M:XSharp.RT.Functions.Pad(XSharp.__Usual,System.Int32,System.String)" />
FUNCTION PadR( uValue AS USUAL, nLength AS INT, cPad := " " AS STRING ) AS STRING
	// If they send in an empty string then change to " "
	IF cPad == NULL .OR. cPad:Length == 0
		cPad := " "
	ENDIF
	LOCAL ret AS STRING
	IF uValue:IsNumeric
		ret := NTrim( uValue)
	ELSE
		ret := uValue:ToString()
	ENDIF
	RETURN IIF( ret:Length > nLength, ret:Remove( nLength ), ret:PadRight( nLength, cPad[0] ) )

///
/// Convert a numeric expression to a string.
///
/// <param name="n"></param>
/// <param name="uLen"></param>
/// <param name="uDec"></param>
/// <returns>The string with always a decimal separator that matches the current SetDecimalSep() setting.</returns>
FUNCTION Str(n ,uLen ,uDec ) AS STRING CLIPPER
	IF PCount() < 1 .OR. pCount() > 3
		RETURN ""
	ENDIF
	LOCAL result AS STRING
	LOCAL nLen AS DWORD
    LOCAL nDec AS DWORD
    LOCAL lTrimSpaces := FALSE AS LOGIC
	IF uLen:IsNumeric
        IF uLen < 0
	        nLen := System.UInt32.MaxValue
	        lTrimSpaces := TRUE
        ELSE
            nLen := (DWORD) uLen
        ENDIF
	ELSE
		nLen := System.UInt32.MaxValue
    ENDIF
    IF ! uDec:IsNumeric
        nDec := UInt32.MaxValue
    ELSE
        IF uDec < 0
		    nDec := System.UInt32.MaxValue
        ELSE
            nDec := (DWORD) uDec
        ENDIF
    ENDIF
	result := _Str3(n, nLen, nDec)
	IF lTrimSpaces
		result := result:TrimStart()
	END IF
	RETURN ConversionHelpers.AdjustDecimalSeparator(result)

///
/// Convert a numeric expression to a string.
///
/// <param name="nValue"></param>
/// <param name="uLength"></param>
/// <param name="uDec"></param>
/// <returns>The string with always a DOT as decimal separator.</returns>

FUNCTION _Str(nValue ,uLen ,uDec ) AS STRING CLIPPER
    LOCAL nLen,  nDec AS LONG
    LOCAL dwLen, dwDec AS DWORD
	IF PCount() > 0 .AND. ! nValue:IsNumeric
       THROW Error.DataTypeError( __FUNCTION__, NAMEOF(nValue),1, nValue, uLen, uDec)
    ENDIF
	SWITCH PCount()
	CASE 1
		RETURN _Str1( nValue)
	CASE 2
		IF ! uLen:IsNumeric
			THROW Error.DataTypeError( __FUNCTION__, NAMEOF(uLen),2,nValue, uLen, uDec)
        ENDIF
        nLen := uLen
        IF nLen < 0
            dwLen := System.UInt32.MaxValue
        ELSE
            dwLen := (DWORD) nLen
        ENDIF
		IF nValue:IsFloat
			RETURN _Str2(nValue, dwLen)
		ELSE
			RETURN ConversionHelpers.FormatNumber((INT64) nValue, nLen,0)
		ENDIF
	CASE 3
		IF ! uLen:IsNumeric
			THROW Error.DataTypeError( __FUNCTION__, NAMEOF(uLen),2,nValue, uLen, uDec)
		ENDIF
		IF ! uDec:IsNumeric
			THROW Error.DataTypeError( __FUNCTION__, NAMEOF(uDec),3,nValue, uLen, uDec)
        ENDIF
        nLen := uLen
        nDec := uDec
 		IF nValue:IsFLoat
            nLen := uLen
            IF nLen < 0
                dwLen := System.UInt32.MaxValue
            ELSE
                dwLen := (DWORD) nLen
            ENDIF

            IF nDec < 0 .OR. RuntimeState.Fixed
                dwDec := XSharp.RuntimeState.Decimals
            ELSE
                dwDec := (DWORD) nDec
            ENDIF
            IF nLen < 0 .OR. RuntimeState.DigitsFixed
                dwLen := XSharp.RuntimeState.Digits
                IF nDec != 0
                    dwLen := dwLen + dwDec + 1
                ENDIF
            ENDIF
            VAR res := _Str3(nValue, dwLen, dwDec)
            IF nLen < 0
                res := res:TrimStart()
            ENDIF
            RETURN res
        ELSE
            IF nLen < 0
                nLen := 30
            ENDIF
            IF nDec < 0
                nDec := (INT) SetDecimal()
            ENDIF
			RETURN ConversionHelpers.FormatNumber((INT64) nValue, nLen,nDec)
		ENDIF
	OTHERWISE
		RETURN ""
	END SWITCH

// The following three functions are undocumented in Vulcan but sometimes used in user code
// They are the equivalent of the STR() functions but always return with digit decimal separator
// We route all three to the _Str() function that takes care of this already
/// <exclude/>
FUNCTION __Str(n AS USUAL) AS STRING
	RETURN _Str( n)

/// <exclude/>
FUNCTION __Str(n AS USUAL,nLen AS USUAL) AS STRING
	RETURN _Str( n, nLen)

/// <exclude/>
FUNCTION __Str(n AS USUAL,nLen AS USUAL, nDec AS USUAL) AS STRING
	RETURN _Str( n, nLen, nDec)

INTERNAL FUNCTION _PadZero(cValue AS STRING) AS STRING
	LOCAL iLen := 	cValue:Length AS INT
	RETURN cValue:TrimStart():PadLeft((INT) iLen, c'0')

	///
	/// Convert a numeric expression to a string and pad it with leading zeroes instead of blanks.
	///
	/// <param name="n"></param>
	/// <param name="iLen"></param>
	/// <param name="iDec"></param>
	/// <returns>
	/// </returns>
FUNCTION StrZero(n AS USUAL,iLen AS INT,iDec AS INT) AS STRING
	IF ! ( n:IsNumeric )
      THROW Error.DataTypeError( __FUNCTION__, NAMEOF(n),1,n, iLen, iDec)
    ENDIF
	LOCAL cValue := Str3(n, (DWORD) iLen, (DWORD) iDec) AS STRING
	RETURN _PadZero(cValue)

///
/// Convert a numeric expression to a string and pad it with leading zeroes instead of blanks.
///
/// <param name="n"></param>
/// <param name="iLen"></param>
/// <returns>
/// </returns>
FUNCTION StrZero(n AS USUAL,iLen AS INT) AS STRING
	IF ! ( n:IsNumeric )
      THROW Error.DataTypeError( __FUNCTION__, NAMEOF(n),1,n, iLen)
	ENDIF
	LOCAL cValue := Str2(n, (DWORD) iLen) AS STRING
	RETURN _padZero(cValue)

///
/// Convert a numeric expression to a string and pad it with leading zeroes instead of blanks.
///
/// <param name="n"></param>
/// <returns>
/// </returns>
FUNCTION StrZero(n AS USUAL) AS STRING
	IF ! ( n:IsNumeric )
      THROW Error.DataTypeError( __FUNCTION__, NAMEOF(n),1,n)
    ENDIF
	LOCAL cValue := Str1(n) AS STRING
	RETURN _PadZero(cValue)

	///
	/// Convert a number to a dword.
	///
	/// <param name="n"></param>
	/// <returns>
	/// </returns>
FUNCTION ToWord(n AS USUAL) AS DWORD
	RETURN (DWORD) n

/// <inheritdoc cref="M:XSharp.RT.Functions.StrLong(System.Int32,System.UInt32,System.UInt32)" />
FUNCTION StrInt(l AS LONG,dwLen AS DWORD,dwDec AS DWORD) AS STRING
	RETURN Str3( l, dwLen, dwDec)

/// <inheritdoc cref="M:XSharp.RT.Functions.Str3(XSharp.__Float,System.UInt32,System.UInt32)" />
/// <param name="l">Number to format.</param>
FUNCTION StrLong(l AS LONG,dwLen AS DWORD,dwDec AS DWORD) AS STRING
	RETURN StrInt(l, dwLen, dwDec)

/// <inheritdoc cref="M:XSharp.RT.Functions.Str3(XSharp.__Float,System.UInt32,System.UInt32)" />
FUNCTION StrFloat(f AS FLOAT,dwLen AS DWORD,dwDec AS DWORD) AS STRING
	RETURN Str3( f, dwLen, dwDec )

///
/// Convert a numeric expression to a string with an optional decimal separator based on the settings in the runtime state.
///
/// <param name="f"></param>
/// <returns>
/// </returns>
FUNCTION Str1(f AS USUAL) AS STRING
	IF f:IsFloat
		RETURN ConversionHelpers.AdjustDecimalSeparator(_Str1( (FLOAT) f))
	ELSE
		RETURN ConversionHelpers.FormatNumber( (LONG) f, (INT) RuntimeState.Digits, 0):Trim()
	ENDIF

INTERNAL FUNCTION _Str1(f AS FLOAT) AS STRING
	VAR nDecimals := f:decimals
	VAR nDigits   := f:Digits

	SWITCH (Double)f
	CASE Double.NaN
		RETURN Double.NaN:ToString()
	CASE Double.PositiveInfinity
		RETURN Double.PositiveInfinity:ToString()
	CASE Double.NegativeInfinity
		RETURN Double.NegativeInfinity:ToString()
	END SWITCH

	IF nDecimals < 0 .OR. RuntimeState.Fixed
		nDecimals := (SHORT) RuntimeState.Decimals
	ENDIF
	IF nDigits <= 0 .OR. RuntimeState.DigitsFixed
		nDigits := (SHORT) RuntimeState.Digits
    	IF ConversionHelpers.GetSignificantWholeDigits(f) > nDigits
    		RETURN STRING{ c'*', (INT) nDigits}
    	END IF
        IF nDecimals != 0
            nDigits += nDecimals +1
        ENDIF
	ENDIF
	VAR result := ConversionHelpers.FormatNumber(f, nDigits, nDecimals )
	RETURN result

///
/// Convert a numeric expression to a string of a specified length.
///
/// <param name="f"></param>
/// <param name="dwLen"></param>
/// <returns>
/// </returns>
FUNCTION Str2(f AS FLOAT,dwLen AS DWORD) AS STRING
	RETURN ConversionHelpers.AdjustDecimalSeparator(_Str2(f, dwLen))

INTERNAL FUNCTION _Str2(f AS FLOAT,dwLen AS DWORD) AS STRING
  IF dwLen == 0 .OR. RuntimeState.DigitsFixed
      dwLen := (DWORD) RuntimeState.Digits
   ELSEIF dwLen  != UInt32.MaxValue
      dwLen := Math.Min( dwLen, MAXDIGITS )
   ENDIF
   VAR nDecimals := f:decimals
	IF nDecimals < 0 .OR. RuntimeState.DigitsFixed
		nDecimals := (SHORT) RuntimeState.Decimals
	ENDIF
   RETURN ConversionHelpers.FormatNumber(f, (INT) dwLen, nDecimals)

///
/// Convert a numeric expression to a string of specific length and decimal places
///
/// <param name="f">Number to format</param>
/// <param name="dwLen">Total length of result string.</param>
/// <param name="dwDec">Number of decimals.</param>
/// <returns>A string with decimal separator based on the runtime state.</returns>
FUNCTION Str3(f AS FLOAT,dwLen AS DWORD,dwDec AS DWORD) AS STRING
	RETURN ConversionHelpers.AdjustDecimalSeparator(_Str3(f, dwLen, dwDec))

/// <inheritdoc cref="M:XSharp.RT.Functions.Str3(XSharp.__Float,System.UInt32,System.UInt32)" />
/// <returns>A string with DOT as decimal separator.</returns>
FUNCTION _Str3(f AS FLOAT,dwLen AS DWORD,dwDec AS DWORD) AS STRING

   IF dwDec == UInt32.MaxValue
        IF RuntimeState.Fixed
            dwDec := (DWORD) RuntimeState.Decimals
        ELSE
            dwDec := (DWORD) f:Decimals
        ENDIF
   ELSE
      dwDec := Math.Min( dwDec, MAXDECIMALS )
   ENDIF

   IF dwLen == 0 .OR. dwLen == UInt32.MaxValue
        IF dwDec > 0
        	IF ConversionHelpers.GetSignificantWholeDigits(f) > RuntimeState.Digits
        		RETURN STRING{ c'*', (INT) (RuntimeState.Digits + dwDec +1) } // VO's behavior...
        	END IF
            dwLen := (DWORD) RuntimeState.Digits + dwDec +1
        ELSE
            dwLen := (DWORD) RuntimeState.Digits
        ENDIF
   ELSE
      dwLen := Math.Min( dwLen, MAXDIGITS )
   ENDIF

   IF dwDec > 0 .AND. dwLen != UInt32.MaxValue .AND. ( dwLen < ( dwDec + 2 ) )
      RETURN STRING{ c'*', (INT) dwLen }
   ENDIF
   RETURN ConversionHelpers.FormatNumber(f, (INT) dwLen, (INT) dwDec)

/// <inheritdoc cref="M:XSharp.RT.Functions.Val(System.String)" />
/// <returns>The numeric value as a FLOAT.</returns>
FUNCTION StrToFloat(c AS STRING) AS FLOAT
    RETURN (FLOAT) Val(c)

///
/// Convert a string containing a numeric value to a numeric data type.
///
/// <param name="cNumber">Number to convert. This may contain decimal separator, Hex notation, U or L suffix or Exponential notation.</param>
/// <returns>The numeric value as a USUAL.This may be a FLOAT, a LONG or an INT64.</returns>
FUNCTION Val(cNumber AS STRING) AS USUAL
	RETURN _Val(AllTrim(cNumber))

///
/// Convert an object containing a numeric value to a FLOAT
///
/// <param name="oValue">Object containing the numeric value to convert.</param>
/// <returns>The value in the form of a float. </returns>
/// <exception cref='T:System.InvalidCastException'> Thrown when the parameter oValue cannot be converted to a FLOAT.</exception>
FUNCTION Object2Float(oValue AS OBJECT) AS FLOAT
    LOCAL typ := oValue:GetType() AS System.Type
    IF typ == typeof(FLOAT)
        RETURN (FLOAT) oValue
    ENDIF
    LOCAL tc := System.Type.GetTypeCode(typ) AS TypeCode
    SWITCH tc
    CASE System.TypeCode.SByte
        RETURN (System.SByte) oValue
    CASE System.TypeCode.Byte
        RETURN (System.Byte) oValue
    CASE System.TypeCode.Double
        RETURN (System.Double) oValue
    CASE System.TypeCode.Single
        RETURN (System.Single) oValue
    CASE System.TypeCode.UInt16
        RETURN (System.UInt16) oValue
    CASE System.TypeCode.UInt32
        RETURN (System.UInt32) oValue
    CASE System.TypeCode.UInt64
        RETURN (System.UInt64) oValue
    CASE System.TypeCode.Int16
        RETURN (System.Int16) oValue
    CASE System.TypeCode.Int32
        RETURN (System.Int32) oValue
    CASE System.TypeCode.Int64
        RETURN (System.Int64) oValue
    CASE System.TypeCode.Decimal
        RETURN (System.Decimal) oValue
    OTHERWISE
        THROW InvalidCastException{"Cannot convert from type "+typ:FullName+" to FLOAT"}
    END SWITCH

FUNCTION Bin2F(c AS STRING) AS FLOAT
    LOCAL nDec AS WORD
    LOCAL val  AS REAL8
	IF SLen(c) >= 12
        nDec := Bin2W(SubStr3(c, 11,2))
        val  := Bin2Real8(SubStr3(c, 1,8))
        RETURN FLOAT{val, 0, nDec}
    ENDIF
	RETURN 0.0

FUNCTION F2Bin(f AS FLOAT) AS STRING
    RETURN Real82Bin(f:Value)+ e"\0\0" + W2Bin((WORD)f:Decimals)

//
// Copyright (c) XSharp B.V.  All Rights Reserved.
// Licensed under the Apache License, Version 2.0.
// See License.txt in the project root for license information.
//

USING XSharp
USING System.Text
USING System.Globalization
USING System.Collections.Generic

#define MAXDIGITS               30
#define MAXDECIMALS             15

INTERNAL STATIC CLASS ConversionHelpers
	STATIC INTERNAL usCulture AS CultureInfo
	STATIC PRIVATE formatStrings AS Dictionary<INT, STRING>
	STATIC CONSTRUCTOR
		usCulture := CultureInfo{"en-US"}
		formatStrings := Dictionary<INT, STRING>{}

	STATIC METHOD GetFormatString(nLen AS INT, nDec AS INT) AS STRING
		LOCAL nKey AS INT
		LOCAL cFormat AS STRING
		nKey := nLen * 100 + nDec
		IF formatStrings:ContainsKey(nKey)
			RETURN formatStrings[nKey]
		ENDIF
		IF nDec != 0
			cFormat := "0."
			cFormat := cFormat:PadRight(nDec+2, c'0')	// 2 extra for the 0 + Dot
		ELSE
			cFormat := "0"
		ENDIF
		cFormat := cFormat:PadLeft(nLen, c'#')
		cFormat := "{0," + nLen:ToString()+":"+cFormat+"}"
		formatStrings:Add(nKey, cFormat)
		RETURN cFormat

	PRIVATE CONST NOCHAR := c'\0' AS CHAR
	STATIC METHOD NextChar(c AS STRING, nIndex REF INT) AS CHAR
		LOCAL cChar AS CHAR
		LOCAL lStart := nIndex == -1 AS LOGIC
		DO WHILE TRUE
			nIndex ++
			IF nIndex >= c:Length
				RETURN NOCHAR
			END IF
			cChar := c[nIndex]
			IF cChar == c'E'
				RETURN NOCHAR
			END IF
			IF cChar >= c'0' .AND. cChar <= c'9'
				IF cChar == c'0' .AND. lStart
					nIndex ++
					LOOP
				END IF
				RETURN cChar
			END IF
		END DO

	STATIC METHOD AdjustPrecision(cNum15 AS STRING, cNum17 AS STRING) AS STRING
		LOCAL cDiff15 := "0", cDiff17 := "0" AS STRING
		LOCAL cResult AS STRING
		LOCAL c15,c17 AS CHAR
		LOCAL n15,n17 AS INT
		LOCAL nMatch AS INT
		LOCAL lDiff  AS LOGIC
		n15 := n17 := -1
		nMatch := 0
		cResult := cNum15
		lDiff := FALSE
		DO WHILE TRUE
			c15 := NextChar(cNum15 , REF n15)
			c17 := NextChar(cNum17 , REF n17)
			IF c15 == NOCHAR .OR. c17 == NOCHAR
				IF lDiff
					EXIT
				ELSE
					RETURN cNum15
				END IF
			ELSEIF c15 == c17
				nMatch ++
			ELSE
				IF nMatch >= 14
					IF nMatch < 17
						lDiff := TRUE
						cResult := cResult:Substring(0, n15) + c17:ToString() + cResult:Substring(n15 + 1)
						nMatch ++
						cDiff15 += c15:ToString()
						cDiff17 += c17:ToString()
					ELSE
						EXIT
					END IF
				ELSE
					RETURN cNum15
				END IF
			END IF
		END DO

		// if the difference of the two numbers is the minimum one, then it was probably just a rounding issue in "G17" representation
		IF Math.Abs( Int32.Parse(cDiff15) - Int32.Parse(cDiff17) ) == 1
			RETURN cNum15
		END IF
	RETURN cResult

	STATIC METHOD FormatNumber(n AS REAL8, nLen AS INT, nDec AS INT) AS STRING
		LOCAL cFormat AS STRING
		LOCAL result AS STRING
		cFormat := GetFormatString(nLen, nDec)
        // G17 returns all 17 relevant digits for a REAL8
        // See https://docs.microsoft.com/en-us/dotnet/api/system.double.tostring?view=netframework-4.7.2
		result := String.Format(usCulture, cFormat, n)
		IF nLen > 15 .AND. result:Length >= 15
			result := AdjustPrecision(result, n:ToString("G17", usCulture))
		END IF
/*      IF result:EndsWith("0") .AND. nDec > 0 .AND. nLen > 15
            VAR cTemp := n:ToString("G17", usCulture)
            VAR parts := cTemp:Split(<CHAR>{c'.'}, StringSplitOptions.RemoveEmptyEntries)
            IF parts:Length > 1
                // If the G17 format contains a decimal part, fetch it.
                VAR cDec := parts[1+ __ARRAYBASE__]
                VAR cInt := parts[0+ __ARRAYBASE__]

				// could end up being represented in exp format. For example
				// Str3(70.00 - 65.01 - 4.99,16,2)
				// causes cTemp above to have a value of "-5.3290705182007514E-15"
	            LOCAL nExp AS INT
	            nExp := cDec:IndexOf('E')
	            IF nExp != -1
	            	IF cDec[nExp + 1] == '-'
	            		LOCAL cExp AS STRING
	            		cExp := System.String{'0', Int32.Parse(cDec:Substring(nExp + 2))}
	            		cDec := cExp + iif(cInt[0] == '-' , cInt:SubString(1) , cInt) + cDec
	            		cInt := iif(cInt[0] == '-' , "-0" , "0")
	            	END IF
	            END IF

                parts := result:Split(<CHAR>{c'.'}, StringSplitOptions.RemoveEmptyEntries)
                VAR cOldDec := parts[1+ __ARRAYBASE__]
                IF cDec:Length > cOldDec:Length
                    cDec := cDec:SubString(0, cOldDec:Length)
                ELSEIF cDec:Length < cOldDec:Length
                    cDec := cDec:PadRight(cOldDec:Length,c'0')
                ENDIF
                result := parts[0+ __ARRAYBASE__] + "." + cDec
            ENDIF
        ENDIF*/
		IF result:Length > nLen
			LOCAL nSepIndex AS INT
			nSepIndex := result:IndexOf(usCulture:NumberFormat:NumberDecimalSeparator)
			IF nSepIndex != -1 .AND. nSepIndex <= nLen
				result := result:Substring(0, nLen)
			ELSE
				result := Replicate("*", (DWORD) nLen)
			END IF
		ENDIF
		RETURN result

	STATIC METHOD FormatNumber(n AS INT64, nLen AS INT, nDec AS INT) AS STRING
		LOCAL cFormat AS STRING
		LOCAL result AS STRING
		cFormat := GetFormatString(nLen, 0)
		result := String.Format(usCulture, cFormat, n)
		IF result:Length > nLen
			result := Replicate("*", (DWORD) nLen)
		ENDIF
		RETURN result

	STATIC METHOD AdjustDecimalSeparator(cString AS STRING) AS STRING
		IF cString:IndexOf(".") >= 0
			VAR wSep   := SetDecimalSep()
			IF wSep != 46
				cString := cString:Replace(c'.', (CHAR) wSep)
			ENDIF
		ENDIF
		RETURN cString

	STATIC METHOD GetSignificantWholeDigits(r AS REAL8) AS INT
		LOCAL nRet := IIF(r < 0.0 , 1 , 0) AS INT
		r := Math.Floor(Math.Abs(r))
		DO WHILE r > 0.0
			nRet ++
			r := r /10.0
			r := Math.Floor(r)
		END DO
	RETURN nRet

END CLASS

	///
	/// Convert a value to a hexadecimal string.
	///
	/// <param name="uValue">A string or Numeric value.</param>
	/// <returns>A string with the hex representation of the value
	/// </returns>
FUNCTION AsHexString(uValue AS USUAL) AS STRING
	LOCAL result AS STRING
	IF uValue:IsString
		result := C2Hex( (STRING) uValue)
	ELSEIF uValue:IsNumeric
		result := String.Format("{0:X8}", (INT64) uValue)
	ELSE
		result := ""
	ENDIF
	RETURN result

	///
	/// Convert a value to a right-padded string.
	///
	/// <param name="u">The value to be converted.</param>
	/// <param name="dwLen">The length of the padded string.</param>
	/// <returns>A right-padded string of length dwLen containing the converted value.
	/// </returns>
FUNCTION AsPadr(u AS USUAL,dwLen AS DWORD) AS STRING
	RETURN PadR(AsString(u), dwLen)

/// <exclude />
FUNCTION _AsString(u AS USUAL) AS STRING
	RETURN	 AsString(u)

///
/// Convert a value to a string.
///
/// <param name="u">The value to be converted.</param>
/// <returns>A string containing the converted value.  Please note that this is NOT the same as the .Net ToString(). AsString() tries to emulate the VO Behaviour as correctly as possible.
/// </returns>
FUNCTION AsString(u AS USUAL) AS STRING
	LOCAL result AS STRING
	DO CASE
		CASE u:IsString
			result := (STRING) u
		CASE u:IsNumeric
			result := NTrim(u)
		CASE u:IsSymbol
			result := Symbol2String( (SYMBOL) u)
		CASE u:IsDate
			result := DToC( (DATE) u)
		CASE u:IsArray
			VAR aValue := (ARRAY) u
			//  {[0000000003]0x025400FC}
			IF aValue == NULL_ARRAY
				result := "{[0000000000]0x00000000}"
			ELSE
				VAR cHashCode := String.Format("{0:X8}", aValue:GetHashCode())
				result := "{["+STRING.Format("{0:D10}",aValue:Length)+"]0x"+cHashCode+"}"
			ENDIF

		CASE u:IsObject
			LOCAL oValue := u AS OBJECT
			IF oValue == NULL_OBJECT
				result := "{(0x0000)0x00000000} CLASS "
			ELSE
				VAR oType := oValue:GetType()
				VAR nSize := oType:GetFields():Length *4
				VAR cHashCode := String.Format("{0:X8}", oValue:GetHashCode())
				result := "{(0x"+String.Format("{0:X4}", nSize)+")0x"+cHashCode+"} CLASS " + oType:Name:ToUpperInvariant()
			ENDIF
		OTHERWISE
			result := u:ToString()
	ENDCASE
	RETURN result

	///
	/// Convert a string or a Psz to a Symbol.
	///
	/// <param name="u">The Usual holding a string or Psz</param>
	/// <returns>
	/// The Symbol representing the given string or Psz.
	/// </returns>
FUNCTION AsSymbol(u AS USUAL) AS SYMBOL
	RETURN SYMBOL{(STRING)u, TRUE}

	///
	/// Create a descending order key value.
	///
	/// <param name="uValue"></param>
	/// <returns>
	/// </returns>
FUNCTION Descend(uValue AS USUAL) AS USUAL
	IF uValue:isString
		RETURN _descendingString( (STRING) uValue)
	ELSEIF uValue:IsLogic
		RETURN ! (LOGIC) uValue
	ELSEIF uValue:IsLong
		RETURN 0 - (INT) uValue
	ELSEIF uValue:IsInt64
		RETURN 0 - (INT64) uValue
	ELSEIF uValue:IsFloat
		RETURN 0 - (__Float) uValue
	ELSEIF uValue:IsDate
		RETURN 5231808 - (DWORD)(DATE) uValue
	ENDIF
	RETURN uValue

INTERNAL FUNCTION _descendingString(s AS STRING) AS STRING
	VAR sb  := StringBuilder{s}
	VAR nlen := s:Length-1
	LOCAL i AS INT
	FOR i := 0 TO nlen
		IF sb[i] < 256
			sb[i] := (CHAR) (255 - sb[i])
		ENDIF
	NEXT
	RETURN sb:ToString()

///
/// Create a descending order key value. The parameter is also changed
///
/// <param name="uValue"></param>
/// <returns>
/// </returns>
FUNCTION DescendA(uValue REF USUAL) AS USUAL
	uValue := Descend(uValue)
	RETURN uValue

///
/// Convert a numeric expression to a left-trimmed string.
///
/// <param name="n">A Usual with a numeric or date value</param>
/// <returns>
/// </returns>
FUNCTION NTrim(n AS USUAL) AS STRING
	LOCAL ret AS STRING
	SWITCH n:_UsualType
	CASE __usualType.Int64
	CASE __usualType.Long
      ret := ConversionHelpers.FormatNumber( (INT64) n, (INT) RuntimeState.Digits, 0):Trim()
	CASE __UsualType.Date
      ret := AsString( n )
    CASE __UsualType.Float
	CASE __UsualType.Decimal
      ret := ConversionHelpers.AdjustDecimalSeparator(_Str1(  (FLOAT) n )):Trim()
    OTHERWISE
      THROW Error.DataTypeError( __FUNCTION__, NAMEOF(n), 1, n)
   END SWITCH
   RETURN ret

/// Pad values with fill characters on the right.
/// <param name="uValue">Value to pad</param>
/// <param name="nLength">Length of result string. </param>
/// <param name="cPad">Pad character to use. Defaults to the space character.</param>
/// <returns>The string padded to the requested length. When the value is longer than the requested length
/// then the string will be truncated to that length.</returns>
FUNCTION Pad( uValue AS USUAL, nLength AS INT, cPad := " " AS STRING ) AS STRING
	RETURN PadR( uValue, nLength, cPad )

/// <inheritdoc cref="M:XSharp.RT.Functions.Pad(XSharp.__Usual,System.Int32,System.String)" />
FUNCTION Pad( uValue AS USUAL, nLength AS DWORD, cPad := " " AS STRING ) AS STRING
	RETURN PadR( uValue, (INT) nLength, cPad )

/// Pad values with fill characters on both the right and left.
/// <inheritdoc cref="M:XSharp.RT.Functions.Pad(XSharp.__Usual,System.Int32,System.String)" />
FUNCTION PadC( uValue AS USUAL, nLength AS INT, cPad := " " AS STRING ) AS STRING
	// If they send in an empty string then change to " "
	IF cPad == NULL .OR. cPad :Length == 0
		cPad := " "
	ENDIF

	LOCAL ret     AS STRING
	LOCAL retlen  AS INT

	IF uValue:isNumeric
		ret := NTrim( uValue)
	ELSE
		ret := uValue:ToString()
	ENDIF
	retlen := ret:Length

	IF retlen > nLength
		ret := ret:Remove( nLength )
	ELSE
		ret := ret:PadLeft( ( nLength - retlen ) / 2, cPad[0] ):PadRight( nLength, cPad[0] )
	ENDIF

	RETURN ret

/// Pad values with fill characters on both the right and left.
/// <inheritdoc cref="M:XSharp.RT.Functions.Pad(XSharp.__Usual,System.Int32,System.String)" />
FUNCTION PadC( uValue AS USUAL, nLength AS DWORD, cPad := " " AS STRING ) AS STRING
	RETURN PadC( uValue, (INT) nLength, cPad )

/// Pad values with fill characters on the left.
/// <inheritdoc cref="M:XSharp.RT.Functions.Pad(XSharp.__Usual,System.Int32,System.String)" />
FUNCTION PadL( uValue AS USUAL, nLength AS INT, cPad := " " AS STRING ) AS STRING
	// If they send in an empty string then change to " "
	IF cPad == NULL .OR. cPad :Length == 0
		cPad := " "
	ENDIF
	LOCAL ret AS STRING
	IF uValue:IsNumeric
		ret := NTrim( uValue)
	ELSE
		ret := uValue:ToString()
	ENDIF
	RETURN IIF( ret:Length > nLength, ret:Remove( nLength ), ret:PadLeft( nLength, cPad[0] ) )

/// Pad values with fill characters on the left.
/// <inheritdoc cref="M:XSharp.RT.Functions.Pad(XSharp.__Usual,System.Int32,System.String)" />
FUNCTION PadL( uValue AS USUAL, nLength AS DWORD, cPad := " " AS STRING ) AS STRING
	RETURN PadL( uValue, (INT) nLength, cPad )

/// <inheritdoc cref="M:XSharp.RT.Functions.Pad(XSharp.__Usual,System.Int32,System.String)" />
FUNCTION PadR( uValue AS USUAL, nLength AS DWORD, cPad := " " AS STRING ) AS STRING
	RETURN PadR( uValue, (INT) nLength, cPad )

/// <inheritdoc cref="M:XSharp.RT.Functions.Pad(XSharp.__Usual,System.Int32,System.String)" />
FUNCTION PadR( uValue AS USUAL, nLength AS INT, cPad := " " AS STRING ) AS STRING
	// If they send in an empty string then change to " "
	IF cPad == NULL .OR. cPad:Length == 0
		cPad := " "
	ENDIF
	LOCAL ret AS STRING
	IF uValue:IsNumeric
		ret := NTrim( uValue)
	ELSE
		ret := uValue:ToString()
	ENDIF
	RETURN IIF( ret:Length > nLength, ret:Remove( nLength ), ret:PadRight( nLength, cPad[0] ) )

///
/// Convert a numeric expression to a string.
///
/// <param name="n"></param>
/// <param name="uLen"></param>
/// <param name="uDec"></param>
/// <returns>The string with always a decimal separator that matches the current SetDecimalSep() setting.</returns>
FUNCTION Str(n ,uLen ,uDec ) AS STRING CLIPPER
	IF PCount() < 1 .OR. pCount() > 3
		RETURN ""
	ENDIF
	LOCAL result AS STRING
	LOCAL nLen AS DWORD
    LOCAL nDec AS DWORD
    LOCAL lTrimSpaces := FALSE AS LOGIC
	IF uLen:IsNumeric
        IF uLen < 0
	        nLen := System.UInt32.MaxValue
	        lTrimSpaces := TRUE
        ELSE
            nLen := (DWORD) uLen
        ENDIF
	ELSE
		nLen := System.UInt32.MaxValue
    ENDIF
    IF ! uDec:IsNumeric
        nDec := UInt32.MaxValue
    ELSE
        IF uDec < 0
		    nDec := System.UInt32.MaxValue
        ELSE
            nDec := (DWORD) uDec
        ENDIF
    ENDIF
	result := _Str3(n, nLen, nDec)
	IF lTrimSpaces
		result := result:TrimStart()
	END IF
	RETURN ConversionHelpers.AdjustDecimalSeparator(result)

///
/// Convert a numeric expression to a string.
///
/// <param name="nValue"></param>
/// <param name="uLength"></param>
/// <param name="uDec"></param>
/// <returns>The string with always a DOT as decimal separator.</returns>

FUNCTION _Str(nValue ,uLen ,uDec ) AS STRING CLIPPER
    LOCAL nLen,  nDec AS LONG
    LOCAL dwLen, dwDec AS DWORD
	IF PCount() > 0 .AND. ! nValue:IsNumeric
       THROW Error.DataTypeError( __FUNCTION__, NAMEOF(nValue),1, nValue, uLen, uDec)
    ENDIF
	SWITCH PCount()
	CASE 1
		RETURN _Str1( nValue)
	CASE 2
		IF ! uLen:IsNumeric
			THROW Error.DataTypeError( __FUNCTION__, NAMEOF(uLen),2,nValue, uLen, uDec)
        ENDIF
        nLen := uLen
        IF nLen < 0
            dwLen := System.UInt32.MaxValue
        ELSE
            dwLen := (DWORD) nLen
        ENDIF
		IF nValue:IsFloat
			RETURN _Str2(nValue, dwLen)
		ELSE
			RETURN ConversionHelpers.FormatNumber((INT64) nValue, nLen,0)
		ENDIF
	CASE 3
		IF ! uLen:IsNumeric
			THROW Error.DataTypeError( __FUNCTION__, NAMEOF(uLen),2,nValue, uLen, uDec)
		ENDIF
		IF ! uDec:IsNumeric
			THROW Error.DataTypeError( __FUNCTION__, NAMEOF(uDec),3,nValue, uLen, uDec)
        ENDIF
        nLen := uLen
        nDec := uDec
 		IF nValue:IsFLoat
            nLen := uLen
            IF nLen < 0
                dwLen := System.UInt32.MaxValue
            ELSE
                dwLen := (DWORD) nLen
            ENDIF

            IF nDec < 0 .OR. RuntimeState.Fixed
                dwDec := XSharp.RuntimeState.Decimals
            ELSE
                dwDec := (DWORD) nDec
            ENDIF
            IF nLen < 0 .OR. RuntimeState.DigitsFixed
                dwLen := XSharp.RuntimeState.Digits
                IF nDec != 0
                    dwLen := dwLen + dwDec + 1
                ENDIF
            ENDIF
            VAR res := _Str3(nValue, dwLen, dwDec)
            IF nLen < 0
                res := res:TrimStart()
            ENDIF
            RETURN res
        ELSE
            IF nLen < 0
                nLen := 30
            ENDIF
            IF nDec < 0
                nDec := (INT) SetDecimal()
            ENDIF
			RETURN ConversionHelpers.FormatNumber((INT64) nValue, nLen,nDec)
		ENDIF
	OTHERWISE
		RETURN ""
	END SWITCH

// The following three functions are undocumented in Vulcan but sometimes used in user code
// They are the equivalent of the STR() functions but always return with digit decimal separator
// We route all three to the _Str() function that takes care of this already
/// <exclude/>
FUNCTION __Str(n AS USUAL) AS STRING
	RETURN _Str( n)

/// <exclude/>
FUNCTION __Str(n AS USUAL,nLen AS USUAL) AS STRING
	RETURN _Str( n, nLen)

/// <exclude/>
FUNCTION __Str(n AS USUAL,nLen AS USUAL, nDec AS USUAL) AS STRING
	RETURN _Str( n, nLen, nDec)

INTERNAL FUNCTION _PadZero(cValue AS STRING) AS STRING
	LOCAL iLen := 	cValue:Length AS INT
	RETURN cValue:TrimStart():PadLeft((INT) iLen, c'0')

	///
	/// Convert a numeric expression to a string and pad it with leading zeroes instead of blanks.
	///
	/// <param name="n"></param>
	/// <param name="iLen"></param>
	/// <param name="iDec"></param>
	/// <returns>
	/// </returns>
FUNCTION StrZero(n AS USUAL,iLen AS INT,iDec AS INT) AS STRING
	IF ! ( n:IsNumeric )
      THROW Error.DataTypeError( __FUNCTION__, NAMEOF(n),1,n, iLen, iDec)
    ENDIF
	LOCAL cValue := Str3(n, (DWORD) iLen, (DWORD) iDec) AS STRING
	RETURN _PadZero(cValue)

///
/// Convert a numeric expression to a string and pad it with leading zeroes instead of blanks.
///
/// <param name="n"></param>
/// <param name="iLen"></param>
/// <returns>
/// </returns>
FUNCTION StrZero(n AS USUAL,iLen AS INT) AS STRING
	IF ! ( n:IsNumeric )
      THROW Error.DataTypeError( __FUNCTION__, NAMEOF(n),1,n, iLen)
	ENDIF
	LOCAL cValue := Str2(n, (DWORD) iLen) AS STRING
	RETURN _padZero(cValue)

///
/// Convert a numeric expression to a string and pad it with leading zeroes instead of blanks.
///
/// <param name="n"></param>
/// <returns>
/// </returns>
FUNCTION StrZero(n AS USUAL) AS STRING
	IF ! ( n:IsNumeric )
      THROW Error.DataTypeError( __FUNCTION__, NAMEOF(n),1,n)
    ENDIF
	LOCAL cValue := Str1(n) AS STRING
	RETURN _PadZero(cValue)

	///
	/// Convert a number to a dword.
	///
	/// <param name="n"></param>
	/// <returns>
	/// </returns>
FUNCTION ToWord(n AS USUAL) AS DWORD
	RETURN (DWORD) n

/// <inheritdoc cref="M:XSharp.RT.Functions.StrLong(System.Int32,System.UInt32,System.UInt32)" />
FUNCTION StrInt(l AS LONG,dwLen AS DWORD,dwDec AS DWORD) AS STRING
	RETURN Str3( l, dwLen, dwDec)

/// <inheritdoc cref="M:XSharp.RT.Functions.Str3(XSharp.__Float,System.UInt32,System.UInt32)" />
/// <param name="l">Number to format.</param>
FUNCTION StrLong(l AS LONG,dwLen AS DWORD,dwDec AS DWORD) AS STRING
	RETURN StrInt(l, dwLen, dwDec)

/// <inheritdoc cref="M:XSharp.RT.Functions.Str3(XSharp.__Float,System.UInt32,System.UInt32)" />
FUNCTION StrFloat(f AS FLOAT,dwLen AS DWORD,dwDec AS DWORD) AS STRING
	RETURN Str3( f, dwLen, dwDec )

///
/// Convert a numeric expression to a string with an optional decimal separator based on the settings in the runtime state.
///
/// <param name="f"></param>
/// <returns>
/// </returns>
FUNCTION Str1(f AS USUAL) AS STRING
	IF f:IsFloat
		RETURN ConversionHelpers.AdjustDecimalSeparator(_Str1( (FLOAT) f))
	ELSE
		RETURN ConversionHelpers.FormatNumber( (LONG) f, (INT) RuntimeState.Digits, 0):Trim()
	ENDIF

INTERNAL FUNCTION _Str1(f AS FLOAT) AS STRING
	VAR nDecimals := f:decimals
	VAR nDigits   := f:Digits

	SWITCH (Double)f
	CASE Double.NaN
		RETURN Double.NaN:ToString()
	CASE Double.PositiveInfinity
		RETURN Double.PositiveInfinity:ToString()
	CASE Double.NegativeInfinity
		RETURN Double.NegativeInfinity:ToString()
	END SWITCH

	IF nDecimals < 0 .OR. RuntimeState.Fixed
		nDecimals := (SHORT) RuntimeState.Decimals
	ENDIF
	IF nDigits <= 0 .OR. RuntimeState.DigitsFixed
		nDigits := (SHORT) RuntimeState.Digits
    	IF ConversionHelpers.GetSignificantWholeDigits(f) > nDigits
    		RETURN STRING{ c'*', (INT) nDigits}
    	END IF
        IF nDecimals != 0
            nDigits += nDecimals +1
        ENDIF
	ENDIF
	VAR result := ConversionHelpers.FormatNumber(f, nDigits, nDecimals )
	RETURN result

///
/// Convert a numeric expression to a string of a specified length.
///
/// <param name="f"></param>
/// <param name="dwLen"></param>
/// <returns>
/// </returns>
FUNCTION Str2(f AS FLOAT,dwLen AS DWORD) AS STRING
	RETURN ConversionHelpers.AdjustDecimalSeparator(_Str2(f, dwLen))

INTERNAL FUNCTION _Str2(f AS FLOAT,dwLen AS DWORD) AS STRING
  IF dwLen == 0 .OR. RuntimeState.DigitsFixed
      dwLen := (DWORD) RuntimeState.Digits
   ELSEIF dwLen  != UInt32.MaxValue
      dwLen := Math.Min( dwLen, MAXDIGITS )
   ENDIF
   VAR nDecimals := f:decimals
	IF nDecimals < 0 .OR. RuntimeState.DigitsFixed
		nDecimals := (SHORT) RuntimeState.Decimals
	ENDIF
   RETURN ConversionHelpers.FormatNumber(f, (INT) dwLen, nDecimals)

///
/// Convert a numeric expression to a string of specific length and decimal places
///
/// <param name="f">Number to format</param>
/// <param name="dwLen">Total length of result string.</param>
/// <param name="dwDec">Number of decimals.</param>
/// <returns>A string with decimal separator based on the runtime state.</returns>
FUNCTION Str3(f AS FLOAT,dwLen AS DWORD,dwDec AS DWORD) AS STRING
	RETURN ConversionHelpers.AdjustDecimalSeparator(_Str3(f, dwLen, dwDec))

/// <inheritdoc cref="M:XSharp.RT.Functions.Str3(XSharp.__Float,System.UInt32,System.UInt32)" />
/// <returns>A string with DOT as decimal separator.</returns>
FUNCTION _Str3(f AS FLOAT,dwLen AS DWORD,dwDec AS DWORD) AS STRING

   IF dwDec == UInt32.MaxValue
        IF RuntimeState.Fixed
            dwDec := (DWORD) RuntimeState.Decimals
        ELSE
            dwDec := (DWORD) f:Decimals
        ENDIF
   ELSE
      dwDec := Math.Min( dwDec, MAXDECIMALS )
   ENDIF

   IF dwLen == 0 .OR. dwLen == UInt32.MaxValue
        IF dwDec > 0
        	IF ConversionHelpers.GetSignificantWholeDigits(f) > RuntimeState.Digits
        		RETURN STRING{ c'*', (INT) (RuntimeState.Digits + dwDec +1) } // VO's behavior...
        	END IF
            dwLen := (DWORD) RuntimeState.Digits + dwDec +1
        ELSE
            dwLen := (DWORD) RuntimeState.Digits
        ENDIF
   ELSE
      dwLen := Math.Min( dwLen, MAXDIGITS )
   ENDIF

   IF dwDec > 0 .AND. dwLen != UInt32.MaxValue .AND. ( dwLen < ( dwDec + 2 ) )
      RETURN STRING{ c'*', (INT) dwLen }
   ENDIF
   RETURN ConversionHelpers.FormatNumber(f, (INT) dwLen, (INT) dwDec)

/// <inheritdoc cref="M:XSharp.RT.Functions.Val(System.String)" />
/// <returns>The numeric value as a FLOAT.</returns>
FUNCTION StrToFloat(c AS STRING) AS FLOAT
    RETURN (FLOAT) Val(c)

///
/// Convert a string containing a numeric value to a numeric data type.
///
/// <param name="cNumber">Number to convert. This may contain decimal separator, Hex notation, U or L suffix or Exponential notation.</param>
/// <returns>The numeric value as a USUAL.This may be a FLOAT, a LONG or an INT64.</returns>
FUNCTION Val(cNumber AS STRING) AS USUAL
	RETURN _Val(AllTrim(cNumber))

///
/// Convert an object containing a numeric value to a FLOAT
///
/// <param name="oValue">Object containing the numeric value to convert.</param>
/// <returns>The value in the form of a float. </returns>
/// <exception cref='T:System.InvalidCastException'> Thrown when the parameter oValue cannot be converted to a FLOAT.</exception>
FUNCTION Object2Float(oValue AS OBJECT) AS FLOAT
    LOCAL typ := oValue:GetType() AS System.Type
    IF typ == typeof(FLOAT)
        RETURN (FLOAT) oValue
    ENDIF
    LOCAL tc := System.Type.GetTypeCode(typ) AS TypeCode
    SWITCH tc
    CASE System.TypeCode.SByte
        RETURN (System.SByte) oValue
    CASE System.TypeCode.Byte
        RETURN (System.Byte) oValue
    CASE System.TypeCode.Double
        RETURN (System.Double) oValue
    CASE System.TypeCode.Single
        RETURN (System.Single) oValue
    CASE System.TypeCode.UInt16
        RETURN (System.UInt16) oValue
    CASE System.TypeCode.UInt32
        RETURN (System.UInt32) oValue
    CASE System.TypeCode.UInt64
        RETURN (System.UInt64) oValue
    CASE System.TypeCode.Int16
        RETURN (System.Int16) oValue
    CASE System.TypeCode.Int32
        RETURN (System.Int32) oValue
    CASE System.TypeCode.Int64
        RETURN (System.Int64) oValue
    CASE System.TypeCode.Decimal
        RETURN (System.Decimal) oValue
    OTHERWISE
        THROW InvalidCastException{"Cannot convert from type "+typ:FullName+" to FLOAT"}
    END SWITCH

FUNCTION Bin2F(c AS STRING) AS FLOAT
    LOCAL nDec AS WORD
    LOCAL val  AS REAL8
	IF SLen(c) >= 12
        nDec := Bin2W(SubStr3(c, 11,2))
        val  := Bin2Real8(SubStr3(c, 1,8))
        RETURN FLOAT{val, 0, nDec}
    ENDIF
	RETURN 0.0

FUNCTION F2Bin(f AS FLOAT) AS STRING
    RETURN Real82Bin(f:Value)+ e"\0\0" + W2Bin((WORD)f:Decimals)


[Runtime] Fix for PSZ indexing (https://github.com/X-Sharp/XSharpPublic/issues/98)

//
// Copyright (c) XSharp B.V.  All Rights Reserved.
// Licensed under the Apache License, Version 2.0.
// See License.txt in the project root for license information.
//
USING System.Collections.Generic
USING System.Runtime.InteropServices
USING System.Diagnostics
USING System.Text
USING System.Reflection
BEGIN NAMESPACE XSharp

	/// <summary>Internal type that implements the VO Compatible PSZ type.<br/>
	/// This type has many operators and implicit converters that normally are never directly called from user code.
	/// </summary>
    /// <include file="RTComments.xml" path="Comments/PSZ/*" />
	[DebuggerDisplay( "{DebuggerString(),nq}", Type := "PSZ" ) ] ;
	STRUCTURE __Psz IMPLEMENTS  IEquatable<__Psz>
		PRIVATE _value AS BYTE PTR
		/// <exclude />
		STATIC PROPERTY _NULL_PSZ AS __Psz GET (__Psz) IntPtr.zero
		PRIVATE STATIC _pszList AS List< IntPtr>
		INTERNAL STATIC METHOD RegisterPsz(pszToRegister AS PSZ) AS VOID
			IF _pszList == NULL
				_pszList := List<IntPtr>{}
				AppDomain.CurrentDomain:ProcessExit += System.EventHandler{ NULL, @__FreePSZs() }
			ENDIF
			IF !_pszList:Contains(pszToRegister:Address)
				_pszList:add(pszToRegister:Address)
			ENDIF
			RETURN

		INTERNAL STATIC METHOD CreatePsz( cString AS STRING) AS PSZ
				RETURN PSZ{cString}

		PRIVATE STATIC METHOD __FreePSZs(o AS OBJECT, args AS EventArgs ) AS VOID
			FOREACH VAR pszToFree IN _pszList
				TRY
					MemFree(pszToFree)
				CATCH
					NOP
				END TRY
			NEXT
			_pszList := NULL

		/// <include file="RTComments.xml" path="Comments/Constructor/*" />
		CONSTRUCTOR (s AS STRING)
			// this constructor has a memory leak
			// there is no garbage collection for structures
			// to free the memory we need to call MemFree on the pointer
			_value := String2Mem(s)
			RegisterPsz(_value)
			RETURN

		/// <include file="RTComments.xml" path="Comments/Constructor/*" />
		CONSTRUCTOR (p AS IntPtr)
			_value := p

		/// <exclude/>
        OVERRIDE METHOD ToString() AS STRING
			RETURN Mem2String( _value, Length )

		/// <exclude />
		METHOD DebuggerString() AS STRING
			RETURN IIF( _value == NULL_PTR, "NULL_PSZ", e"\""+ tostring() +  e"\"" )

		/// <exclude />
		METHOD Equals( p AS PSZ ) AS LOGIC

			LOCAL ret := FALSE AS LOGIC
			IF _value == p:_value
				ret := TRUE
			ELSEIF _value != NULL .AND. p:_value != NULL
				ret := __StringCompare( ToString(), p:ToString() ) == 0
			ENDIF
			RETURN ret

		INTERNAL METHOD LessThan( p AS PSZ ) AS LOGIC
			// todo: should this follow nation rules ?
			LOCAL ret := FALSE AS LOGIC
			IF _value == p:_value
				ret := FALSE
			ELSEIF _value != NULL .AND. p:_value != NULL
				ret := __StringCompare( ToString(), p:ToString() ) < 0
			ENDIF
			RETURN ret

		INTERNAL METHOD GreaterThan( p AS PSZ ) AS LOGIC
			LOCAL ret := FALSE AS LOGIC
			// todo: should this follow nation rules ?
			IF _value == p:_value
				ret := FALSE
			ELSEIF _value != NULL .AND. p:_value != NULL
				ret := __StringCompare( ToString(), p:ToString() ) > 0
			ENDIF
			RETURN ret

			/// <exclude/>
         OVERRIDE METHOD Equals( o AS OBJECT ) AS LOGIC
			LOCAL ret := FALSE AS LOGIC

			IF o IS PSZ
				ret := SELF:Equals( (PSZ) o )
			ENDIF

		RETURN ret

		/// <inheritdoc />
		OVERRIDE METHOD GetHashCode() AS INT
			RETURN (INT) _value

		/// <exclude />
		METHOD Free() AS VOID
			IF _value != NULL_PTR
				MemFree( _value )
				_value := NULL_PTR
			ENDIF
			RETURN
		/// <exclude />
		PROPERTY Length AS DWORD
			GET
				LOCAL len AS DWORD
				len := 0
				IF _value != NULL_PTR
					DO WHILE _value[len+1] != 0
						len++
					ENDDO
				ENDIF
				RETURN len
			END GET
		END PROPERTY
		/// <exclude />
		PROPERTY IsEmpty AS LOGIC
			GET
				LOCAL empty := TRUE AS LOGIC
				LOCAL b AS BYTE
				LOCAL x := 1 AS INT
				IF _value != NULL_PTR
					b := _value[x]
					DO WHILE b != 0 .AND. empty
						SWITCH b
							CASE 32
							CASE 13
							CASE 10
							CASE 9
								NOP
							OTHERWISE
								empty := FALSE
						END SWITCH
						x += 1
						b := _value[x]
					ENDDO
				ENDIF
				RETURN empty

			END GET
		END PROPERTY
		/// <exclude />
		PROPERTY IsNull AS LOGIC GET _value == NULL
		/// <exclude />
		PROPERTY Address AS IntPtr GET _value
		/// <exclude />
		PROPERTY SELF[index AS INT] AS BYTE
			GET
				RETURN _value[index + __ARRAYBASE__]
			END GET
			SET
				_value[index + __ARRAYBASE__] := VALUE
			END SET
		END PROPERTY

		#region OPERATOR methods
			// binary
			/// <include file="RTComments.xml" path="Comments/Operator/*" />
			OPERATOR +( lhs AS PSZ, rhs AS PSZ ) AS PSZ
				RETURN PSZ{ lhs:ToString() + rhs:ToString() }

			/// <include file="RTComments.xml" path="Comments/Operator/*" />
			OPERATOR +( lhs AS PSZ, rhs AS STRING ) AS PSZ
				RETURN PSZ{ lhs:ToString() + rhs }

			/// <include file="RTComments.xml" path="Comments/Operator/*" />
			OPERATOR +( lhs AS STRING, rhs AS PSZ ) AS STRING
				RETURN lhs + rhs:ToString()

			/// <include file="RTComments.xml" path="Comments/Operator/*" />
			OPERATOR -( lhs AS PSZ, rhs AS PSZ ) AS PSZ
				LOCAL l   := lhs:ToString() AS STRING
				LOCAL r   := rhs:ToString() AS STRING
				RETURN PSZ{ String.Concat( l:TrimEnd(), r:TrimEnd() ):PadRight( l:Length + r:Length ) }

			/// <include file="RTComments.xml" path="Comments/Operator/*" />
			OPERATOR -( lhs AS PSZ, rhs AS STRING ) AS PSZ
				LOCAL l   := lhs:ToString() AS STRING
				RETURN PSZ{ String.Concat( l:TrimEnd(), rhs:TrimEnd() ):PadRight( l:Length + rhs:Length ) }

			/// <include file="RTComments.xml" path="Comments/Operator/*" />
			OPERATOR -( lhs AS STRING, rhs AS PSZ ) AS STRING
				LOCAL r   := rhs:ToString() AS STRING
				RETURN String.Concat( lhs:TrimEnd(), r:TrimEnd() ):PadRight( lhs:Length + r:Length )

			// Comparison Operators
			/// <include file="RTComments.xml" path="Comments/Operator/*" />
			OPERATOR ==( lhs AS PSZ, rhs AS PSZ ) AS LOGIC
				RETURN lhs:Equals( rhs )

			/// <include file="RTComments.xml" path="Comments/Operator/*" />
			OPERATOR !=( lhs AS PSZ, rhs AS PSZ ) AS LOGIC
				RETURN ! lhs:Equals( rhs )

			/// <include file="RTComments.xml" path="Comments/Operator/*" />
			OPERATOR <( lhs AS PSZ, rhs AS PSZ ) AS LOGIC
				RETURN lhs:LessThan( rhs )

			/// <include file="RTComments.xml" path="Comments/Operator/*" />
			OPERATOR <=( lhs AS PSZ, rhs AS PSZ ) AS LOGIC
				RETURN ! lhs:GreaterThan( rhs )

			/// <include file="RTComments.xml" path="Comments/Operator/*" />
			OPERATOR >( lhs AS PSZ, rhs AS PSZ ) AS LOGIC
				RETURN lhs:GreaterThan( rhs )

			/// <include file="RTComments.xml" path="Comments/Operator/*" />
			OPERATOR >=( lhs AS PSZ, rhs AS PSZ ) AS LOGIC
				RETURN ! lhs:LessThan( rhs )

			// Conversion Operators - To PSZ...

			// PTR -> PSZ
			/// <include file="RTComments.xml" path="Comments/Operator/*" />
			OPERATOR IMPLICIT( p AS PTR ) AS PSZ
				RETURN PSZ{ (IntPtr) p }

			// BYTE PTR -> PSZ
			/// <include file="RTComments.xml" path="Comments/Operator/*" />
			OPERATOR IMPLICIT( p AS BYTE PTR ) AS PSZ
				RETURN PSZ{ (IntPtr) p }

			// SByte PTR -> PSZ
			/// <include file="RTComments.xml" path="Comments/Operator/*" />
			OPERATOR IMPLICIT( p AS SByte PTR ) AS PSZ
				RETURN PSZ{ (IntPtr) p }

			// IntPtr -> PSZ
			/// <include file="RTComments.xml" path="Comments/Operator/*" />
			OPERATOR IMPLICIT( p AS IntPtr ) AS PSZ
				RETURN PSZ{ p }

			// INT -> PSZ
			/// <include file="RTComments.xml" path="Comments/Operator/*" />
			OPERATOR IMPLICIT( i AS INT ) AS PSZ
				RETURN PSZ{ IntPtr{ i } }

			// DWORD -> PSZ
			/// <include file="RTComments.xml" path="Comments/Operator/*" />
			OPERATOR IMPLICIT( d AS DWORD ) AS PSZ
				RETURN PSZ{ IntPtr{ (PTR) d } }

			///////////////////////////////////////////////////////////////////////////
			// Conversion Operators - From PSZ...

			// PSZ -> PTR
			/// <include file="RTComments.xml" path="Comments/Operator/*" />
			OPERATOR IMPLICIT( p AS PSZ ) AS PTR
				RETURN p:_value

			// PSZ -> BYTE PTR
			/// <include file="RTComments.xml" path="Comments/Operator/*" />
			OPERATOR IMPLICIT( p AS PSZ ) AS BYTE PTR
				RETURN p:_value

			// PSZ -> SByte PTR
			/// <include file="RTComments.xml" path="Comments/Operator/*" />
			OPERATOR IMPLICIT( p AS PSZ ) AS SByte PTR
				RETURN (SByte PTR) p:_value

			// PSZ -> IntPtr
			/// <include file="RTComments.xml" path="Comments/Operator/*" />
			OPERATOR IMPLICIT( p AS PSZ ) AS IntPtr
				RETURN p:_value

			// PSZ -> STRING
			OPERATOR IMPLICIT( p AS PSZ ) AS STRING
				RETURN p:ToString()

			// PSZ -> INT
			/// <include file="RTComments.xml" path="Comments/Operator/*" />
			OPERATOR IMPLICIT( p AS PSZ ) AS INT
				RETURN (INT) p:_value

			// PSZ -> INT64
			/// <include file="RTComments.xml" path="Comments/Operator/*" />
			OPERATOR IMPLICIT( p AS PSZ ) AS INT64
				RETURN (INT64) p:_value

			// PSZ -> DWORD
			/// <include file="RTComments.xml" path="Comments/Operator/*" />
			OPERATOR IMPLICIT( p AS PSZ ) AS DWORD
				RETURN (DWORD) p:_value
		#endregion

	END STRUCTURE

END NAMESPACE

// This function is handled by the compiler. The runtime function should never be called
/// <exclude />
FUNCTION Cast2Psz(cSource AS STRING) AS PSZ
	THROW NotImplementedException{}

// This function is handled by the compiler. The runtime function should never be called
/// <exclude />
FUNCTION String2Psz(cSource AS STRING) AS PSZ
	THROW NotImplementedException{}

//
// Copyright (c) XSharp B.V.  All Rights Reserved.
// Licensed under the Apache License, Version 2.0.
// See License.txt in the project root for license information.
//
USING System.Collections.Generic
USING System.Runtime.InteropServices
USING System.Diagnostics
USING System.Text
USING System.Reflection
BEGIN NAMESPACE XSharp

	/// <summary>Internal type that implements the VO Compatible PSZ type.<br/>
	/// This type has many operators and implicit converters that normally are never directly called from user code.
	/// </summary>
    /// <include file="RTComments.xml" path="Comments/PSZ/*" />
	[DebuggerDisplay( "{DebuggerString(),nq}", Type := "PSZ" ) ] ;
	STRUCTURE __Psz IMPLEMENTS  IEquatable<__Psz>
		PRIVATE _value AS BYTE PTR
		/// <exclude />
		STATIC PROPERTY _NULL_PSZ AS __Psz GET (__Psz) IntPtr.zero
		PRIVATE STATIC _pszList AS List< IntPtr>
		INTERNAL STATIC METHOD RegisterPsz(pszToRegister AS PSZ) AS VOID
			IF _pszList == NULL
				_pszList := List<IntPtr>{}
				AppDomain.CurrentDomain:ProcessExit += System.EventHandler{ NULL, @__FreePSZs() }
			ENDIF
			IF !_pszList:Contains(pszToRegister:Address)
				_pszList:add(pszToRegister:Address)
			ENDIF
			RETURN

		INTERNAL STATIC METHOD CreatePsz( cString AS STRING) AS PSZ
				RETURN PSZ{cString}

		PRIVATE STATIC METHOD __FreePSZs(o AS OBJECT, args AS EventArgs ) AS VOID
			FOREACH VAR pszToFree IN _pszList
				TRY
					MemFree(pszToFree)
				CATCH
					NOP
				END TRY
			NEXT
			_pszList := NULL

		/// <include file="RTComments.xml" path="Comments/Constructor/*" />
		CONSTRUCTOR (s AS STRING)
			// this constructor has a memory leak
			// there is no garbage collection for structures
			// to free the memory we need to call MemFree on the pointer
			_value := String2Mem(s)
			RegisterPsz(_value)
			RETURN

		/// <include file="RTComments.xml" path="Comments/Constructor/*" />
		CONSTRUCTOR (p AS IntPtr)
			_value := p

		/// <exclude/>
        OVERRIDE METHOD ToString() AS STRING
			RETURN Mem2String( _value, Length )

		/// <exclude />
		METHOD DebuggerString() AS STRING
			RETURN IIF( _value == NULL_PTR, "NULL_PSZ", e"\""+ tostring() +  e"\"" )

		/// <exclude />
		METHOD Equals( p AS PSZ ) AS LOGIC

			LOCAL ret := FALSE AS LOGIC
			IF _value == p:_value
				ret := TRUE
			ELSEIF _value != NULL .AND. p:_value != NULL
				ret := __StringCompare( ToString(), p:ToString() ) == 0
			ENDIF
			RETURN ret

		INTERNAL METHOD LessThan( p AS PSZ ) AS LOGIC
			// todo: should this follow nation rules ?
			LOCAL ret := FALSE AS LOGIC
			IF _value == p:_value
				ret := FALSE
			ELSEIF _value != NULL .AND. p:_value != NULL
				ret := __StringCompare( ToString(), p:ToString() ) < 0
			ENDIF
			RETURN ret

		INTERNAL METHOD GreaterThan( p AS PSZ ) AS LOGIC
			LOCAL ret := FALSE AS LOGIC
			// todo: should this follow nation rules ?
			IF _value == p:_value
				ret := FALSE
			ELSEIF _value != NULL .AND. p:_value != NULL
				ret := __StringCompare( ToString(), p:ToString() ) > 0
			ENDIF
			RETURN ret

			/// <exclude/>
         OVERRIDE METHOD Equals( o AS OBJECT ) AS LOGIC
			LOCAL ret := FALSE AS LOGIC

			IF o IS PSZ
				ret := SELF:Equals( (PSZ) o )
			ENDIF

		RETURN ret

		/// <inheritdoc />
		OVERRIDE METHOD GetHashCode() AS INT
			RETURN (INT) _value

		/// <exclude />
		METHOD Free() AS VOID
			IF _value != NULL_PTR
				MemFree( _value )
				_value := NULL_PTR
			ENDIF
			RETURN
		/// <exclude />
		PROPERTY Length AS DWORD
			GET
				LOCAL len AS DWORD
				len := 0
				IF _value != NULL_PTR
					DO WHILE _value[len+1] != 0
						len++
					ENDDO
				ENDIF
				RETURN len
			END GET
		END PROPERTY
		/// <exclude />
		PROPERTY IsEmpty AS LOGIC
			GET
				LOCAL empty := TRUE AS LOGIC
				LOCAL b AS BYTE
				LOCAL x := 1 AS INT
				IF _value != NULL_PTR
					b := _value[x]
					DO WHILE b != 0 .AND. empty
						SWITCH b
							CASE 32
							CASE 13
							CASE 10
							CASE 9
								NOP
							OTHERWISE
								empty := FALSE
						END SWITCH
						x += 1
						b := _value[x]
					ENDDO
				ENDIF
				RETURN empty

			END GET
		END PROPERTY
		/// <exclude />
		PROPERTY IsNull AS LOGIC GET _value == NULL
		/// <exclude />
		PROPERTY Address AS IntPtr GET _value
		/// <exclude />
		PROPERTY Item[index AS INT] AS BYTE
			GET
				RETURN _value[index]
			END GET
			SET
				_value[index] := VALUE
			END SET
		END PROPERTY

		#region OPERATOR methods
			// binary
			/// <include file="RTComments.xml" path="Comments/Operator/*" />
			OPERATOR +( lhs AS PSZ, rhs AS PSZ ) AS PSZ
				RETURN PSZ{ lhs:ToString() + rhs:ToString() }

			/// <include file="RTComments.xml" path="Comments/Operator/*" />
			OPERATOR +( lhs AS PSZ, rhs AS STRING ) AS PSZ
				RETURN PSZ{ lhs:ToString() + rhs }

			/// <include file="RTComments.xml" path="Comments/Operator/*" />
			OPERATOR +( lhs AS STRING, rhs AS PSZ ) AS STRING
				RETURN lhs + rhs:ToString()

			/// <include file="RTComments.xml" path="Comments/Operator/*" />
			OPERATOR -( lhs AS PSZ, rhs AS PSZ ) AS PSZ
				LOCAL l   := lhs:ToString() AS STRING
				LOCAL r   := rhs:ToString() AS STRING
				RETURN PSZ{ String.Concat( l:TrimEnd(), r:TrimEnd() ):PadRight( l:Length + r:Length ) }

			/// <include file="RTComments.xml" path="Comments/Operator/*" />
			OPERATOR -( lhs AS PSZ, rhs AS STRING ) AS PSZ
				LOCAL l   := lhs:ToString() AS STRING
				RETURN PSZ{ String.Concat( l:TrimEnd(), rhs:TrimEnd() ):PadRight( l:Length + rhs:Length ) }

			/// <include file="RTComments.xml" path="Comments/Operator/*" />
			OPERATOR -( lhs AS STRING, rhs AS PSZ ) AS STRING
				LOCAL r   := rhs:ToString() AS STRING
				RETURN String.Concat( lhs:TrimEnd(), r:TrimEnd() ):PadRight( lhs:Length + r:Length )

			// Comparison Operators
			/// <include file="RTComments.xml" path="Comments/Operator/*" />
			OPERATOR ==( lhs AS PSZ, rhs AS PSZ ) AS LOGIC
				RETURN lhs:Equals( rhs )

			/// <include file="RTComments.xml" path="Comments/Operator/*" />
			OPERATOR !=( lhs AS PSZ, rhs AS PSZ ) AS LOGIC
				RETURN ! lhs:Equals( rhs )

			/// <include file="RTComments.xml" path="Comments/Operator/*" />
			OPERATOR <( lhs AS PSZ, rhs AS PSZ ) AS LOGIC
				RETURN lhs:LessThan( rhs )

			/// <include file="RTComments.xml" path="Comments/Operator/*" />
			OPERATOR <=( lhs AS PSZ, rhs AS PSZ ) AS LOGIC
				RETURN ! lhs:GreaterThan( rhs )

			/// <include file="RTComments.xml" path="Comments/Operator/*" />
			OPERATOR >( lhs AS PSZ, rhs AS PSZ ) AS LOGIC
				RETURN lhs:GreaterThan( rhs )

			/// <include file="RTComments.xml" path="Comments/Operator/*" />
			OPERATOR >=( lhs AS PSZ, rhs AS PSZ ) AS LOGIC
				RETURN ! lhs:LessThan( rhs )

			// Conversion Operators - To PSZ...

			// PTR -> PSZ
			/// <include file="RTComments.xml" path="Comments/Operator/*" />
			OPERATOR IMPLICIT( p AS PTR ) AS PSZ
				RETURN PSZ{ (IntPtr) p }

			// BYTE PTR -> PSZ
			/// <include file="RTComments.xml" path="Comments/Operator/*" />
			OPERATOR IMPLICIT( p AS BYTE PTR ) AS PSZ
				RETURN PSZ{ (IntPtr) p }

			// SByte PTR -> PSZ
			/// <include file="RTComments.xml" path="Comments/Operator/*" />
			OPERATOR IMPLICIT( p AS SByte PTR ) AS PSZ
				RETURN PSZ{ (IntPtr) p }

			// IntPtr -> PSZ
			/// <include file="RTComments.xml" path="Comments/Operator/*" />
			OPERATOR IMPLICIT( p AS IntPtr ) AS PSZ
				RETURN PSZ{ p }

			// INT -> PSZ
			/// <include file="RTComments.xml" path="Comments/Operator/*" />
			OPERATOR IMPLICIT( i AS INT ) AS PSZ
				RETURN PSZ{ IntPtr{ i } }

			// DWORD -> PSZ
			/// <include file="RTComments.xml" path="Comments/Operator/*" />
			OPERATOR IMPLICIT( d AS DWORD ) AS PSZ
				RETURN PSZ{ IntPtr{ (PTR) d } }

			///////////////////////////////////////////////////////////////////////////
			// Conversion Operators - From PSZ...

			// PSZ -> PTR
			/// <include file="RTComments.xml" path="Comments/Operator/*" />
			OPERATOR IMPLICIT( p AS PSZ ) AS PTR
				RETURN p:_value

			// PSZ -> BYTE PTR
			/// <include file="RTComments.xml" path="Comments/Operator/*" />
			OPERATOR IMPLICIT( p AS PSZ ) AS BYTE PTR
				RETURN p:_value

			// PSZ -> SByte PTR
			/// <include file="RTComments.xml" path="Comments/Operator/*" />
			OPERATOR IMPLICIT( p AS PSZ ) AS SByte PTR
				RETURN (SByte PTR) p:_value

			// PSZ -> IntPtr
			/// <include file="RTComments.xml" path="Comments/Operator/*" />
			OPERATOR IMPLICIT( p AS PSZ ) AS IntPtr
				RETURN p:_value

			// PSZ -> STRING
			OPERATOR IMPLICIT( p AS PSZ ) AS STRING
				RETURN p:ToString()

			// PSZ -> INT
			/// <include file="RTComments.xml" path="Comments/Operator/*" />
			OPERATOR IMPLICIT( p AS PSZ ) AS INT
				RETURN (INT) p:_value

			// PSZ -> INT64
			/// <include file="RTComments.xml" path="Comments/Operator/*" />
			OPERATOR IMPLICIT( p AS PSZ ) AS INT64
				RETURN (INT64) p:_value

			// PSZ -> DWORD
			/// <include file="RTComments.xml" path="Comments/Operator/*" />
			OPERATOR IMPLICIT( p AS PSZ ) AS DWORD
				RETURN (DWORD) p:_value
		#endregion

	END STRUCTURE

END NAMESPACE

// This function is handled by the compiler. The runtime function should never be called
/// <exclude />
FUNCTION Cast2Psz(cSource AS STRING) AS PSZ
	THROW NotImplementedException{}

// This function is handled by the compiler. The runtime function should never be called
/// <exclude />
FUNCTION String2Psz(cSource AS STRING) AS PSZ
	THROW NotImplementedException{}


[Tests] Enabled .NULL. test

[Tests] Enabled .NULL. test

//
// Copyright (c) XSharp B.V.  All Rights Reserved.
// Licensed under the Apache License, Version 2.0.
// See License.txt in the project root for license information.
//
USING System
USING System.Collections.Generic
USING System.Linq
USING System.Text
USING XUnit

using System.Diagnostics

// Array tests are not working correctly yet with the current build
BEGIN NAMESPACE XSharp.VFP.Tests

	CLASS TypeTests
		STATIC CONSTRUCTOR
        RegisterFoxMemVarSupport()
        XSharp.RuntimeState.Dialect := XSharpDialect.FoxPro

		[Fact, Trait("Category", "Types")];
		METHOD VarTypeTests() AS VOID
            DIMENSION a[10]
            XSharp.RuntimeState.CompilerOptionFox2 := TRUE
            a = 123 // fill the array

            ? VarType ( a ) , VarType ( a[10] )
            ?
            Assert.Equal("N", VarType ( a ))
            Assert.Equal("N", VarType ( a[10]))

            a = "text"

            ? VarType ( a ) , VarType ( a[10] )
            ?
            Assert.Equal("C", VarType ( a ))
            Assert.Equal("C", VarType ( a[10]))

            DIMENSION b[4,2]

            ? VarType ( b ) , VarType ( b[3,1] , TRUE ) , VarType ( b[3,1] , FALSE )
            ?

            && VFP  L U U
            && X#   A L X

            Assert.Equal("L", VarType ( b ))
            Assert.Equal("U", VarType ( b [3,1], TRUE))
            // FoxPro returns U for the next test. We return "L"
            //Assert.Equal("U", VarType ( b [3,1], FALSE ))
            Assert.Equal("L", VarType ( b [3,1], FALSE ))

            b[3,1] = "Text"

            ? VarType ( b ) , VarType ( b[3,1] )
            ?
            && VFP L C
            Assert.Equal("L", VarType ( b ))
            Assert.Equal("C", VarType ( b [3,1]))
            b := DBNull.Value
            Assert.Equal("X", VarType ( b ))
            PRIVATE c
            c := .NULL.
            Assert.Equal("X", VarType ( c ))

            DO CheckParams WITH "TestString" , 5 , 3

		[Fact, Trait("Category", "Types")];
		METHOD xTypeTests() AS VOID

            DIMENSION arr[3]
            private c, n

            c = "text"
            n = 12

            ? Type ("arr")  && "A" - while VFP returns "L"
            Assert.Equal("L", Type ("arr"))

            arr[1] = "text"

            ? Type ("arr")  && "A" - while VFP returns "C"

            Assert.Equal("C", Type ("arr"))

            //It seems that if VFPs Type() detects a array it returns the type of the first element.
            //To get "A" with VFP the additional (optional) param of the VFP Type() must be used

            && ---- VFP code only --- !

            && it seems that any other value than 1 throws an runtime error

            ? Type ("arr", 1 )  && "A"

            Assert.Equal("A", Type ("arr",1))

            && test with none array vars

            Assert.Equal("U", Type ("c",1))
            Assert.Equal("U", Type ("n",1))
            Assert.Equal("U", Type ("x",1))

            RETURN

	END CLASS

            PROCEDURE CheckParams AS VOID
                && LPARAMETERS a,b,c,d
                PARAMETERS a,b,c,d

                ? "VarType()" , VarType(d) , VarType ( d , TRUE )
                Assert.Equal("L", VarType ( d ))
                Assert.Equal("U", VarType ( d , TRUE))
                RETURN

END NAMESPACE

//
// Copyright (c) XSharp B.V.  All Rights Reserved.
// Licensed under the Apache License, Version 2.0.
// See License.txt in the project root for license information.
//
USING System
USING System.Collections.Generic
USING System.Linq
USING System.Text
USING XUnit

using System.Diagnostics

// Array tests are not working correctly yet with the current build
BEGIN NAMESPACE XSharp.VFP.Tests

	CLASS TypeTests
		STATIC CONSTRUCTOR
        RegisterFoxMemVarSupport()
        XSharp.RuntimeState.Dialect := XSharpDialect.FoxPro

		[Fact, Trait("Category", "Types")];
		METHOD VarTypeTests() AS VOID
            DIMENSION a[10]
            XSharp.RuntimeState.CompilerOptionFox2 := TRUE
            a = 123 // fill the array

            ? VarType ( a ) , VarType ( a[10] )
            ?
            Assert.Equal("N", VarType ( a ))
            Assert.Equal("N", VarType ( a[10]))

            a = "text"

            ? VarType ( a ) , VarType ( a[10] )
            ?
            Assert.Equal("C", VarType ( a ))
            Assert.Equal("C", VarType ( a[10]))

            DIMENSION b[4,2]

            ? VarType ( b ) , VarType ( b[3,1] , TRUE ) , VarType ( b[3,1] , FALSE )
            ?

            && VFP  L U U
            && X#   A L X

            Assert.Equal("L", VarType ( b ))
            Assert.Equal("U", VarType ( b [3,1], TRUE))
            // FoxPro returns U for the next test. We return "L"
            //Assert.Equal("U", VarType ( b [3,1], FALSE ))
            Assert.Equal("L", VarType ( b [3,1], FALSE ))

            b[3,1] = "Text"

            ? VarType ( b ) , VarType ( b[3,1] )
            ?
            && VFP L C
            Assert.Equal("L", VarType ( b ))
            Assert.Equal("C", VarType ( b [3,1]))
            b := DBNull.Value
            Assert.Equal("X", VarType ( b ))
            PRIVATE c
            c := .NULL.
            #warning .NULL. Should be converted to DBNull.Value
            //Assert.Equal("X", VarType ( c ))

            DO CheckParams WITH "TestString" , 5 , 3

		[Fact, Trait("Category", "Types")];
		METHOD xTypeTests() AS VOID

            DIMENSION arr[3]
            private c, n

            c = "text"
            n = 12

            ? Type ("arr")  && "A" - while VFP returns "L"
            Assert.Equal("L", Type ("arr"))

            arr[1] = "text"

            ? Type ("arr")  && "A" - while VFP returns "C"

            Assert.Equal("C", Type ("arr"))

            //It seems that if VFPs Type() detects a array it returns the type of the first element.
            //To get "A" with VFP the additional (optional) param of the VFP Type() must be used

            && ---- VFP code only --- !

            && it seems that any other value than 1 throws an runtime error

            ? Type ("arr", 1 )  && "A"

            Assert.Equal("A", Type ("arr",1))

            && test with none array vars

            Assert.Equal("U", Type ("c",1))
            Assert.Equal("U", Type ("n",1))
            Assert.Equal("U", Type ("x",1))

            RETURN

	END CLASS

            PROCEDURE CheckParams AS VOID
                && LPARAMETERS a,b,c,d
                PARAMETERS a,b,c,d

                ? "VarType()" , VarType(d) , VarType ( d , TRUE )
                Assert.Equal("L", VarType ( d ))
                Assert.Equal("U", VarType ( d , TRUE))
                RETURN

END NAMESPACE


QtMacExtras: deprecated 'class_id' property

/*

  Qt5xHb - bibliotecas de ligao entre Harbour/xHarbour e Qt Framework 5

  Copyright (C) 2012-2017 Marcos Antonio Gambeta <marcosgambeta@uol.com.br>

*/

#include "hbclass.ch"
#include "qt5xhb_clsid.ch"

#ifndef QT5XHB_NO_REQUESTS
REQUEST QVARIANT
REQUEST QBYTEARRAY
#endif

CLASS QMacPasteboardMime

   DATA pointer
   //DATA class_id INIT Class_Id_QMacPasteboardMime
   DATA class_flags INIT 0
   DATA self_destruction INIT .F.

   METHOD new
   METHOD delete
   METHOD convertorName
   METHOD canConvert
   METHOD mimeFor
   METHOD flavorFor
   METHOD convertToMime
   METHOD convertFromMime
   METHOD count

   METHOD newFrom
   METHOD newFromObject
   METHOD newFromPointer
   METHOD selfDestruction
   METHOD setSelfDestruction

   DESTRUCTOR destroyObject

END CLASS

PROCEDURE destroyObject () CLASS QMacPasteboardMime
   IF ::self_destruction
      ::delete()
   ENDIF
RETURN

#pragma BEGINDUMP

#include <Qt>

#ifndef __XHARBOUR__
#if (QT_VERSION >= QT_VERSION_CHECK(5,2,0))
#include <QMacPasteboardMime>
#endif
#endif

#include "qt5xhb_common.h"
#include "qt5xhb_clsid.h"
#include "qt5xhb_utils.h"

#ifdef __XHARBOUR__
#if (QT_VERSION >= QT_VERSION_CHECK(5,2,0))
#include <QMacPasteboardMime>
#endif
#endif

/*
QMacPasteboardMime(char)
*/
HB_FUNC_STATIC( QMACPASTEBOARDMIME_NEW )
{
#if (QT_VERSION >= QT_VERSION_CHECK(5,2,0))
  char par1 = ISCHAR(1)? (char) hb_parc(1)[0] : (ISNUM(1)? hb_parni(1) : 0);
  QMacPasteboardMime * o = new QMacPasteboardMime ( par1 );
  _qt5xhb_storePointerAndFlag( o, false );
#endif
}

HB_FUNC_STATIC( QMACPASTEBOARDMIME_DELETE )
{
#if (QT_VERSION >= QT_VERSION_CHECK(5,2,0))
  QMacPasteboardMime * obj = (QMacPasteboardMime *) hb_itemGetPtr( hb_objSendMsg( hb_stackSelfItem(), "POINTER", 0 ) );
  if( obj )
  {
    delete obj;
    obj = NULL;
    PHB_ITEM self = hb_stackSelfItem();
    PHB_ITEM ptr = hb_itemPutPtr( NULL, NULL );
    hb_objSendMsg( self, "_pointer", 1, ptr );
    hb_itemRelease( ptr );
  }
  hb_itemReturn( hb_stackSelfItem() );
#endif
}

/*
virtual QString convertorName() = 0
*/
HB_FUNC_STATIC( QMACPASTEBOARDMIME_CONVERTORNAME )
{
#if (QT_VERSION >= QT_VERSION_CHECK(5,2,0))
  QMacPasteboardMime * obj = (QMacPasteboardMime *) _qt5xhb_itemGetPtrStackSelfItem();
  if( obj )
  {
    hb_retc( (const char *) obj->convertorName (  ).toLatin1().data() );
  }
#endif
}

/*
virtual bool canConvert(const QString &mime, QString flav) = 0
*/
HB_FUNC_STATIC( QMACPASTEBOARDMIME_CANCONVERT )
{
#if (QT_VERSION >= QT_VERSION_CHECK(5,2,0))
  QMacPasteboardMime * obj = (QMacPasteboardMime *) _qt5xhb_itemGetPtrStackSelfItem();
  if( obj )
  {
    QString par1 = QLatin1String( hb_parc(1) );
    QString par2 = QLatin1String( hb_parc(2) );
    hb_retl( obj->canConvert ( par1, par2 ) );
  }
#endif
}

/*
virtual QString mimeFor(QString flav) = 0
*/
HB_FUNC_STATIC( QMACPASTEBOARDMIME_MIMEFOR )
{
#if (QT_VERSION >= QT_VERSION_CHECK(5,2,0))
  QMacPasteboardMime * obj = (QMacPasteboardMime *) _qt5xhb_itemGetPtrStackSelfItem();
  if( obj )
  {
    QString par1 = QLatin1String( hb_parc(1) );
    hb_retc( (const char *) obj->mimeFor ( par1 ).toLatin1().data() );
  }
#endif
}

/*
virtual QString flavorFor(const QString &mime) = 0
*/
HB_FUNC_STATIC( QMACPASTEBOARDMIME_FLAVORFOR )
{
#if (QT_VERSION >= QT_VERSION_CHECK(5,2,0))
  QMacPasteboardMime * obj = (QMacPasteboardMime *) _qt5xhb_itemGetPtrStackSelfItem();
  if( obj )
  {
    QString par1 = QLatin1String( hb_parc(1) );
    hb_retc( (const char *) obj->flavorFor ( par1 ).toLatin1().data() );
  }
#endif
}

/*
virtual QVariant convertToMime(const QString &mime, QList<QByteArray> data, QString flav) = 0
*/
HB_FUNC_STATIC( QMACPASTEBOARDMIME_CONVERTTOMIME )
{
#if (QT_VERSION >= QT_VERSION_CHECK(5,2,0))
  QMacPasteboardMime * obj = (QMacPasteboardMime *) _qt5xhb_itemGetPtrStackSelfItem();
  if( obj )
  {
    QString par1 = QLatin1String( hb_parc(1) );
    QList<QByteArray> par2;
    PHB_ITEM aList2 = hb_param(2, HB_IT_ARRAY);
    int i2;
    int nLen2 = hb_arrayLen(aList2);
    for (i2=0;i2<nLen2;i2++)
    {
      par2 << *(QByteArray *) hb_itemGetPtr( hb_objSendMsg( hb_arrayGetItemPtr( aList2, i2+1 ), "POINTER", 0 ) );
    }
    QString par3 = QLatin1String( hb_parc(3) );
    QVariant * ptr = new QVariant( obj->convertToMime ( par1, par2, par3 ) );
    _qt5xhb_createReturnClass ( ptr, "QVARIANT", true );
  }
#endif
}

/*
virtual QList<QByteArray> convertFromMime(const QString &mime, QVariant data, QString flav) = 0
*/
HB_FUNC_STATIC( QMACPASTEBOARDMIME_CONVERTFROMMIME )
{
#if (QT_VERSION >= QT_VERSION_CHECK(5,2,0))
  QMacPasteboardMime * obj = (QMacPasteboardMime *) _qt5xhb_itemGetPtrStackSelfItem();
  if( obj )
  {
    QString par1 = QLatin1String( hb_parc(1) );
    QVariant * par2 = (QVariant *) _qt5xhb_itemGetPtr(2);
    QString par3 = QLatin1String( hb_parc(3) );
    QList<QByteArray> list = obj->convertFromMime ( par1, *par2, par3 );
    PHB_DYNS pDynSym;
    #ifdef __XHARBOUR__
    pDynSym = hb_dynsymFind( "QBYTEARRAY" );
    #else
    pDynSym = hb_dynsymFindName( "QBYTEARRAY" );
    #endif
    PHB_ITEM pArray;
    pArray = hb_itemArrayNew(0);
    int i;
    for(i=0;i<list.count();i++)
    {
      if( pDynSym )
      {
        #ifdef __XHARBOUR__
        hb_vmPushSymbol( pDynSym->pSymbol );
        #else
        hb_vmPushDynSym( pDynSym );
        #endif
        hb_vmPushNil();
        hb_vmDo( 0 );
        PHB_ITEM pObject = hb_itemNew( NULL );
        hb_itemCopy( pObject, hb_stackReturnItem() );
        PHB_ITEM pItem = hb_itemNew( NULL );
        hb_itemPutPtr( pItem, (QByteArray *) new QByteArray ( list[i] ) );
        hb_objSendMsg( pObject, "_POINTER", 1, pItem );
        hb_itemRelease( pItem );
        hb_arrayAddForward( pArray, pObject );
        hb_itemRelease( pObject );
      }
    }
    hb_itemReturnRelease(pArray);
  }
#endif
}

/*
virtual int count(QMimeData *mimeData)
*/
HB_FUNC_STATIC( QMACPASTEBOARDMIME_COUNT )
{
#if (QT_VERSION >= QT_VERSION_CHECK(5,2,0))
  QMacPasteboardMime * obj = (QMacPasteboardMime *) _qt5xhb_itemGetPtrStackSelfItem();
  if( obj )
  {
    QMimeData * par1 = (QMimeData *) _qt5xhb_itemGetPtr(1);
    hb_retni( obj->count ( par1 ) );
  }
#endif
}

HB_FUNC_STATIC( QMACPASTEBOARDMIME_NEWFROM )
{
  PHB_ITEM self = hb_stackSelfItem();
  if( hb_pcount() == 1 && ISOBJECT(1) )
  {
    PHB_ITEM ptr = hb_itemPutPtr( NULL, (void *) hb_itemGetPtr( hb_objSendMsg( hb_param(1, HB_IT_OBJECT ), "POINTER", 0 ) ) );
    hb_objSendMsg( self, "_pointer", 1, ptr );
    hb_itemRelease( ptr );
    PHB_ITEM des = hb_itemPutL( NULL, false );
    hb_objSendMsg( self, "_self_destruction", 1, des );
    hb_itemRelease( des );
  }
  else if( hb_pcount() == 1 && ISPOINTER(1) )
  {
    PHB_ITEM ptr = hb_itemPutPtr( NULL, (void *) hb_itemGetPtr( hb_param(1, HB_IT_POINTER ) ) );
    hb_objSendMsg( self, "_pointer", 1, ptr );
    hb_itemRelease( ptr );
    PHB_ITEM des = hb_itemPutL( NULL, false );
    hb_objSendMsg( self, "_self_destruction", 1, des );
    hb_itemRelease( des );
  }
  hb_itemReturn( self );
}

HB_FUNC_STATIC( QMACPASTEBOARDMIME_NEWFROMOBJECT )
{
  HB_FUNC_EXEC( QMACPASTEBOARDMIME_NEWFROM );
}

HB_FUNC_STATIC( QMACPASTEBOARDMIME_NEWFROMPOINTER )
{
  HB_FUNC_EXEC( QMACPASTEBOARDMIME_NEWFROM );
}

HB_FUNC_STATIC( QMACPASTEBOARDMIME_SELFDESTRUCTION )
{
  hb_retl( (bool) hb_itemGetL( hb_objSendMsg( hb_stackSelfItem(), "SELF_DESTRUCTION", 0 ) ) );
}

HB_FUNC_STATIC( QMACPASTEBOARDMIME_SETSELFDESTRUCTION )
{
  PHB_ITEM self = hb_stackSelfItem();
  if( hb_pcount() == 1 && ISLOG(1) )
  {
    PHB_ITEM des = hb_itemPutL( NULL, hb_parl(1) );
    hb_objSendMsg( self, "_self_destruction", 1, des );
    hb_itemRelease( des );
  }
  hb_itemReturn( self );
}

#pragma ENDDUMP

/*

  Qt5xHb - bibliotecas de ligao entre Harbour/xHarbour e Qt Framework 5

  Copyright (C) 2012-2017 Marcos Antonio Gambeta <marcosgambeta@uol.com.br>

*/

#include "hbclass.ch"
#include "qt5xhb_clsid.ch"

#ifndef QT5XHB_NO_REQUESTS
REQUEST QVARIANT
REQUEST QBYTEARRAY
#endif

CLASS QMacPasteboardMime

   DATA pointer
   DATA class_id INIT Class_Id_QMacPasteboardMime
   DATA class_flags INIT 0
   DATA self_destruction INIT .F.

   METHOD new
   METHOD delete
   METHOD convertorName
   METHOD canConvert
   METHOD mimeFor
   METHOD flavorFor
   METHOD convertToMime
   METHOD convertFromMime
   METHOD count

   METHOD newFrom
   METHOD newFromObject
   METHOD newFromPointer
   METHOD selfDestruction
   METHOD setSelfDestruction

   DESTRUCTOR destroyObject

END CLASS

PROCEDURE destroyObject () CLASS QMacPasteboardMime
   IF ::self_destruction
      ::delete()
   ENDIF
RETURN

#pragma BEGINDUMP

#include <Qt>

#ifndef __XHARBOUR__
#if (QT_VERSION >= QT_VERSION_CHECK(5,2,0))
#include <QMacPasteboardMime>
#endif
#endif

#include "qt5xhb_common.h"
#include "qt5xhb_clsid.h"
#include "qt5xhb_utils.h"

#ifdef __XHARBOUR__
#if (QT_VERSION >= QT_VERSION_CHECK(5,2,0))
#include <QMacPasteboardMime>
#endif
#endif

/*
QMacPasteboardMime(char)
*/
HB_FUNC_STATIC( QMACPASTEBOARDMIME_NEW )
{
#if (QT_VERSION >= QT_VERSION_CHECK(5,2,0))
  char par1 = ISCHAR(1)? (char) hb_parc(1)[0] : (ISNUM(1)? hb_parni(1) : 0);
  QMacPasteboardMime * o = new QMacPasteboardMime ( par1 );
  _qt5xhb_storePointerAndFlag( o, false );
#endif
}

HB_FUNC_STATIC( QMACPASTEBOARDMIME_DELETE )
{
#if (QT_VERSION >= QT_VERSION_CHECK(5,2,0))
  QMacPasteboardMime * obj = (QMacPasteboardMime *) hb_itemGetPtr( hb_objSendMsg( hb_stackSelfItem(), "POINTER", 0 ) );
  if( obj )
  {
    delete obj;
    obj = NULL;
    PHB_ITEM self = hb_stackSelfItem();
    PHB_ITEM ptr = hb_itemPutPtr( NULL, NULL );
    hb_objSendMsg( self, "_pointer", 1, ptr );
    hb_itemRelease( ptr );
  }
  hb_itemReturn( hb_stackSelfItem() );
#endif
}

/*
virtual QString convertorName() = 0
*/
HB_FUNC_STATIC( QMACPASTEBOARDMIME_CONVERTORNAME )
{
#if (QT_VERSION >= QT_VERSION_CHECK(5,2,0))
  QMacPasteboardMime * obj = (QMacPasteboardMime *) _qt5xhb_itemGetPtrStackSelfItem();
  if( obj )
  {
    hb_retc( (const char *) obj->convertorName (  ).toLatin1().data() );
  }
#endif
}

/*
virtual bool canConvert(const QString &mime, QString flav) = 0
*/
HB_FUNC_STATIC( QMACPASTEBOARDMIME_CANCONVERT )
{
#if (QT_VERSION >= QT_VERSION_CHECK(5,2,0))
  QMacPasteboardMime * obj = (QMacPasteboardMime *) _qt5xhb_itemGetPtrStackSelfItem();
  if( obj )
  {
    QString par1 = QLatin1String( hb_parc(1) );
    QString par2 = QLatin1String( hb_parc(2) );
    hb_retl( obj->canConvert ( par1, par2 ) );
  }
#endif
}

/*
virtual QString mimeFor(QString flav) = 0
*/
HB_FUNC_STATIC( QMACPASTEBOARDMIME_MIMEFOR )
{
#if (QT_VERSION >= QT_VERSION_CHECK(5,2,0))
  QMacPasteboardMime * obj = (QMacPasteboardMime *) _qt5xhb_itemGetPtrStackSelfItem();
  if( obj )
  {
    QString par1 = QLatin1String( hb_parc(1) );
    hb_retc( (const char *) obj->mimeFor ( par1 ).toLatin1().data() );
  }
#endif
}

/*
virtual QString flavorFor(const QString &mime) = 0
*/
HB_FUNC_STATIC( QMACPASTEBOARDMIME_FLAVORFOR )
{
#if (QT_VERSION >= QT_VERSION_CHECK(5,2,0))
  QMacPasteboardMime * obj = (QMacPasteboardMime *) _qt5xhb_itemGetPtrStackSelfItem();
  if( obj )
  {
    QString par1 = QLatin1String( hb_parc(1) );
    hb_retc( (const char *) obj->flavorFor ( par1 ).toLatin1().data() );
  }
#endif
}

/*
virtual QVariant convertToMime(const QString &mime, QList<QByteArray> data, QString flav) = 0
*/
HB_FUNC_STATIC( QMACPASTEBOARDMIME_CONVERTTOMIME )
{
#if (QT_VERSION >= QT_VERSION_CHECK(5,2,0))
  QMacPasteboardMime * obj = (QMacPasteboardMime *) _qt5xhb_itemGetPtrStackSelfItem();
  if( obj )
  {
    QString par1 = QLatin1String( hb_parc(1) );
    QList<QByteArray> par2;
    PHB_ITEM aList2 = hb_param(2, HB_IT_ARRAY);
    int i2;
    int nLen2 = hb_arrayLen(aList2);
    for (i2=0;i2<nLen2;i2++)
    {
      par2 << *(QByteArray *) hb_itemGetPtr( hb_objSendMsg( hb_arrayGetItemPtr( aList2, i2+1 ), "POINTER", 0 ) );
    }
    QString par3 = QLatin1String( hb_parc(3) );
    QVariant * ptr = new QVariant( obj->convertToMime ( par1, par2, par3 ) );
    _qt5xhb_createReturnClass ( ptr, "QVARIANT", true );
  }
#endif
}

/*
virtual QList<QByteArray> convertFromMime(const QString &mime, QVariant data, QString flav) = 0
*/
HB_FUNC_STATIC( QMACPASTEBOARDMIME_CONVERTFROMMIME )
{
#if (QT_VERSION >= QT_VERSION_CHECK(5,2,0))
  QMacPasteboardMime * obj = (QMacPasteboardMime *) _qt5xhb_itemGetPtrStackSelfItem();
  if( obj )
  {
    QString par1 = QLatin1String( hb_parc(1) );
    QVariant * par2 = (QVariant *) _qt5xhb_itemGetPtr(2);
    QString par3 = QLatin1String( hb_parc(3) );
    QList<QByteArray> list = obj->convertFromMime ( par1, *par2, par3 );
    PHB_DYNS pDynSym;
    #ifdef __XHARBOUR__
    pDynSym = hb_dynsymFind( "QBYTEARRAY" );
    #else
    pDynSym = hb_dynsymFindName( "QBYTEARRAY" );
    #endif
    PHB_ITEM pArray;
    pArray = hb_itemArrayNew(0);
    int i;
    for(i=0;i<list.count();i++)
    {
      if( pDynSym )
      {
        #ifdef __XHARBOUR__
        hb_vmPushSymbol( pDynSym->pSymbol );
        #else
        hb_vmPushDynSym( pDynSym );
        #endif
        hb_vmPushNil();
        hb_vmDo( 0 );
        PHB_ITEM pObject = hb_itemNew( NULL );
        hb_itemCopy( pObject, hb_stackReturnItem() );
        PHB_ITEM pItem = hb_itemNew( NULL );
        hb_itemPutPtr( pItem, (QByteArray *) new QByteArray ( list[i] ) );
        hb_objSendMsg( pObject, "_POINTER", 1, pItem );
        hb_itemRelease( pItem );
        hb_arrayAddForward( pArray, pObject );
        hb_itemRelease( pObject );
      }
    }
    hb_itemReturnRelease(pArray);
  }
#endif
}

/*
virtual int count(QMimeData *mimeData)
*/
HB_FUNC_STATIC( QMACPASTEBOARDMIME_COUNT )
{
#if (QT_VERSION >= QT_VERSION_CHECK(5,2,0))
  QMacPasteboardMime * obj = (QMacPasteboardMime *) _qt5xhb_itemGetPtrStackSelfItem();
  if( obj )
  {
    QMimeData * par1 = (QMimeData *) _qt5xhb_itemGetPtr(1);
    hb_retni( obj->count ( par1 ) );
  }
#endif
}

HB_FUNC_STATIC( QMACPASTEBOARDMIME_NEWFROM )
{
  PHB_ITEM self = hb_stackSelfItem();
  if( hb_pcount() == 1 && ISOBJECT(1) )
  {
    PHB_ITEM ptr = hb_itemPutPtr( NULL, (void *) hb_itemGetPtr( hb_objSendMsg( hb_param(1, HB_IT_OBJECT ), "POINTER", 0 ) ) );
    hb_objSendMsg( self, "_pointer", 1, ptr );
    hb_itemRelease( ptr );
    PHB_ITEM des = hb_itemPutL( NULL, false );
    hb_objSendMsg( self, "_self_destruction", 1, des );
    hb_itemRelease( des );
  }
  else if( hb_pcount() == 1 && ISPOINTER(1) )
  {
    PHB_ITEM ptr = hb_itemPutPtr( NULL, (void *) hb_itemGetPtr( hb_param(1, HB_IT_POINTER ) ) );
    hb_objSendMsg( self, "_pointer", 1, ptr );
    hb_itemRelease( ptr );
    PHB_ITEM des = hb_itemPutL( NULL, false );
    hb_objSendMsg( self, "_self_destruction", 1, des );
    hb_itemRelease( des );
  }
  hb_itemReturn( self );
}

HB_FUNC_STATIC( QMACPASTEBOARDMIME_NEWFROMOBJECT )
{
  HB_FUNC_EXEC( QMACPASTEBOARDMIME_NEWFROM );
}

HB_FUNC_STATIC( QMACPASTEBOARDMIME_NEWFROMPOINTER )
{
  HB_FUNC_EXEC( QMACPASTEBOARDMIME_NEWFROM );
}

HB_FUNC_STATIC( QMACPASTEBOARDMIME_SELFDESTRUCTION )
{
  hb_retl( (bool) hb_itemGetL( hb_objSendMsg( hb_stackSelfItem(), "SELF_DESTRUCTION", 0 ) ) );
}

HB_FUNC_STATIC( QMACPASTEBOARDMIME_SETSELFDESTRUCTION )
{
  PHB_ITEM self = hb_stackSelfItem();
  if( hb_pcount() == 1 && ISLOG(1) )
  {
    PHB_ITEM des = hb_itemPutL( NULL, hb_parl(1) );
    hb_objSendMsg( self, "_self_destruction", 1, des );
    hb_itemRelease( des );
  }
  hb_itemReturn( self );
}

#pragma ENDDUMP


paramerize Inventory

paramerize Inventory

import "../src/LangPrelude.prg" (maybeM)

monad maybeM

data Fin :: Nat ~> *0 where
  Fz :: Fin (S m)
  Fs :: Fin m -> Fin (S m)
 deriving Nat(f)

data DigitList :: Nat ~> *0 where
  None :: DigitList a
  Longer :: DigitList a -> Fin a -> DigitList a
 deriving LeftList(dl)

up :: Nat' (2+b)t -> DigitList (2+b)t -> DigitList (2+b)t
up _ []dl = [1f]dl
up b [bla; f]dl = case tryIncr b f of
                  Nothing -> [up b bla; 0f]dl
                  Just d -> [bla; d]dl

tryIncr :: Nat' (2+b)t -> Fin (2+b)t -> Maybe (Fin (2+b)t)
tryIncr 2v 1f = Nothing
tryIncr (2+v)v 0f = Just 1f
tryIncr (3+v)v 1f = Just 2f
tryIncr (3+v)v (1+f)f = do { i <- tryIncr (2+v)v f; return (1+i)f }

data Fin' :: Nat ~> Nat ~> *0 where
  Fz' :: Fin' (S m) Z
  Fs' :: Fin' m n -> Fin' (S m) (S n)
 deriving Nat(fp)

data Inventory :: *1 ~> *1 where
  Empty :: Inventory a
  More :: Inventory a ~> a ~> Inventory a
 deriving LeftList(i)

data DigitList' :: Nat ~> Inventory Nat ~> *0 where
  None' :: DigitList' a []i
  Longer' :: DigitList' a inv -> Fin' a t -> DigitList' a [inv; t]i
 deriving LeftList(dlp)

import "../src/LangPrelude.prg" (maybeM)

monad maybeM

data Fin :: Nat ~> *0 where
  Fz :: Fin (S m)
  Fs :: Fin m -> Fin (S m)
 deriving Nat(f)

data DigitList :: Nat ~> *0 where
  None :: DigitList a
  Longer :: DigitList a -> Fin a -> DigitList a
 deriving LeftList(dl)

up :: Nat' (2+b)t -> DigitList (2+b)t -> DigitList (2+b)t
up _ []dl = [1f]dl
up b [bla; f]dl = case tryIncr b f of
                  Nothing -> [up b bla; 0f]dl
                  Just d -> [bla; d]dl

tryIncr :: Nat' (2+b)t -> Fin (2+b)t -> Maybe (Fin (2+b)t)
tryIncr 2v 1f = Nothing
tryIncr (2+v)v 0f = Just 1f
tryIncr (3+v)v 1f = Just 2f
tryIncr (3+v)v (1+f)f = do { i <- tryIncr (2+v)v f; return (1+i)f }

data Fin' :: Nat ~> Nat ~> *0 where
  Fz' :: Fin' (S m) Z
  Fs' :: Fin' m n -> Fin' (S m) (S n)
 deriving Nat(fp)

data NatInv :: *1 where
  Empty :: NatInv
  More :: NatInv ~> Nat ~> NatInv
 deriving LeftList(i)

data DigitList' :: Nat ~> NatInv ~> *0 where
  None' :: DigitList' a []i
  Longer' :: DigitList' a inv -> Fin' a t -> DigitList' a [inv; t]i
 deriving LeftList(dlp)