silly me

silly me

data Pat :: *2 where
  Y :: Pat
  Q :: Pat ~> Pat
 deriving Nat(p)

data Pat' :: Pat ~> *1 where
  Y' :: Pat' Y
  Q' :: Pat' n ~> Pat' (Q n)
 deriving Nat(q)

data Pat'' :: Pat' a ~> * where
  Y :: Pat'' Y'
  Q :: Pat'' n -> Pat'' (Q' n)
 deriving Nat(r)

plus :: Pat ~> Pat ~> Pat
{plus 0p n} = n
{plus (1+m)p n} = {plus m (1+n)p}

plus' :: Pat' a ~> Pat' b ~> Pat' {plus a b}
{plus' 0q n} = n
{plus' (1+m)q n} = {plus' m (1+n)q}

pl :: Pat'' a -> Pat'' b -> Pat'' {plus' a b}
pl 0r n = n
pl (1+m)r n = pl m (1+n)r

-- TESTS --

t1 :: Pat'' 25q
t1 = pl 13r 12r

data Pat :: *2 where
  Y :: Pat
  Q :: Pat ~> Pat
 deriving Nat(p)

data Pat' :: Pat ~> *1 where
  Y' :: Pat' Y
  Q' :: Pat' n ~> Pat' (Q n)
 deriving Nat(q)

data Pat'' :: Pat' a ~> * where
  Y :: Pat'' Y'
  Q :: Pat'' n -> Pat'' (Q' n)
 deriving Nat(r)

plus :: Pat ~> Pat ~> Pat
{plus 0p n} = n
{plus (1+m)p n} = {plus m (1+n)p}

plus' :: Pat' a ~> Pat' b ~> Pat' {plus a b}
{plus' 0q n} = n
{plus' (1+m)q n} = {plus' m (1+n)q}

pl :: Pat'' a -> Pat'' b -> Pat'' {plus' a b}
pl 0r n = n
pl (1+m)r n = pl m (1+n)r

-- TESTS --

--t1 :: 25q
t1 = pl 13r 12r


[VsIntegration] Remove call to GC.Collect to speed up closing of solutions.

//
// 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.Concurrent
USING System.Collections.Generic
USING System.Linq
USING System
USING System.IO
USING System.Reflection

BEGIN NAMESPACE XSharpModel
	/// <summary>
		/// We have one SystemTypeController in memory : It will handle all references types for all projects
		/// Assemblies are stored inside a List of AssemblyInfo
	/// </summary>
	CLASS SystemTypeController
		#region fields
		STATIC PRIVATE assemblies  AS ConcurrentDictionary<STRING, XAssembly>
		STATIC PRIVATE _mscorlib 	AS XAssembly
		#endregion

		STATIC CONSTRUCTOR
			assemblies := ConcurrentDictionary<STRING, XAssembly>{StringComparer.OrdinalIgnoreCase}
			_mscorlib := NULL
			RETURN

			#region properties
			// Properties
			STATIC PROPERTY AssemblyFileNames AS IList<STRING>
				GET
					RETURN SystemTypeController.assemblies:Keys:ToArray()
				END GET
			END PROPERTY
			STATIC PROPERTY mscorlib AS XAssembly GET _mscorlib SET _mscorlib := VALUE
		#endregion

		// Methods
		STATIC METHOD Clear() AS VOID
			assemblies:Clear()
			_mscorlib := NULL
			//GC.Collect()

		STATIC METHOD FindAssemblyByLocation(location AS STRING) AS STRING
			IF assemblies:ContainsKey(location)
				RETURN assemblies:Item[location]:FullName
			ENDIF
			RETURN NULL

		STATIC METHOD FindAssembly(fullName AS STRING) AS XAssembly
			FOREACH VAR item IN assemblies
				VAR asm := item:Value
				IF String.Compare(asm:FullName, fullName, StringComparison.OrdinalIgnoreCase) == 0
					RETURN asm
				ENDIF
			NEXT
			RETURN NULL

		STATIC METHOD FindAssemblyByName(fullName AS STRING) AS STRING
			FOREACH VAR item IN assemblies
				VAR asm := item:Value
				IF String.Compare(asm:FullName, fullName, StringComparison.OrdinalIgnoreCase) == 0
					RETURN asm:FullName
				ENDIF
			NEXT
			RETURN NULL

		STATIC METHOD FindAssemblyLocation(fullName AS STRING) AS STRING
			LOCAL info AS XAssembly
			FOREACH VAR pair IN assemblies
				info := pair:Value
				IF ! String.IsNullOrEmpty(info:FullName) .AND. (String.Compare(info:FullName, fullName, System.StringComparison.OrdinalIgnoreCase) == 0)
					RETURN pair:Key
				ENDIF
			NEXT
			RETURN NULL

      STATIC METHOD FindType(typeName as STRING, assemblyName as STRING) AS XTypeReference
         VAR assemblies := List<XAssembly>{}
         var asm := FindAssembly(assemblyName)
         IF asm != null
            assemblies:Add(asm)
            FOREACH var name in asm:ReferencedAssemblies
               var asm2 := FindAssembly(name)
               if asm2 != null
                  assemblies:Add(asm2)
               endif
            NEXT
         ENDIF
         IF assemblies:Count > 0
            RETURN FindType(typeName, List<String>{}, assemblies)
         ENDIF
         return NULL

		STATIC METHOD FindType(typeName AS STRING, usings AS IList<STRING>, assemblies AS IList<XAssembly>) AS XTypeReference
			LOCAL result := NULL AS XTypeReference
			TRY
				WriteOutputMessage("--> FindType() "+typeName)
				IF typeName:EndsWith(">") .AND.  typeName:Contains("<") .AND. typeName:Length > 2
					IF typeName:Length <= (typeName:Replace(">", ""):Length + 1)
						VAR elements := typeName:Split("<,>":ToCharArray(), System.StringSplitOptions.RemoveEmptyEntries)
						VAR num := (elements:Length - 1)
						typeName := elements[ 1] + "`" + num:ToString()
					ELSE
						VAR pos		   := typeName:IndexOf("<")
						VAR baseName   := typeName:Substring(0, pos)
						VAR typeParams := typeName:Substring(pos + 1)
						typeParams	   := typeParams:Substring(0, typeName:Length - 1):Trim()
						pos			   := typeParams:IndexOf("<")
						WHILE pos >= 0
							VAR pos2  := typeParams:LastIndexOf(">")
							typeParams := typeParams:Substring(0, pos) + typeParams:Substring(pos2 + 1):Trim()
							pos := typeParams:IndexOf("<")
						ENDDO
						VAR elements := typeParams:Split(",":ToCharArray())
						typeName := baseName + "`" + elements:Length:ToString()
					ENDIF
				ENDIF
				result := Lookup(typeName, assemblies)
				IF result != NULL
					RETURN result
				ENDIF
				IF usings != NULL
					FOREACH name AS STRING IN usings:Expanded()
						result := Lookup(name + "." + typeName, assemblies)
						IF result != NULL
							RETURN result
						ENDIF
					NEXT
				ENDIF
				IF assemblies != NULL
					FOREACH VAR asm IN assemblies
						IF asm:ImplicitNamespaces != NULL
							FOREACH strNs AS STRING IN asm:ImplicitNamespaces
								VAR fullName := strNs + "." + typeName
								result := Lookup(fullName, assemblies)
								IF result != NULL
									RETURN result
								ENDIF
							NEXT
						ENDIF
					NEXT
				ENDIF
				// Also Check into the Functions Class for Globals/Defines/...
				result := Lookup("Functions." + typeName, assemblies)
			CATCH e AS Exception
				XSolution.WriteException(e)
				result := NULL
			FINALLY
				WriteOutputMessage("<-- FindType() "+typeName+" " + IIF(result != NULL, result:FullName, "* not found *"))
			END TRY
			RETURN result

		STATIC METHOD GetNamespaces(assemblies AS IList<XAssembly>) AS IList<STRING>
			VAR list := List<STRING>{}
			FOREACH VAR info IN assemblies
				FOREACH str AS STRING IN info:Namespaces
					list:AddUnique( str)
				NEXT
			NEXT
			RETURN list:AsReadOnly()

		STATIC METHOD LoadAssembly(cFileName AS STRING) AS XAssembly
			LOCAL info AS XAssembly
			LOCAL lastWriteTime AS System.DateTime
			LOCAL key AS STRING
			//
			//WriteOutputMessage("<<-- LoadAssembly(string) "+cFileName)
			lastWriteTime := File.GetLastWriteTime(cFileName)
			IF assemblies:ContainsKey(cFileName)
				info := assemblies:Item[cFileName]
				//WriteOutputMessage("     ... assembly "+cFileName+" found in cache")
			ELSE
				info := XAssembly{cFileName, System.DateTime.MinValue}
				assemblies:TryAdd(cFileName, info)
			ENDIF
			IF cFileName:EndsWith("mscorlib.dll", System.StringComparison.OrdinalIgnoreCase)
				mscorlib := XAssembly{cFileName, System.DateTime.MinValue}
			ENDIF
			IF Path.GetFileName(cFileName):ToLower() == "system.dll"
				key := Path.Combine(Path.GetDirectoryName(cFileName), "mscorlib.dll")
				IF ! assemblies:ContainsKey(key) .AND. File.Exists(key)
					//WriteOutputMessage("LoadAssembly() load mscorlib from same location as system.DLL")
					LoadAssembly(key)
				ENDIF
			ENDIF
			//WriteOutputMessage(">>-- LoadAssembly(string) "+cFileName)
			RETURN info

		STATIC METHOD Lookup(typeName AS STRING, theirassemblies AS IList<XAssembly>) AS XTypeReference
			FOREACH VAR assembly IN theirassemblies
				assembly:Refresh()
 				VAR type := assembly:GetType(typeName)
				IF type != NULL
               RETURN type
				ENDIF
			NEXT
			IF mscorlib != NULL
				// check mscorlib
				RETURN mscorlib:GetType(typeName)
         ENDIF
         RETURN NULL

		STATIC METHOD RemoveAssembly(cFileName AS STRING) AS VOID
			LOCAL info AS XAssembly
			IF assemblies:ContainsKey(cFileName)
				assemblies:TryRemove(cFileName, OUT info)
			ENDIF

		STATIC METHOD UnloadUnusedAssemblies() AS VOID
			LOCAL unused AS List<STRING>
			unused := List<STRING>{}
			// collect list of assemblies which are no longer in use
			FOREACH VAR asm IN assemblies
				IF ! asm:Value:HasProjects
					unused:Add(asm:Key)
				ENDIF
			NEXT
			FOREACH key AS STRING IN unused
				LOCAL info AS XAssembly
				assemblies:TryRemove(key, OUT info)
			NEXT
			// when no assemblies left, then unload mscorlib
			IF assemblies:Count == 0
				mscorlib := NULL
			ENDIF
			//GC.Collect()

		STATIC METHOD WriteOutputMessage(message AS STRING) AS VOID
			XSolution.WriteOutputMessage("XModel.Typecontroller "+message)

		STATIC METHOD LookForExtensions(typeName AS STRING, theirassemblies AS IList<XAssembly>) AS IList<IXMember>
			// First Search for a system Type
         VAR pos := typeName:IndexOf('<')
         IF pos > 0
            typeName := typeName:Substring(0, pos)+"<>"

         ENDIF
         VAR result := List<IXMember>{}
			FOREACH VAR assembly IN theirassemblies
				assembly:Refresh()
				IF assembly:HasExtensions
               VAR ext := assembly:FindExtensionMethodsForType(typeName)
               result:AddRange(ext)
				ENDIF
			NEXT
			RETURN result

	END CLASS

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.Collections.Concurrent
USING System.Collections.Generic
USING System.Linq
USING System
USING System.IO
USING System.Reflection

BEGIN NAMESPACE XSharpModel
	/// <summary>
		/// We have one SystemTypeController in memory : It will handle all references types for all projects
		/// Assemblies are stored inside a List of AssemblyInfo
	/// </summary>
	CLASS SystemTypeController
		#region fields
		STATIC PRIVATE assemblies  AS ConcurrentDictionary<STRING, XAssembly>
		STATIC PRIVATE _mscorlib 	AS XAssembly
		#endregion

		STATIC CONSTRUCTOR
			assemblies := ConcurrentDictionary<STRING, XAssembly>{StringComparer.OrdinalIgnoreCase}
			_mscorlib := NULL
			RETURN

			#region properties
			// Properties
			STATIC PROPERTY AssemblyFileNames AS IList<STRING>
				GET
					RETURN SystemTypeController.assemblies:Keys:ToArray()
				END GET
			END PROPERTY
			STATIC PROPERTY mscorlib AS XAssembly GET _mscorlib SET _mscorlib := VALUE
		#endregion

		// Methods
		STATIC METHOD Clear() AS VOID
			assemblies:Clear()
			_mscorlib := NULL
         GC.Collect()

		STATIC METHOD FindAssemblyByLocation(location AS STRING) AS STRING
			IF assemblies:ContainsKey(location)
				RETURN assemblies:Item[location]:FullName
			ENDIF
			RETURN NULL

		STATIC METHOD FindAssembly(fullName AS STRING) AS XAssembly
			FOREACH VAR item IN assemblies
				VAR asm := item:Value
				IF String.Compare(asm:FullName, fullName, StringComparison.OrdinalIgnoreCase) == 0
					RETURN asm
				ENDIF
			NEXT
			RETURN NULL

		STATIC METHOD FindAssemblyByName(fullName AS STRING) AS STRING
			FOREACH VAR item IN assemblies
				VAR asm := item:Value
				IF String.Compare(asm:FullName, fullName, StringComparison.OrdinalIgnoreCase) == 0
					RETURN asm:FullName
				ENDIF
			NEXT
			RETURN NULL

		STATIC METHOD FindAssemblyLocation(fullName AS STRING) AS STRING
			LOCAL info AS XAssembly
			FOREACH VAR pair IN assemblies
				info := pair:Value
				IF ! String.IsNullOrEmpty(info:FullName) .AND. (String.Compare(info:FullName, fullName, System.StringComparison.OrdinalIgnoreCase) == 0)
					RETURN pair:Key
				ENDIF
			NEXT
			RETURN NULL

      STATIC METHOD FindType(typeName as STRING, assemblyName as STRING) AS XTypeReference
         VAR assemblies := List<XAssembly>{}
         var asm := FindAssembly(assemblyName)
         IF asm != null
            assemblies:Add(asm)
            FOREACH var name in asm:ReferencedAssemblies
               var asm2 := FindAssembly(name)
               if asm2 != null
                  assemblies:Add(asm2)
               endif
            NEXT
         ENDIF
         IF assemblies:Count > 0
            RETURN FindType(typeName, List<String>{}, assemblies)
         ENDIF
         return NULL

		STATIC METHOD FindType(typeName AS STRING, usings AS IList<STRING>, assemblies AS IList<XAssembly>) AS XTypeReference
			LOCAL result := NULL AS XTypeReference
			TRY
				WriteOutputMessage("--> FindType() "+typeName)
				IF typeName:EndsWith(">") .AND.  typeName:Contains("<") .AND. typeName:Length > 2
					IF typeName:Length <= (typeName:Replace(">", ""):Length + 1)
						VAR elements := typeName:Split("<,>":ToCharArray(), System.StringSplitOptions.RemoveEmptyEntries)
						VAR num := (elements:Length - 1)
						typeName := elements[ 1] + "`" + num:ToString()
					ELSE
						VAR pos		   := typeName:IndexOf("<")
						VAR baseName   := typeName:Substring(0, pos)
						VAR typeParams := typeName:Substring(pos + 1)
						typeParams	   := typeParams:Substring(0, typeName:Length - 1):Trim()
						pos			   := typeParams:IndexOf("<")
						WHILE pos >= 0
							VAR pos2  := typeParams:LastIndexOf(">")
							typeParams := typeParams:Substring(0, pos) + typeParams:Substring(pos2 + 1):Trim()
							pos := typeParams:IndexOf("<")
						ENDDO
						VAR elements := typeParams:Split(",":ToCharArray())
						typeName := baseName + "`" + elements:Length:ToString()
					ENDIF
				ENDIF
				result := Lookup(typeName, assemblies)
				IF result != NULL
					RETURN result
				ENDIF
				IF usings != NULL
					FOREACH name AS STRING IN usings:Expanded()
						result := Lookup(name + "." + typeName, assemblies)
						IF result != NULL
							RETURN result
						ENDIF
					NEXT
				ENDIF
				IF assemblies != NULL
					FOREACH VAR asm IN assemblies
						IF asm:ImplicitNamespaces != NULL
							FOREACH strNs AS STRING IN asm:ImplicitNamespaces
								VAR fullName := strNs + "." + typeName
								result := Lookup(fullName, assemblies)
								IF result != NULL
									RETURN result
								ENDIF
							NEXT
						ENDIF
					NEXT
				ENDIF
				// Also Check into the Functions Class for Globals/Defines/...
				result := Lookup("Functions." + typeName, assemblies)
			CATCH e AS Exception
				XSolution.WriteException(e)
				result := NULL
			FINALLY
				WriteOutputMessage("<-- FindType() "+typeName+" " + IIF(result != NULL, result:FullName, "* not found *"))
			END TRY
			RETURN result

		STATIC METHOD GetNamespaces(assemblies AS IList<XAssembly>) AS IList<STRING>
			VAR list := List<STRING>{}
			FOREACH VAR info IN assemblies
				FOREACH str AS STRING IN info:Namespaces
					list:AddUnique( str)
				NEXT
			NEXT
			RETURN list:AsReadOnly()

		STATIC METHOD LoadAssembly(cFileName AS STRING) AS XAssembly
			LOCAL info AS XAssembly
			LOCAL lastWriteTime AS System.DateTime
			LOCAL key AS STRING
			//
			//WriteOutputMessage("<<-- LoadAssembly(string) "+cFileName)
			lastWriteTime := File.GetLastWriteTime(cFileName)
			IF assemblies:ContainsKey(cFileName)
				info := assemblies:Item[cFileName]
				//WriteOutputMessage("     ... assembly "+cFileName+" found in cache")
			ELSE
				info := XAssembly{cFileName, System.DateTime.MinValue}
				assemblies:TryAdd(cFileName, info)
			ENDIF
			IF cFileName:EndsWith("mscorlib.dll", System.StringComparison.OrdinalIgnoreCase)
				mscorlib := XAssembly{cFileName, System.DateTime.MinValue}
			ENDIF
			IF Path.GetFileName(cFileName):ToLower() == "system.dll"
				key := Path.Combine(Path.GetDirectoryName(cFileName), "mscorlib.dll")
				IF ! assemblies:ContainsKey(key) .AND. File.Exists(key)
					//WriteOutputMessage("LoadAssembly() load mscorlib from same location as system.DLL")
					LoadAssembly(key)
				ENDIF
			ENDIF
			//WriteOutputMessage(">>-- LoadAssembly(string) "+cFileName)
			RETURN info

		STATIC METHOD Lookup(typeName AS STRING, theirassemblies AS IList<XAssembly>) AS XTypeReference
			FOREACH VAR assembly IN theirassemblies
				assembly:Refresh()
 				VAR type := assembly:GetType(typeName)
				IF type != NULL
               RETURN type
				ENDIF
			NEXT
			IF mscorlib != NULL
				// check mscorlib
				RETURN mscorlib:GetType(typeName)
         ENDIF
         RETURN NULL

		STATIC METHOD RemoveAssembly(cFileName AS STRING) AS VOID
			LOCAL info AS XAssembly
			IF assemblies:ContainsKey(cFileName)
				assemblies:TryRemove(cFileName, OUT info)
			ENDIF

		STATIC METHOD UnloadUnusedAssemblies() AS VOID
			LOCAL unused AS List<STRING>
			unused := List<STRING>{}
			// collect list of assemblies which are no longer in use
			FOREACH VAR asm IN assemblies
				IF ! asm:Value:HasProjects
					unused:Add(asm:Key)
				ENDIF
			NEXT
			FOREACH key AS STRING IN unused
				LOCAL info AS XAssembly
				assemblies:TryRemove(key, OUT info)
			NEXT
			// when no assemblies left, then unload mscorlib
			IF assemblies:Count == 0
				mscorlib := NULL
			ENDIF
			GC.Collect()

		STATIC METHOD WriteOutputMessage(message AS STRING) AS VOID
			XSolution.WriteOutputMessage("XModel.Typecontroller "+message)

		STATIC METHOD LookForExtensions(typeName AS STRING, theirassemblies AS IList<XAssembly>) AS IList<IXMember>
			// First Search for a system Type
         VAR pos := typeName:IndexOf('<')
         IF pos > 0
            typeName := typeName:Substring(0, pos)+"<>"

         ENDIF
         VAR result := List<IXMember>{}
			FOREACH VAR assembly IN theirassemblies
				assembly:Refresh()
				IF assembly:HasExtensions
               VAR ext := assembly:FindExtensionMethodsForType(typeName)
               result:AddRange(ext)
				ENDIF
			NEXT
			RETURN result

	END CLASS

END NAMESPACE


QtMacExtras: module updated (macros)

QtMacExtras: module updated (macros)

Modified:
source/QtMacExtras/QMacPasteboardMime.prg

/*

  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"

#ifndef QT5XHB_NO_REQUESTS
REQUEST QVARIANT
REQUEST QBYTEARRAY
#endif

CLASS QMacPasteboardMime

   DATA pointer
   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_macros.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( RQSTRING( obj->convertorName () ) );
  }
#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 )
  {
    RBOOL( obj->canConvert ( PQSTRING(1), PQSTRING(2) ) );
  }
#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 )
  {
    hb_retc( RQSTRING( obj->mimeFor ( PQSTRING(1) ) ) );
  }
#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 )
  {
    hb_retc( RQSTRING( obj->flavorFor ( PQSTRING(1) ) ) );
  }
#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 )
  {
    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 ) );
    }
    QVariant * ptr = new QVariant( obj->convertToMime ( PQSTRING(1), par2, PQSTRING(3) ) );
    _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 )
  {
    QList<QByteArray> list = obj->convertFromMime ( PQSTRING(1), *PQVARIANT(2), PQSTRING(3) );
    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"

#ifndef QT5XHB_NO_REQUESTS
REQUEST QVARIANT
REQUEST QBYTEARRAY
#endif

CLASS QMacPasteboardMime

   DATA pointer
   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_macros.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( RQSTRING( obj->convertorName () ) );
  }
#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 )
  {
    hb_retl( obj->canConvert ( PQSTRING(1), PQSTRING(2) ) );
  }
#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 )
  {
    hb_retc( RQSTRING( obj->mimeFor ( PQSTRING(1) ) ) );
  }
#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 )
  {
    hb_retc( RQSTRING( obj->flavorFor ( PQSTRING(1) ) ) );
  }
#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 )
  {
    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 ) );
    }
    QVariant * ptr = new QVariant( obj->convertToMime ( PQSTRING(1), par2, PQSTRING(3) ) );
    _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 )
  {
    QList<QByteArray> list = obj->convertFromMime ( PQSTRING(1), *PQVARIANT(2), PQSTRING(3) );
    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


[Runtime] Add Mod() function that accepts USUAL parameters

//
// 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.
//

/// <summary>
/// </summary>
/// <param name="f"></param>
/// <returns>
/// </returns>
FUNCTION Float2Long(f AS USUAL) AS LONG
    LOCAL flValue AS FLOAT
    flValue := (FLOAT) f
    RETURN (LONG) flValue

/// <include file="VoFunctionDocs.xml" path="Runtimefunctions/abs/*" />
FUNCTION Abs(nValue AS USUAL) AS USUAL
    LOCAL uRet AS USUAL
    IF nValue:IsInt64
        uRet := Math.Abs( (INT64) nValue )
    ELSEIF nValue:IsDecimal
        uRet := Math.Abs( (Decimal) nValue)
    ELSEIF nValue:IsCurrency
        uRet := __Currency{Math.Abs( (Decimal) (__Currency) nValue)}
    ELSEIF nValue:IsInteger
        uRet := Math.Abs( (INT) nValue )
    ELSEIF nValue:IsFloat
        uRet := AbsFloat( nValue )
    ELSE
        THROW  Error.ArgumentError( __FUNCTION__, NAMEOF(nValue), "Argument not numeric",1)
    ENDIF
    RETURN uRet

/// <include file="VoFunctionDocs.xml" path="Runtimefunctions/acot/*" />
FUNCTION ACot(nNum AS USUAL) AS FLOAT
    RETURN 2 * Math.Atan(1) + Math.Atan( (REAL8) nNum)

/// <include file="VoFunctionDocs.xml" path="Runtimefunctions/atan/*" />
FUNCTION ATan(nNum AS USUAL) AS FLOAT
    RETURN Math.Atan((REAL8)nNum)

/// <include file="VoFunctionDocs.xml" path="Runtimefunctions/acos/*" />
FUNCTION ACos(nExpression AS USUAL) AS FLOAT
    RETURN Math.Acos((REAL8) nExpression)

/// <include file="VoFunctionDocs.xml" path="Runtimefunctions/asin/*" />
FUNCTION ASin(nExpression AS USUAL) AS FLOAT
    RETURN Math.Asin((REAL8) nExpression)

/// <include file="VoFunctionDocs.xml" path="Runtimefunctions/atan2/*" />
FUNCTION Atan2(nY as USUAL, nX AS USUAL) AS FLOAT
    RETURN Math.Atan2((REAL8) nY, (REAL8) nX)

/// <include file="VoFunctionDocs.xml" path="Runtimefunctions/dtor/*" />
FUNCTION DToR(nExpression as USUAL) AS REAL8
    RETURN (Real8) nExpression / 180.0 * Math.PI

/// <include file="VoFunctionDocs.xml" path="Runtimefunctions/rtod/*" />
FUNCTION RToD(nExpression as USUAL) AS REAL8
    RETURN ((REAL8) nExpression / Math.PI) * 180.0

/// <include file="VoFunctionDocs.xml" path="Runtimefunctions/pi/*" />
FUNCTION PI() AS REAL8
    RETURN Math.PI

/// <include file="VoFunctionDocs.xml" path="Runtimefunctions/ceil/*" />
FUNCTION Ceil(nNumber AS USUAL) AS USUAL
    LOCAL result AS USUAL
    IF nNumber:IsInteger
        result := nNumber
    ELSEIF nNumber:IsDecimal .OR. nNumber:IsCurrency
        LOCAL d AS DECIMAL
        IF (nNumber:IsDecimal)
            d := (DECIMAL) nNumber
        ELSE
            d := (DECIMAL) (CURRENCY) nNumber
        ENDIF
        d := Math.Ceiling(d)
        IF d <= Int32.MaxValue .AND. d >= Int32.MinValue
            result := Convert.ToInt32(d)
        ELSEIF d <= Int64.MaxValue .AND. d >= Int64.MinValue
            result := Convert.ToInt64(d)
        ELSE
            result := d
        ENDIF

    ELSEIF nNumber:IsFloat
        LOCAL r8 AS REAL8
        r8 := (FLOAT) nNumber
        r8 := Math.Ceiling(r8)
        IF r8 <= Int32.MaxValue .AND. r8 >= Int32.MinValue
            result := Convert.ToInt32(r8)
        ELSEIF r8 <= Int64.MaxValue .AND. r8 >= Int64.MinValue
            result := Convert.ToInt64(r8)
        ELSE
            result := r8
        ENDIF
    ELSE
        THROW  Error.ArgumentError( __FUNCTION__, NAMEOF(nNumber), "Argument not numeric",1)
    ENDIF
    RETURN result

/// <include file="VoFunctionDocs.xml" path="Runtimefunctions/cos/*" />
FUNCTION Cos(nNum AS USUAL) AS FLOAT
    RETURN Math.Cos((REAL8)nNum)

/// <include file="VoFunctionDocs.xml" path="Runtimefunctions/cot/*" />
FUNCTION Cot(nNum AS USUAL) AS FLOAT
    RETURN 2 * Math.Atan( 1 ) + Math.Atan( (REAL8)nNum)

/// <include file="VoFunctionDocs.xml" path="Runtimefunctions/exp/*" />
FUNCTION Exp(nExponent AS USUAL) AS FLOAT
    RETURN Math.Exp((REAL8)nExponent)

/// <include file="VoFunctionDocs.xml" path="Runtimefunctions/floor/*" />
FUNCTION Floor(nNum AS USUAL) AS USUAL
    LOCAL result AS USUAL
    IF nNum:IsInteger
        result := nNum
    ELSEIF nNum:IsDecimal .OR. nNum:IsCurrency
        LOCAL d AS DECIMAL
        IF (nNum:IsDecimal)
            d := (DECIMAL) nNum
        ELSE
            d := (DECIMAL) (CURRENCY) nNum
        ENDIF
        d := Math.Floor(d)
        IF d <= Int32.MaxValue .AND. d >= Int32.MinValue
            result := Convert.ToInt32(d)
        ELSEIF d <= Int64.MaxValue .AND. d >= Int64.MinValue
            result := Convert.ToInt64(d)
        ELSE
            result := d
        ENDIF

    ELSEIF nNum:IsFloat
        LOCAL r8 AS REAL8
        r8 := (FLOAT) nNum
        r8 := Math.Floor(r8)
        IF r8 <= Int32.MaxValue .AND. r8 >= Int32.MinValue
            result := Convert.ToInt32(r8)
        ELSEIF r8 <= Int64.MaxValue .AND. r8 >= Int64.MinValue
            result := Convert.ToInt64(r8)
        ELSE
            result := r8
        ENDIF
    ELSE
        THROW  Error.ArgumentError( __FUNCTION__, NAMEOF(nNum), "Argument not numeric",1)
    ENDIF
    RETURN result

/// <include file="VoFunctionDocs.xml" path="Runtimefunctions/integer/*" />
FUNCTION Integer(nValue AS USUAL) AS USUAL
    LOCAL result AS USUAL
    IF nValue:IsInteger
        result := nValue
    ELSEIF nValue:IsFractional
        IF nValue > 0.0
            result := Floor(nValue)
        ELSE
            result := Ceil(nValue)
        ENDIF
    ELSE
        THROW Error.ArgumentError( __FUNCTION__, NAMEOF(nValue), "Argument not numeric",1)
    ENDIF
    RETURN result

/// <include file="VoFunctionDocs.xml" path="Runtimefunctions/log/*" />
FUNCTION LOG(nValue AS USUAL) AS FLOAT
    RETURN Math.Log((REAL8)nValue)

/// <include file="VoFunctionDocs.xml" path="Runtimefunctions/log10/*" />
FUNCTION Log10(nValue AS USUAL) AS FLOAT
    RETURN Math.Log10((REAL8)nValue)

/// <include file="VoFunctionDocs.xml" path="Runtimefunctions/pow/*" />
FUNCTION Pow(nBase AS USUAL,nExponent AS USUAL) AS FLOAT
    RETURN Math.Pow((REAL8)nBase, (REAL8)nExponent)

INTERNAL GLOBAL _randomGenerator AS Random
/// <include file="VoFunctionDocs.xml" path="Runtimefunctions/rand/*" />
FUNCTION Rand(nSeed AS USUAL) AS FLOAT
    IF !nSeed:IsNumeric .OR. nSeed <= 0
        nSeed := (INT) DateTime.Now:Ticks
    ENDIF
    _randomGenerator := Random{ nSeed }
    RETURN _randomGenerator:NextDouble()
/// <include file="VoFunctionDocs.xml" path="Runtimefunctions/rand/*" />
FUNCTION Rand() AS FLOAT
    IF _randomGenerator == NULL
        _randomGenerator := Random{ 100001 }
    ENDIF
    RETURN _randomGenerator:NextDouble()

    #define MAX_DECIMALS 15
/// <include file="VoFunctionDocs.xml" path="Runtimefunctions/round/*" />
FUNCTION Round(nNumber AS USUAL,siDecimals AS INT) AS USUAL
    LOCAL ret    AS USUAL
    LOCAL IsLong   AS LOGIC
    LOCAL IsInt64  AS LOGIC
    LOCAL r8     AS REAL8

    IF ! nNumber:IsNumeric
        THROW Error.ArgumentError( __FUNCTION__, NAMEOF(nNumber), "Argument is not numeric")
    ENDIF

    // For Integers we could round the numbers
    // Round(12345, -1) -> 12350
    IsInt64 := nNumber:IsInt64
    IsLong  := nNumber:IsLong
    r8  := nNumber

    IF siDecimals > 0
        // Round after decimal point
        IF siDecimals > MAX_DECIMALS
            siDecimals := MAX_DECIMALS
        ENDIF

        r8 := (REAL8) Math.Round( (System.Decimal) r8, siDecimals, MidpointRounding.AwayFromZero )
    ELSE
        // Round before decimal point
        siDecimals := -siDecimals

        IF siDecimals > MAX_DECIMALS
            siDecimals := MAX_DECIMALS
        ENDIF

        r8 := r8 / ( 10 ^ siDecimals )
        r8 := Math.Round( r8, 0, MidpointRounding.AwayFromZero )
        r8 := r8 * ( 10 ^ siDecimals )

        IF r8 < 0
            IsLong	:= r8 >= Int32.MinValue
            IsInt64 := r8 >= Int64.MinValue
        ELSE
            IsLong  := r8 <= Int32.MaxValue
            IsInt64 := r8 <= Int64.MaxValue
        ENDIF
        siDecimals := 0
    ENDIF

    IF IsLong .OR. IsInt64
        siDecimals := 0
    ENDIF

    IF siDecimals == 0
        IF IsLong
            ret := (INT) r8
        ELSEIF IsInt64
            ret := (INT64) r8
        ELSE
            ret := FLOAT{r8, 0}
        ENDIF
    ELSE
        ret := FLOAT{r8, siDecimals}
    ENDIF

    RETURN ret

/// <include file="VoFunctionDocs.xml" path="Runtimefunctions/sin/*" />
FUNCTION Sin(nNum AS USUAL) AS FLOAT
    RETURN Math.Sin((REAL8)nNum)

/// <include file="VoFunctionDocs.xml" path="Runtimefunctions/sqrt/*" />
FUNCTION SQrt(nNumber AS USUAL) AS FLOAT
    RETURN Math.Sqrt((REAL8)nNumber)

/// <include file="VoFunctionDocs.xml" path="Runtimefunctions/tan/*" />
FUNCTION Tan(nNum AS USUAL) AS FLOAT
    RETURN Math.Tan((REAL8)nNum)

/// <include file="VoFunctionDocs.xml" path="Runtimefunctions/mod/*" />
FUNCTION Mod(nDividend AS USUAL, nDivisor AS USUAL) AS USUAL
local resType := __UsualType.Void as __UsualType
switch nDividend:_usualType
CASE __UsualType.Long
    switch nDivisor:_usualType
    CASE __UsualType.Long
        resType := __UsualType.Long
    CASE __UsualType.Int64
        resType := __UsualType.Int64
    CASE __UsualType.Float
        resType := __UsualType.Float
    CASE __UsualType.Currency
        resType := __UsualType.Currency
    CASE __UsualType.Decimal
        resType := __UsualType.Decimal
    end switch
CASE __UsualType.Int64
    switch nDivisor:_usualType
    CASE __UsualType.Long
    CASE __UsualType.Int64
        resType := __UsualType.Int64
    CASE __UsualType.Float
        resType := __UsualType.Float
    CASE __UsualType.Currency
        resType := __UsualType.Currency
    CASE __UsualType.Decimal
        resType := __UsualType.Decimal
    end switch
CASE __UsualType.Float
    switch nDivisor:_usualType
    CASE __UsualType.Long
    CASE __UsualType.Int64
    CASE __UsualType.Float
        resType := __UsualType.Float
    CASE __UsualType.Currency
        resType := __UsualType.Currency
    CASE __UsualType.Decimal
        resType := __UsualType.Decimal
    end switch
CASE __UsualType.Currency
    resType := __UsualType.Currency
CASE __UsualType.Decimal
    resType := __UsualType.Decimal
end switch

switch resType
CASE __UsualType.Long
    RETURN (LONG) nDividend % (LONG) nDivisor
CASE __UsualType.Int64
    RETURN (INT64) nDividend % (INT64) nDivisor
CASE __UsualType.Float
    RETURN (FLOAT) nDividend % (FLOAT) nDivisor
CASE __UsualType.Currency
    RETURN (CURRENCY) nDividend % (CURRENCY) nDivisor
CASE __UsualType.Decimal
    RETURN (DECIMAL) nDividend % (DECIMAL) nDivisor
end switch
IF !IsNumeric(nDividend)
    THROW Error.ArgumentError("Mod", nameof(nDividend),"nDividend must be numeric")
endif
THROW Error.ArgumentError("Mod", nameof(nDivisor),"nDivisor must be numeric")


[runtime tests] Added more dbf tests

[runtime tests] Added more dbf tests

//
// 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.Globalization

BEGIN NAMESPACE XSharp.VO.Tests

	CLASS DbfTests

		[Fact, Trait("Category", "DBFFuncs")];
		METHOD DBCreate_Tests() AS VOID
			LOCAL aFields AS ARRAY
			aFields := {{"TEST","C",10,0}}

			LOCAL cFileName_WithExt AS STRING
			LOCAL cFileName_NoExt AS STRING
			cFileName_NoExt := "DBCreate_Tests"
			cFileName_WithExt := cFileName_NoExt + ".dbf"
			IF System.IO.File.Exists(cFileName_WithExt)
				System.IO.File.Delete(cFileName_WithExt)
			END IF
			Assert.True(  DBCreate(cFileName_NoExt , aFields , "DBFNTX")  )
			Assert.True(  System.IO.File.Exists(cFileName_WithExt) )

			IF System.IO.File.Exists(cFileName_WithExt)
				System.IO.File.Delete(cFileName_WithExt)
			END IF
			Assert.True(  DBCreate(cFileName_WithExt , aFields , "DBFNTX")  )
			Assert.True(  System.IO.File.Exists(cFileName_WithExt) )

			cFileName_WithExt := cFileName_NoExt + ".none"
			IF System.IO.File.Exists(cFileName_WithExt)
				System.IO.File.Delete(cFileName_WithExt)
			END IF
			Assert.True(  DBCreate(cFileName_WithExt , aFields , "DBFNTX")  )
			Assert.True(  System.IO.File.Exists(cFileName_WithExt) )
		RETURN

		[Fact, Trait("Category", "DBFFuncs")];
		METHOD DBAppend_Exclusive() AS VOID
			LOCAL aFields AS ARRAY
			LOCAL cFileName AS STRING
			aFields := {{"TEST","C",10,0}}
			cFileName := "DBAppend_Exclusive"

			Assert.True(  DBCreate(cFileName , aFields , "DBFNTX")  )
			Assert.True(  DBUseArea(,"DBFNTX",cFileName,,FALSE) )
			Assert.True(  RecCount() == 0 )
			Assert.True(  DBAppend() )
			FieldPut(1 , "test")
			Assert.True(  AllTrim(FieldGet(1)) == "test" )
			Assert.True(  DBCloseArea() )
		RETURN

		[Fact, Trait("Category", "DBFFuncs")];
		METHOD DBAppend_Shared() AS VOID
			LOCAL aFields AS ARRAY
			LOCAL cFileName AS STRING
			aFields := {{"TEST","C",10,0}}
			cFileName := "DBAppend_Shared"

			Assert.True(  DBCreate(cFileName , aFields , "DBFNTX")  )
			Assert.True(  DBUseArea(,"DBFNTX",cFileName,,TRUE) )
			Assert.True(  RecCount() == 0 )
			Assert.True(  DBAppend() )
			FieldPut(1 , "test")
			Assert.True(  AllTrim(FieldGet(1)) == "test" )
			Assert.True(  DBCloseArea() )
		RETURN

		[Fact, Trait("Category", "DBFFuncs")];
		METHOD DBAppend_more() AS VOID
		LOCAL cDbf AS STRING
			cDbf := "testappend.DbF"
			RDDSetDefault( "DBFNTX" )
			Assert.True(  DBCreate(cDbf , { {"TEST","C",10,0} }) )
			// Appending in exclusive mode:
			Assert.True( DBUseArea(, , cDbf , "alias1" , FALSE) )
			Assert.True( DBAppend() )
			Assert.True( RecCount() == 1 )
			FieldPut(1, "test") // ok
			Assert.True( AllTrim(FieldGet(1)) == "test" )
			Assert.True( DBCloseArea() )

			// Appending in SHARED mode:
			Assert.True( DBUseArea(, , cDbf , "alias2" , TRUE) )
			Assert.True( RecCount() == 1 )
			Assert.True( DBAppend() )// returns true but does not append record
			Assert.True( RecCount() == 2 )
			FieldPut(1, "test2") // ok
			Assert.True( AllTrim(FieldGet(1)) == "test2" )
			Assert.True( DBCloseArea() )
		RETURN

		[Fact, Trait("Category", "DBFFuncs")];
		METHOD DBUseArea_same_file_twice() AS VOID
		LOCAL cDbf AS STRING
			RDDSetDefault( "DBFNTX" )
			cDbf := "testtwice.DbF"
			Assert.True(  DBCreate(cDbf , { {"TEST","C",10,0} }) )

			// shared mode
			Assert.True( DBUseArea(, , cDbf , , FALSE) )
			Assert.True( DBCloseArea() )

			Assert.True( DBUseArea(, , cDbf , , FALSE) )
			Assert.True( DBCloseArea() )
		RETURN

		// TECH-K3TL5J8M7V
		[Fact, Trait("Category", "DBF")];
		METHOD VODBInfo() AS VOID

			LOCAL cFileName AS STRING
			cFileName := GetTempFileame("test")
			DBCreate(cFileName , { {"CFIELD","C",10,0} })
			DBUseArea(,,cFileName)
			DBAppend()

			LOCAL u AS USUAL
			VODBSkip(-1)

			VODBInfo(DBI_FULLPATH , REF u)
			LOCAL c AS STRING
			c := u
			? c
			Assert.True(c:EndsWith("test.DBF") .and. c:Contains(":\"))
			VODBInfo(DBI_DB_VERSION , REF u)
			Assert.True(SLen(u) > 1)
			VODBInfo(DBI_ALIAS , REF u)
			Assert.Equal("test" , u)

			VODBInfo(DBI_BOF , REF u)
			Assert.Equal(TRUE , u)
			VODBInfo(DBI_EOF , REF u)
			Assert.Equal(FALSE , u)
			VODBInfo(DBI_ISANSI , REF u)
			Assert.Equal(SetAnsi() , u)
			VODBInfo(DBI_FCOUNT , REF u)
			Assert.Equal(1, u)
			VODBInfo(DBI_READONLY , REF u)
			Assert.Equal(FALSE, u)

			DBCloseArea()
		RETURN

		// TECH-E6Y9GNHB99
		[Fact, Trait("Category", "DBF")];
		METHOD AppendShared() AS VOID
			LOCAL cDbf AS STRING
			cDbf := GetTempFileame("testAppendShared")
			RDDSetDefault( "DBFNTX" )
			DBCreate(cDbf , { {"TEST","C",10,0} })

//			Appending in exclusive mode:
			DBUseArea(, , cDbf , "alias2" , FALSE)
			LOCAL lRet AS LOGIC
			Assert.True( DBAppend() )
			Assert.Equal( 1 , RecCount() )
			FieldPut(1, "test") // ok
			DBCloseArea()

//			Appending in SHARED mode:
			DBUseArea(, , cDbf , "alias2" , TRUE)
			Assert.True( DBAppend() ) // returns true but does not append record
			Assert.Equal( 2 , RecCount() ) // returns 1, wrong
			DBCloseArea()
		RETURN

		// TECH-6U40UQ0JV3
		[Fact, Trait("Category", "DBF")];
		METHOD AliasNameReuse() AS VOID
			LOCAL cDbf AS STRING
			cDbf := GetTempFileame("testdbf")

			RDDSetDefault( "DBFNTX" )

			DBCreate(cDbf , { {"TEST","C",10,0} })

//			opening and closing once
			DBUseArea(, , cDbf , , FALSE)
			DBCloseArea()

//			opening and closing again
			Assert.True( DBUseArea(, , cDbf , , FALSE) )
			Assert.True( DBCloseArea() )
		RETURN

		// TECH-SAK5955895
		[Fact, Trait("Category", "DBF")];
		METHOD SavingDecimalValues() AS VOID
			LOCAL cFileName AS STRING
			cFileName := GetTempFileame("mydbf.dbf")
			DBCreate(cFileName, {{"FLD1","N",10,2},{"FLD2","N",10,0}})
			DBUseArea(,,cFileName)
			DBAppend()

			SetDecimalSep(Asc(","))
			FieldPut(1 , 12.34) // not saved in the dbf
			Assert.Equal(12.34 , FieldGet(1)) // 0,00

			SetDecimalSep(Asc("."))
			FieldPut(1 , 12.34)
			Assert.Equal(12.34 , FieldGet(1))

			DBCloseArea()
		RETURN

		// TECH-C8WB52EA4A , Runtime exception when reading from a float field, after writing to it and DBCommit()
		[Fact, Trait("Category", "DBF")];
		METHOD DBCommitAfterFieldput() AS VOID
			LOCAL cFileName AS STRING
			cFileName := GetTempFileame("mydbf1.dbf")
			DBCreate(cFileName, {{"FLD1","N",10,4}})
			DBUseArea( , , cFileName , "tempalias")
			DBAppend()
			DBCloseArea()

			DBUseArea( , , cFileName)
			FieldPut(1 , 46.11) // ! a float isn/t stored !
			DBCommit()
			Assert.Equal(46.11 , FieldGet(1)) // runtime exception
			DBCloseArea()
		RETURN

		// TECH-J61EXJ870D , FieldName() and FieldSym() throw an exception with incorrect field no
		[Fact, Trait("Category", "DBF")];
		METHOD FieldNameSym() AS VOID
			LOCAL cFileName AS STRING
			cFileName := GetTempFileame("mydbf4.dbf")
			DBCreate(cFileName, {{"FLD1","N",10,4}})
			DBUseArea( , , cFileName , "tempalias")
			DBAppend()
			Assert.Equal("", FieldName(100)) // exception
			Assert.Equal("", FieldName(0))
			Assert.Equal(NULL_SYMBOL, FieldSym(100))
			Assert.Equal(NULL_SYMBOL, FieldSym(0))
			DBCloseArea()
		RETURN

		// TECH-560ANYQI2P , DBRLockList() always returns zero
		[Fact, Trait("Category", "DBF")];
		METHOD DBRLockList() AS VOID
			LOCAL cFileName AS STRING
			cFileName := GetTempFileame("mydbf3.dbf")
			DBCreate(cFileName, {{"FLD1","C",10,0}})
			DBUseArea( , , cFileName , "tempalias" , TRUE)
			DBAppend()
			DBAppend()
			DBGoTop()
			DBRLock()
			DBRLockList()
			Assert.Equal(1, ALen(DBRLockList()))
			Assert.Equal(1, DBRLockList()[1])
			DBUnlock()
			DBSkip()
			DBRLock()
			Assert.Equal(1, ALen(DBRLockList()))
			Assert.Equal(2, DBRLockList()[1])
			DBCloseArea()
		RETURN

		// TECH-34OWD3RR1Z , DBF problems with filters
		[Fact, Trait("Category", "DBF")];
		METHOD DBFilter() AS VOID
			LOCAL cDbf AS STRING
			cDbf := GetTempFileame("testdbf6.dbf")
			IF System.IO.File.Exists(cDbf)
				System.IO.File.Delete(cDbf)
			END IF
			DBCreate(cDbf, {{"CFIELD","C",10,0}}, "DBFNTX", TRUE)
			DBAppend()
			FieldPut(1, "ABC")
			DBAppend()
			FieldPut(1, "DEF")
			DBAppend()
			FieldPut(1, "GHI")
			DBAppend()
			FieldPut(1, "JKL")
			Assert.Equal(4 , RecCount())
			Assert.Equal(4 , LastRec())
			DBCloseArea()

			DBUseArea(,,cDbf)
//			"Setting filter to GHI, should be one record:"
//			"Instead, record 1 and 3 are shown"
			DBSetFilter({||AllTrim(FIELD->CFIELD) == "GHI"})
			DBGoTop()
			LOCAL nCount := 0 AS INT
			DO WHILE .not. EoF()
				Assert.Equal(3 , RecNo())
				FieldGet(1)
				DBSkip(+1)
				nCount ++
			END DO
			Assert.Equal(1 , nCount)

			DBGoBottom()
			Assert.False( EOF() )
			nCount := 0
			DO WHILE .not. EoF()
				Assert.Equal(3 , RecNo())
				nCount ++
				FieldGet(1)
				DBSkip(+1)
			END DO
			Assert.Equal(1 , nCount)

			DBCloseArea()
		RETURN

		// TECH-8C175D53DN , DBRecordInfo() always returns NULL_OBJECT
		[Fact, Trait("Category", "DBF")];
		METHOD DBRecordInfo_test() AS VOID
			LOCAL cDbf AS STRING
			LOCAL l AS LOGIC
			cDbf := GetTempFileame("testdbf7.dbf")
			DBCreate(cDbf, {{"CFIELD","C",10,0}}, "DBFNTX", TRUE)
			DBAppend()
			FieldPut(1, "ABC")

			l := DBRecordInfo( DBRI_RECNO ) // exception
			Assert.True(l)
			l := DBRecordInfo( DBRI_DELETED ) // exception
			Assert.False(l)
			l := DBRecordInfo( DBRI_LOCKED ) // exception
			Assert.True(l)

			DBCloseArea()
		RETURN

		// TECH-NVMBVB2Y44 , NullReferenceExpetion with DBFieldInfo()
		[Fact, Trait("Category", "DBF")];
		METHOD DBFieldInfo_test() AS VOID
			LOCAL cDbf AS STRING
			cDbf := GetTempFileame("testdbf8.dbf")
			DBCreate(cDbf, {{"NFIELD","N",10,3}}, "DBFNTX", TRUE)
			DBAppend()
			FieldPut(1, "ABC")

			Assert.Equal("NFIELD",	DBFieldInfo( DBS_NAME , 1 ) ) // NullReferenceException
			Assert.Equal("N",		DBFieldInfo( DBS_TYPE , 1 ) )
			Assert.Equal(10,		DBFieldInfo( DBS_LEN , 1 ) )
			Assert.Equal(3,			DBFieldInfo( DBS_DEC , 1 ) )
			Assert.Equal(5,			DBFieldInfo( DBS_PROPERTIES , 1 ) )

			DBCloseArea()
		RETURN

		// TECH-52M9YX557W , DBRecordInfo() changes record pointer
		[Fact, Trait("Category", "DBF")];
		METHOD DBRecordInfo_test2() AS VOID
			LOCAL cDbf AS STRING
			cDbf := GetTempFileame("testdbf9.dbf")
			DBCreate(cDbf, {{"CFIELD","C",10,0}}, "DBFNTX", TRUE)
			DBAppend()
			FieldPut(1, "ABC")
			DBAppend()
			FieldPut(1, "DEF")

			DBGoTop()
			Assert.Equal(1, RecNo())
			Assert.Equal(FALSE, EOF())

//			 Any of the below cause the record pointer to go EOF
			Assert.False( DBRecordInfo(DBRI_DELETED , 0) )
			DBRecordInfo(DBRI_BUFFPTR , 0)
			DBRecordInfo(DBRI_RAWDATA , 0)

			Assert.Equal(1, RecNo())
			Assert.Equal(FALSE, EOF())

			DBCloseArea()
		RETURN

		// TECH-C6Y1L51V1O , DBContinue() not working correctly
		[Fact, Trait("Category", "DBF")];
		METHOD DBContinue_test() AS VOID
			LOCAL cDbf AS STRING
			cDbf := GetTempFileame("testdbf10.dbf")
			DBCreate(cDbf, {{"NFIELD","N",10,0}}, "DBFNTX", TRUE)
			DBAppend()
			FieldPut(1, 123)
			DBAppend()
			FieldPut(1, 456)
			DBAppend()
			FieldPut(1, 789)

			DBGoTop()
			Assert.True( DBLocate({||_FIELD->NFIELD > 300} , , , , TRUE) ) // DBSCOPEREST
			Assert.True( Found() )
			Assert.Equal(456.0 , FieldGet(1) )

//			DBContinue() returns TRUE (correct) but does not move record pointer at all
			Assert.True( DBContinue() )
			Assert.True( Found() )
			Assert.Equal( 789.0 , FieldGet(1) )

			Assert.True( DBContinue() )
			Assert.False( Found() )
			Assert.Equal( 0.0 , FieldGet(1) )

			Assert.True( DBContinue() )
			Assert.False( Found() )
			Assert.Equal( 0.0 , FieldGet(1) )

			DBCloseArea()
		RETURN

		STATIC PRIVATE METHOD GetTempFileame(cFileName AS STRING) AS STRING
			// we may want to put them to a specific folder etc
		RETURN cFileName

	END CLASS
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.Globalization

BEGIN NAMESPACE XSharp.VO.Tests

	CLASS DbfTests

		[Fact, Trait("Category", "DBFFuncs")];
		METHOD DBCreate_Tests() AS VOID
			LOCAL aFields AS ARRAY
			aFields := {{"TEST","C",10,0}}

			LOCAL cFileName_WithExt AS STRING
			LOCAL cFileName_NoExt AS STRING
			cFileName_NoExt := "DBCreate_Tests"
			cFileName_WithExt := cFileName_NoExt + ".dbf"
			IF System.IO.File.Exists(cFileName_WithExt)
				System.IO.File.Delete(cFileName_WithExt)
			END IF
			Assert.True(  DBCreate(cFileName_NoExt , aFields , "DBFNTX")  )
			Assert.True(  System.IO.File.Exists(cFileName_WithExt) )

			IF System.IO.File.Exists(cFileName_WithExt)
				System.IO.File.Delete(cFileName_WithExt)
			END IF
			Assert.True(  DBCreate(cFileName_WithExt , aFields , "DBFNTX")  )
			Assert.True(  System.IO.File.Exists(cFileName_WithExt) )

			cFileName_WithExt := cFileName_NoExt + ".none"
			IF System.IO.File.Exists(cFileName_WithExt)
				System.IO.File.Delete(cFileName_WithExt)
			END IF
			Assert.True(  DBCreate(cFileName_WithExt , aFields , "DBFNTX")  )
			Assert.True(  System.IO.File.Exists(cFileName_WithExt) )
		RETURN

		[Fact, Trait("Category", "DBFFuncs")];
		METHOD DBAppend_Exclusive() AS VOID
			LOCAL aFields AS ARRAY
			LOCAL cFileName AS STRING
			aFields := {{"TEST","C",10,0}}
			cFileName := "DBAppend_Exclusive"

			Assert.True(  DBCreate(cFileName , aFields , "DBFNTX")  )
			Assert.True(  DBUseArea(,"DBFNTX",cFileName,,FALSE) )
			Assert.True(  RecCount() == 0 )
			Assert.True(  DBAppend() )
			FieldPut(1 , "test")
			Assert.True(  AllTrim(FieldGet(1)) == "test" )
			Assert.True(  DBCloseArea() )
		RETURN

		[Fact, Trait("Category", "DBFFuncs")];
		METHOD DBAppend_Shared() AS VOID
			LOCAL aFields AS ARRAY
			LOCAL cFileName AS STRING
			aFields := {{"TEST","C",10,0}}
			cFileName := "DBAppend_Shared"

			Assert.True(  DBCreate(cFileName , aFields , "DBFNTX")  )
			Assert.True(  DBUseArea(,"DBFNTX",cFileName,,TRUE) )
			Assert.True(  RecCount() == 0 )
			Assert.True(  DBAppend() )
			FieldPut(1 , "test")
			Assert.True(  AllTrim(FieldGet(1)) == "test" )
			Assert.True(  DBCloseArea() )
		RETURN

		[Fact, Trait("Category", "DBFFuncs")];
		METHOD DBAppend_more() AS VOID
		LOCAL cDbf AS STRING
			cDbf := "testappend.DbF"
			RDDSetDefault( "DBFNTX" )
			Assert.True(  DBCreate(cDbf , { {"TEST","C",10,0} }) )
			// Appending in exclusive mode:
			Assert.True( DBUseArea(, , cDbf , "alias1" , FALSE) )
			Assert.True( DBAppend() )
			Assert.True( RecCount() == 1 )
			FieldPut(1, "test") // ok
			Assert.True( AllTrim(FieldGet(1)) == "test" )
			Assert.True( DBCloseArea() )

			// Appending in SHARED mode:
			Assert.True( DBUseArea(, , cDbf , "alias2" , TRUE) )
			Assert.True( RecCount() == 1 )
			Assert.True( DBAppend() )// returns true but does not append record
			Assert.True( RecCount() == 2 )
			FieldPut(1, "test2") // ok
			Assert.True( AllTrim(FieldGet(1)) == "test2" )
			Assert.True( DBCloseArea() )
		RETURN

		[Fact, Trait("Category", "DBFFuncs")];
		METHOD DBUseArea_same_file_twice() AS VOID
		LOCAL cDbf AS STRING
			RDDSetDefault( "DBFNTX" )
			cDbf := "testtwice.DbF"
			Assert.True(  DBCreate(cDbf , { {"TEST","C",10,0} }) )

			// shared mode
			Assert.True( DBUseArea(, , cDbf , , FALSE) )
			Assert.True( DBCloseArea() )

			Assert.True( DBUseArea(, , cDbf , , FALSE) )
			Assert.True( DBCloseArea() )
		RETURN

		// TECH-K3TL5J8M7V
		[Fact, Trait("Category", "DBF")];
		METHOD VODBInfo() AS VOID

			LOCAL cFileName AS STRING
			cFileName := GetTempFileame("test")
			DBCreate(cFileName , { {"CFIELD","C",10,0} })
			DBUseArea(,,cFileName)
			DBAppend()

			LOCAL u AS USUAL
			VODBSkip(-1)

			VODBInfo(DBI_FULLPATH , REF u)
			LOCAL c AS STRING
			c := u
			? c
			Assert.True(c:EndsWith("test.DBF") .and. c:Contains(":\"))
			VODBInfo(DBI_DB_VERSION , REF u)
			Assert.True(SLen(u) > 1)
			VODBInfo(DBI_ALIAS , REF u)
			Assert.Equal("test" , u)

			VODBInfo(DBI_BOF , REF u)
			Assert.Equal(TRUE , u)
			VODBInfo(DBI_EOF , REF u)
			Assert.Equal(FALSE , u)
			VODBInfo(DBI_ISANSI , REF u)
			Assert.Equal(SetAnsi() , u)
			VODBInfo(DBI_FCOUNT , REF u)
			Assert.Equal(1, u)
			VODBInfo(DBI_READONLY , REF u)
			Assert.Equal(FALSE, u)

			DBCloseArea()
		RETURN

		// TECH-E6Y9GNHB99
		[Fact, Trait("Category", "DBF")];
		METHOD AppendShared() AS VOID
			LOCAL cDbf AS STRING
			cDbf := GetTempFileame("testAppendShared")
			RDDSetDefault( "DBFNTX" )
			DBCreate(cDbf , { {"TEST","C",10,0} })

//			Appending in exclusive mode:
			DBUseArea(, , cDbf , "alias2" , FALSE)
			LOCAL lRet AS LOGIC
			Assert.True( DBAppend() )
			Assert.Equal( 1 , RecCount() )
			FieldPut(1, "test") // ok
			DBCloseArea()

//			Appending in SHARED mode:
			DBUseArea(, , cDbf , "alias2" , TRUE)
			Assert.True( DBAppend() ) // returns true but does not append record
			Assert.Equal( 2 , RecCount() ) // returns 1, wrong
			DBCloseArea()
		RETURN

		// TECH-6U40UQ0JV3
		[Fact, Trait("Category", "DBF")];
		METHOD AliasNameReuse() AS VOID
			LOCAL cDbf AS STRING
			cDbf := GetTempFileame("testdbf")

			RDDSetDefault( "DBFNTX" )

			DBCreate(cDbf , { {"TEST","C",10,0} })

//			opening and closing once
			DBUseArea(, , cDbf , , FALSE)
			DBCloseArea()

//			opening and closing again
			Assert.True( DBUseArea(, , cDbf , , FALSE) )
			Assert.True( DBCloseArea() )
		RETURN

		STATIC PRIVATE METHOD GetTempFileame(cFileName AS STRING) AS STRING
			// we may want to put them to a specific folder etc
		RETURN cFileName

	END CLASS
END NAMESPACE


[runtime] Fix for CToDAnsi()

[runtime] Fix for CToDAnsi()

//
// 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.Globalization
/// <summary>
/// Convert a string containing a 32-bit binary Date to a Date data type.
/// </summary>
/// <param name="cString">A 32-bit binary date represented as a string  least significant byte first.  Only the first 4 bytes are used by the function; all others are ignored. </param>
/// <returns>A date value that corresponds to the date specified in cString.  If cString is not a valid binary date, Bin2Date() returns a NULL_DATE.
/// </returns>
FUNCTION Bin2Date(cString AS STRING) AS DATE
	RETURN (DATE)(DWORD) Bin2L( cString )

/// <summary>
/// Extract the name of the day of the week from a Date.
/// </summary>
/// <param name="d">The Date to calculate the day of week from.</param>
/// <returns>
/// A string for the calculated day of the week.
/// </returns>
FUNCTION CDoW(d AS DATE) AS STRING
	RETURN NToCDoW(DoW(d))

/// <summary>
/// Extract the name of the month from a Date.
/// </summary>
/// <param name="d">The Date to calculate the month from.</param>
/// <returns>
/// A string with the name of the month.
/// </returns>
FUNCTION CMonth(d AS DATE) AS STRING
	RETURN NToCMonth( d:DMonth)

/// <summary>
/// Format a set of numbers representing a year, month, and day as a Date.
/// </summary>
/// <param name="dwY">A valid year.  If the century digits are not specified, the century is determined by the rules of SetEpoch(). </param>
/// <param name="dwM">A number from 1 through 12 representing a valid month. </param>
/// <param name="dwDay">A number representing a valid day of dwMonth.</param>
/// <returns>The date that corresponds to the passed arguments.  If any of the arguments specified do not represent a valid year, month, or day, a NULL_DATE is returned.</returns>
FUNCTION ConDate(dwY AS DWORD,dwM AS DWORD,dwDay AS DWORD) AS DATE
    IF dwY == 0 .OR. dwM == 0 .OR. dwDay == 0
      RETURN NULL_DATE
    ENDIF
    RETURN _ConDate(dwY, dwM, dwDay)

/// <summary>
/// Convert a Date string to date format.
/// </summary>
/// <param name="cDate">A string of numbers representing the month, day, and year, separated by any character other than a number.  The month, day, and year digits must be in the format set by SetDateFormat() or SetDateCountry().  If the century digits are not specified, the century is determined by the rules of SetEpoch().</param>
/// <returns>The date value that corresponds to the numbers specified in cDate.  If cDate is not a valid date, CToD() returns a NULL_DATE.
/// </returns>
FUNCTION CToD(cDate AS STRING) AS DATE
	RETURN CToD(cDate, XSharp.RuntimeState.DateFormat)

/// <summary>
/// Convert a Date string to date format using a specified Date Format string
/// </summary>
/// <param name="cDate">A string of numbers representing the month, day, and year, separated by any character other than a number.  The month, day, and year digits must be in the format set by SetDateFormat() or SetDateCountry().  If the century digits are not specified, the century is determined by the rules of SetEpoch().</param>
/// <param name="cDateFormat">A string representating the date format to use when converting the string to a date. Should consist of D, M and Y characters and separators.</param>
/// <returns>The date value that corresponds to the numbers specified in cDate.  If cDate is not a valid date, CToD() returns a NULL_DATE.
/// </returns>
FUNCTION CToD(cDate AS STRING, cDateFormat AS STRING) AS DATE
    RETURN _CToD(cDate, cDateFormat)

/// <summary>
/// Convert an ANSI date string to date format.
/// </summary>
/// <param name="cDate">A string in the ANSI form yyyy.mm.dd, where yy, mm, and dd represent year, month, and day respectively.
/// The year, month, and day can be separated by any character other than a number.
/// cDate is always interpreted as an ANSI string and is not dependent on SetDateFormat() or SetDateCountry().
/// If the century digits are not specified, the century is determined by the rules of SetEpoch().</param>
/// <returns>The date value that corresponds to the numbers specified in <paramref name="cDate"/>.  If cDate is not a valid ANSI date, CToDAnsi() returns a NULL_DATE.
/// </returns>
FUNCTION CToDAnsi(cDate AS STRING) AS DATE
	RETURN CToD(Left(cDate,10), "YYYY.MM.DD")

/// <summary>
/// Convert a Date to a 32-bit binary Date string.
/// </summary>
/// <param name="dValue">The date value to convert.</param>
/// <returns>Date2Bin() is a conversion function that converts a date data type into a 4-byte string.
/// Typical applications include reading foreign file types in their native format and then saving, reading, decrypting, and
/// transmitting date types in their compressed binary form instead of in strings.  Its inverse is Bin2Date().
/// </returns>
FUNCTION Date2Bin(dValue AS DATE) AS STRING
	RETURN L2Bin((LONG) (DATE) dValue)

/// <summary>
/// Extract the number of the day of the month from a Date.
/// </summary>
/// <param name="d">The Date to extract the day from.</param>
/// <returns>
/// The day of the month, as a number in the range 0 to 31.  For a NULL_DATE, Day() returns 0.
/// </returns>
FUNCTION Day(d AS DATE) AS DWORD
	LOCAL day := 0  AS DWORD
	IF ! d:IsEmpty
		day :=  d:DDay
	ENDIF
	RETURN day

/// <summary>
/// Extract the number of the day of the week from a Date.
/// </summary>
/// <param name="d">The Date to extract the day of the week from.</param>
/// <returns>
/// The day of the week as a number from 1 to 7, where 1 is Sunday, 2 is Monday, and so on.  For a NULL_DATE, DoW() returns 0.
/// </returns>
FUNCTION DoW(d AS DATE) AS DWORD
	LOCAL day := 0  AS DWORD
	IF ! d:IsEmpty
		LOCAL dt := d AS Datetime
		day := (DWORD) (dt:DayOfWeek	+1  )
	ENDIF
	RETURN day

/// <summary>
/// Convert a Date to a string.
/// </summary>
/// <param name="d">The Date to be converted.</param>
/// <returns>
/// A string representation of the given Date, formatted in the current Date format.
/// </returns>
FUNCTION DToC(d AS DATE) AS STRING
    RETURN _DToC(d)

/// <summary>
/// Convert a Date value to a string formatted as string in ANSI format
/// </summary>
/// <param name="dDate">The Date to be converted</param>
/// <returns>
/// An 8-character string in the format yyyymmdd.  If dDate is a NULL_DATE, a string of eight spaces is returned.  The return value is not affected by the current date format.
/// </returns>
FUNCTION DToS(dDate AS DATE) AS STRING
    RETURN _DToS(dDate)

/// <summary>
/// </summary>
/// <param name="d"></param>
/// <returns>
/// </returns>
FUNCTION JCDOW(d AS DATE) AS STRING
	LOCAL dt := d AS DateTime
	LOCAL cal := JapaneseCalendar{} AS JapaneseCalendar
	LOCAL culture := System.Globalization.CultureInfo.GetCultureInfo("ja-JP") AS CultureInfo
	RETURN culture:DateTimeFormat:GetDayName(dt:DayOfWeek)

/// <summary>
/// </summary>
/// <param name="d"></param>
/// <returns>
/// </returns>
FUNCTION JCMONTH(d AS DATE) AS STRING
	LOCAL dt := d AS DateTime
	LOCAL cal := JapaneseCalendar{} AS JapaneseCalendar
	LOCAL month := cal:GetMonth(dt) AS INT
	LOCAL culture := System.Globalization.CultureInfo.GetCultureInfo("ja-JP") AS CultureInfo
	RETURN culture:DateTimeFormat:GetMonthName(month)

/// <summary>
/// </summary>
/// <param name="d"></param>
/// <returns>
/// </returns>
FUNCTION JCYEAR(d AS DATE) AS STRING
	RETURN Year(d):ToString()

/// <summary>
/// Extract the number of the month from a DATE.
/// </summary>
/// <param name="d">The Date to extract the month from.</param>
/// <returns>
/// The month of the given Date.
/// </returns>
FUNCTION Month(d AS DATE) AS DWORD
	LOCAL month := 0  AS DWORD
	IF !d:IsEmpty
		month :=  d:DMonth
	ENDIF
	RETURN month

/// <summary>
/// Convert an ANSI Date string to Date format.
/// </summary>
/// <param name="cDate"></param>
/// <returns>
/// </returns>
FUNCTION SToD(cDate AS STRING) AS DATE
	LOCAL convertedDate AS DATE
	TRY
		IF cDate:Length == 8 .AND. cDate[0] == '0' .AND. cDate[1] == '0'
			// VO adjusts date strings like "00yyMMdd" to epoch-based year
			LOCAL dwY AS DWORD
			dwY := UInt32.Parse(cDate:Substring(0,4))

			// same code as in ConDate(), probably better adjust SToD() to use ConDate() directly
			LOCAL lAfter AS LOGIC
			lAfter := dwY > XSharp.RuntimeState.EpochYear
			dwY += XSharp.RuntimeState.EpochCent
			IF lAfter
				dwY -= 100
			ENDIF

			cDate := dwY:ToString():PadLeft(4 , '0') + cDate:Substring(4)
		END IF
		convertedDate := (DATE)DateTime.ParseExact(cDate, "yyyyMMdd", System.Globalization.CultureInfo.InvariantCulture)
	CATCH
		convertedDate := NULL_DATE
	END TRY
	RETURN	 convertedDate

/// <summary>
/// Return the system Date as a Date value.
/// </summary>
/// <returns>
/// </returns>
FUNCTION Today() AS DATE
	RETURN (DATE) DateTime.Now

/// <summary>
/// Convert a specified number of seconds to a time string.
/// </summary>
/// <param name="uSeconds"></param>
/// <returns>
/// </returns>
FUNCTION TString(uSeconds AS USUAL) AS STRING
	IF uSeconds:IsNil
		RETURN XSharp.Core.Functions.Tstring( (DWORD) 0 )
	ELSEIF uSeconds:IsFLoat
		RETURN XSharp.Core.Functions.TString ( (FLOAT) uSeconds)
	ELSEIF uSeconds:IsInteger
		RETURN XSharp.Core.Functions.TString ( (DWORD) uSeconds)
	ENDIF
	RETURN String.Empty

/// <summary>
/// Extract the number of the year from a DATE.
/// </summary>
/// <param name="d">The DATE to extract the year from.</param>
/// <returns>
/// The year from the give DATE.
/// </returns>
FUNCTION Year(d AS DATE) AS DWORD
	LOCAL year := 0  AS DWORD
	IF ! d:IsEmpty
		year := d:DYear
	ENDIF
	RETURN year

//
// 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.Globalization
/// <summary>
/// Convert a string containing a 32-bit binary Date to a Date data type.
/// </summary>
/// <param name="cString">A 32-bit binary date represented as a string — least significant byte first.  Only the first 4 bytes are used by the function; all others are ignored. </param>
/// <returns>A date value that corresponds to the date specified in cString.  If cString is not a valid binary date, Bin2Date() returns a NULL_DATE.
/// </returns>
FUNCTION Bin2Date(cString AS STRING) AS DATE
	RETURN (DATE)(DWORD) Bin2L( cString )

/// <summary>
/// Extract the name of the day of the week from a Date.
/// </summary>
/// <param name="d">The Date to calculate the day of week from.</param>
/// <returns>
/// A string for the calculated day of the week.
/// </returns>
FUNCTION CDoW(d AS DATE) AS STRING
	RETURN NToCDow(Dow(d))

/// <summary>
/// Extract the name of the month from a Date.
/// </summary>
/// <param name="d">The Date to calculate the month from.</param>
/// <returns>
/// A string with the name of the month.
/// </returns>
FUNCTION CMonth(d AS DATE) AS STRING
	RETURN NToCMonth( d:DMonth)

/// <summary>
/// Format a set of numbers representing a year, month, and day as a Date.
/// </summary>
/// <param name="dwY">A valid year.  If the century digits are not specified, the century is determined by the rules of SetEpoch(). </param>
/// <param name="dwM">A number from 1 through 12 representing a valid month. </param>
/// <param name="dwDay">A number representing a valid day of dwMonth.</param>
/// <returns>The date that corresponds to the passed arguments.  If any of the arguments specified do not represent a valid year, month, or day, a NULL_DATE is returned.</returns>
FUNCTION ConDate(dwY AS DWORD,dwM AS DWORD,dwDay AS DWORD) AS DATE
    IF dwY == 0 .OR. dwM == 0 .OR. dwDay == 0
      RETURN NULL_DATE
    ENDIF
    RETURN _ConDate(dwY, dwM, dwDay)

/// <summary>
/// Convert a Date string to date format.
/// </summary>
/// <param name="cDate">A string of numbers representing the month, day, and year, separated by any character other than a number.  The month, day, and year digits must be in the format set by SetDateFormat() or SetDateCountry().  If the century digits are not specified, the century is determined by the rules of SetEpoch().</param>
/// <returns>The date value that corresponds to the numbers specified in cDate.  If cDate is not a valid date, CToD() returns a NULL_DATE.
/// </returns>
FUNCTION CToD(cDate AS STRING) AS DATE
	RETURN CToD(cDate, XSharp.RuntimeState.DateFormat)

/// <summary>
/// Convert a Date string to date format using a specified Date Format string
/// </summary>
/// <param name="cDate">A string of numbers representing the month, day, and year, separated by any character other than a number.  The month, day, and year digits must be in the format set by SetDateFormat() or SetDateCountry().  If the century digits are not specified, the century is determined by the rules of SetEpoch().</param>
/// <param name="cDateFormat">A string representating the date format to use when converting the string to a date. Should consist of D, M and Y characters and separators.</param>
/// <returns>The date value that corresponds to the numbers specified in cDate.  If cDate is not a valid date, CToD() returns a NULL_DATE.
/// </returns>
FUNCTION CToD(cDate AS STRING, cDateFormat AS STRING) AS DATE
    RETURN _CToD(cDate, cDateFormat)

/// <summary>
/// Convert an ANSI date string to date format.
/// </summary>
/// <param name="cDate">A string in the ANSI form yyyy.mm.dd, where yy, mm, and dd represent year, month, and day respectively.
/// The year, month, and day can be separated by any character other than a number.
/// cDate is always interpreted as an ANSI string and is not dependent on SetDateFormat() or SetDateCountry().
/// If the century digits are not specified, the century is determined by the rules of SetEpoch().</param>
/// <returns>The date value that corresponds to the numbers specified in <paramref name="cDate"/>.  If cDate is not a valid ANSI date, CToDAnsi() returns a NULL_DATE.
/// </returns>
FUNCTION CToDAnsi(cDate AS STRING) AS DATE
	RETURN CToD(cDate, "YYYY.MM.DD")

/// <summary>
/// Convert a Date to a 32-bit binary Date string.
/// </summary>
/// <param name="dValue">The date value to convert.</param>
/// <returns>Date2Bin() is a conversion function that converts a date data type into a 4-byte string.
/// Typical applications include reading foreign file types in their native format and then saving, reading, decrypting, and
/// transmitting date types in their compressed binary form instead of in strings.  Its inverse is Bin2Date().
/// </returns>
FUNCTION Date2Bin(dValue AS DATE) AS STRING
	RETURN L2Bin((LONG) (DATE) dValue)

/// <summary>
/// Extract the number of the day of the month from a Date.
/// </summary>
/// <param name="d">The Date to extract the day from.</param>
/// <returns>
/// The day of the month, as a number in the range 0 to 31.  For a NULL_DATE, Day() returns 0.
/// </returns>
FUNCTION Day(d AS DATE) AS DWORD
	LOCAL day := 0  AS DWORD
	IF ! d:IsEmpty
		day :=  d:DDay
	ENDIF
	RETURN day

/// <summary>
/// Extract the number of the day of the week from a Date.
/// </summary>
/// <param name="d">The Date to extract the day of the week from.</param>
/// <returns>
/// The day of the week as a number from 1 to 7, where 1 is Sunday, 2 is Monday, and so on.  For a NULL_DATE, DoW() returns 0.
/// </returns>
FUNCTION DoW(d AS DATE) AS DWORD
	LOCAL day := 0  AS DWORD
	IF ! d:IsEmpty
		LOCAL dt := d AS Datetime
		day := (DWORD) (dt:DayOfWeek	+1  )
	ENDIF
	RETURN day

/// <summary>
/// Convert a Date to a string.
/// </summary>
/// <param name="d">The Date to be converted.</param>
/// <returns>
/// A string representation of the given Date, formatted in the current Date format.
/// </returns>
FUNCTION DToC(d AS DATE) AS STRING
    RETURN _DToC(d)

/// <summary>
/// Convert a Date value to a string formatted as string in ANSI format
/// </summary>
/// <param name="dDate">The Date to be converted</param>
/// <returns>
/// An 8-character string in the format yyyymmdd.  If dDate is a NULL_DATE, a string of eight spaces is returned.  The return value is not affected by the current date format.
/// </returns>
FUNCTION DToS(dDate AS DATE) AS STRING
    RETURN _DToS(dDate)

/// <summary>
/// </summary>
/// <param name="d"></param>
/// <returns>
/// </returns>
FUNCTION JCDOW(d AS DATE) AS STRING
	LOCAL dt := d AS DateTime
	LOCAL cal := JapaneseCalendar{} AS JapaneseCalendar
	LOCAL culture := System.Globalization.CultureInfo.GetCultureInfo("ja-JP") AS CultureInfo
	RETURN culture:DateTimeFormat:GetDayName(dt:DayOfWeek)

/// <summary>
/// </summary>
/// <param name="d"></param>
/// <returns>
/// </returns>
FUNCTION JCMONTH(d AS DATE) AS STRING
	LOCAL dt := d AS DateTime
	LOCAL cal := JapaneseCalendar{} AS JapaneseCalendar
	LOCAL month := cal:GetMonth(dt) AS INT
	LOCAL culture := System.Globalization.CultureInfo.GetCultureInfo("ja-JP") AS CultureInfo
	RETURN culture:DateTimeFormat:GetMonthName(month)

/// <summary>
/// </summary>
/// <param name="d"></param>
/// <returns>
/// </returns>
FUNCTION JCYEAR(d AS DATE) AS STRING
	RETURN Year(d):ToString()

/// <summary>
/// Extract the number of the month from a DATE.
/// </summary>
/// <param name="d">The Date to extract the month from.</param>
/// <returns>
/// The month of the given Date.
/// </returns>
FUNCTION Month(d AS DATE) AS DWORD
	LOCAL month := 0  AS DWORD
	IF !d:IsEmpty
		month :=  d:DMonth
	ENDIF
	RETURN month

/// <summary>
/// Convert an ANSI Date string to Date format.
/// </summary>
/// <param name="cDate"></param>
/// <returns>
/// </returns>
FUNCTION SToD(cDate AS STRING) AS DATE
	LOCAL convertedDate AS DATE
	TRY
		IF cDate:Length == 8 .AND. cDate[0] == '0' .AND. cDate[1] == '0'
			// VO adjusts date strings like "00yyMMdd" to epoch-based year
			LOCAL dwY AS DWORD
			dwY := UInt32.Parse(cDate:Substring(0,4))

			// same code as in ConDate(), probably better adjust SToD() to use ConDate() directly
			LOCAL lAfter AS LOGIC
			lAfter := dwY > XSharp.RuntimeState.EpochYear
			dwY += XSharp.RuntimeState.EpochCent
			IF lAfter
				dwY -= 100
			ENDIF

			cDate := dwY:ToString():PadLeft(4 , '0') + cDate:Substring(4)
		END IF
		convertedDate := (DATE)DateTime.ParseExact(cDate, "yyyyMMdd", System.Globalization.CultureInfo.InvariantCulture)
	CATCH
		convertedDate := NULL_DATE
	END TRY
	RETURN	 convertedDate

/// <summary>
/// Return the system Date as a Date value.
/// </summary>
/// <returns>
/// </returns>
FUNCTION Today() AS DATE
	RETURN (DATE) DateTime.Now

/// <summary>
/// Convert a specified number of seconds to a time string.
/// </summary>
/// <param name="uSeconds"></param>
/// <returns>
/// </returns>
FUNCTION TString(uSeconds AS USUAL) AS STRING
	IF uSeconds:IsNil
		RETURN XSharp.Core.Functions.Tstring( (DWORD) 0 )
	ELSEIF uSeconds:IsFLoat
		RETURN XSharp.Core.Functions.TString ( (FLOAT) uSeconds)
	ELSEIF uSeconds:IsInteger
		RETURN XSharp.Core.Functions.TString ( (DWORD) uSeconds)
	ENDIF
	RETURN String.Empty

/// <summary>
/// Extract the number of the year from a DATE.
/// </summary>
/// <param name="d">The DATE to extract the year from.</param>
/// <returns>
/// The year from the give DATE.
/// </returns>
FUNCTION Year(d AS DATE) AS DWORD
	LOCAL year := 0  AS DWORD
	IF ! d:IsEmpty
		year := d:DYear
	ENDIF
	RETURN year


add multiGraft TODO

add multiGraft TODO

-- Modeling Opetopes
-- here is Eric's editor: http://sma.epfl.ch/~finster/opetope/opetope.html
--
-- Note: Kock et al. use a similar scheme, where
--          - dots    <-->   lines
--          - spheres <-->   dots
--          - lines disappear
--          -                spheres appear

-- Note: In Eric's new work (at IAS) there are no
--       dots any more, instead he uses 'output cards', so
--          - (output) cards   <-->  lines
--          - space between stacked cards <--> output cards
--          - lines disappear
--          -                (regular) cards appear

import "../tests/Nat.prg"

data ZoomComplex :: Tree e ~> Tree f ~> * where
  Nil :: ZoomComplex a a
  Cons :: Stack a b -> ZoomComplex b c -> ZoomComplex a c
 deriving List(cplx)

data Dir :: *2 where
  Hor :: Dir
  Ver :: Dir

-- define the Tree kind, a rose tree
-- note: we may need a two-level kind, since we need to track disjointness
--       of subtrees
-- todo: later we may want to have a label kind parameter too

data Tree :: Dir ~> *1 where
  Unit :: Tree Ver
  Ni :: Tree Hor
  Fork :: Tree d ~> Tree Hor ~> Tree Hor
 deriving syntax (tr) List(Ni, Fork) Unit(Unit)

-- make it singleton

data Tree' :: Tree d ~> * where
  In :: Tree' ()tr
  Fork :: Tree' head -> Tree' tail -> Tree' [head; tail]tr
  Done :: Tree' []tr
 deriving syntax (ar) List(Done, Fork) Unit(In) -- "arbre"
-- http://www.papoulipoesique.com/wp-content/uploads/2013/06/arbre.jpg

-- define a proposition for subtrees
-- to be checked: TakeHead must ensure that all the node is consumed

prop Subtree :: Tree d ~> Tree e ~> * where
  UnitSub :: Subtree ()tr tr
  BothNil :: Subtree []tr []tr
  TakeHead :: Subtree head head' -> Subtree tail tail' -> Subtree [head; tail]tr [head'; tail']tr

-- now we can stack cards (these are zooms in Kock et al. parlance)

data Stack :: Tree d ~> Tree e ~> * where
  Empty :: Corolla tr => Tree' tr -> Stack tr ()tr
  SubDone :: Stack ()tr []tr
  SubCont :: Stack ()tr tr -> Stack ()tr [tr]tr
  --Subdivision :: Stack ()tr sub -> Stack tr rest -> Stack tr [sub; rest]tr
  Encompass :: Subtree consumed tr => Stack consumed prod -> Stack tr prod
  -- the following three grab a node (and possibly its offsprings) and incorporate it into a single card
  NodeDone :: Stack []tr [()tr]tr
  Pick :: {- EntireNode => -} Stack head prodhead -> Stack tail prodtail -> Stack [head; tail]tr [prodhead; prodtail]tr
  Exclude :: {- EntireNode => -} Stack tail prod -> Stack [()tr; tail]tr prod
  -- we need a way to sequence cards
  -- MultiCard :: ??? Disjoint a b 0 => Subtree a -> Subtree b -> Stack tr a [proda, prodb]tr

  On :: (Subtree tr' tr, Pointers 1t at out) => Stack tr' out' -> Stack tr out -> Tree' at -> Stack tr {graft out' at out}
  Beside :: () -- (Pointers 1t at tr, Pointers 1t {graft skipping at at} {graft skipping at tr})
         => Tree' at -> Tree' skipping -> Stack tr' [out']tr -> Stack tr out -> Stack {graft tr' {graft skipping at at} {graft skipping at tr}} [out'; out]tr

  -- WARNING: [out']tr ---> one sibling for now

-- it remains to define corollas

prop Corolla :: Tree d ~> * where
  None' :: Corolla []tr
  One' :: Corolla tail -> Corolla [()tr; tail]tr

--  o   --->  |
--  |         |

lolliCell :: Stack []tr ()tr
lolliCell = Empty Done

--  |         |
--  o   --->  |
--  |         |

dolliCell :: Stack [()tr]tr ()tr
dolliCell = Empty $ Fork In Done

--              |
--  [o]   --->  o
--   |          |

lolliFrame :: Stack []tr [()tr]tr
lolliFrame = Encompass NodeDone

--   |          |
--  [o]   --->  o
--   |          |

dolliFrame :: Stack [()tr]tr [()tr]tr
dolliFrame = Encompass (Exclude NodeDone)

--   |          |
--   |          o
-- [[o]]  --->  |
--   |          o
--   |          |

stacked :: Stack [()tr]tr [[()tr]tr]tr
stacked = (dolliFrame `On` dolliFrame) (In `Fork` Done)

--   |
--  [|]   --->  o
--   |          |

crossed :: Stack ()tr []tr
crossed = SubDone

-- we can now join things
--
dolliForever = [dolliFrame; dolliForever]cplx
nopetope = [crossed, lolliFrame; dolliForever]cplx

-- back to unit as fast as possible...
--
stopetope = [crossed, lolliFrame, dolliCell]cplx
neverstopetope = [crossed, lolliFrame, dolliCell; neverstopetope]cplx

--   |          o
-- [[|]]  --->  |
--   |          o
--   |          |

drossed :: Stack ()tr [[]tr]tr
drossed = SubCont SubDone
-- drossed = (SubDone `On` NodeDone) In
-- Note: can we find a way to graft here? Then On would be feasible

--                    |
--    |           o   o
-- | [o] |  --->   \ /
-- | [|] |          o
--    |             |

--cyclops :: Stack [()tr]tr [[]tr, ()tr]tr
--cyclops = Pick (Beside ()ar ()ar SubDone (Exclude NodeDone)) NodeDone

-- Stacking, Valence, Affine subtree, Substitute at an affine position

-- counting Units in a tree

valence :: Tree d ~> Nat
{valence []tr} = 0t
{valence [head; tail]tr} = {plus {valence head} {valence tail}}
{valence ()tr} = 1t

-- counting siblings of a tree

nodeValence :: Tree d ~> Nat
{nodeValence []tr} = 0t
{nodeValence [head; tail]tr} = (1+{nodeValence tail})t

-- nodeValenceAt: given a (multi)pointer, determine the node valences at those positions
--               WHERE     IN
nodeValenceAt :: Tree d ~> Tree e ~> Nat
{nodeValenceAt ()tr tree} = {nodeValence tree}
{nodeValenceAt []tr []tr} = 0t
{nodeValenceAt [head'; tail']tr [head; tail]tr} = {plus {nodeValenceAt head' head} {nodeValenceAt tail' tail}}

-- a pointer is a valence-1 subtree of a tree
-- it is used to mark a unit in a tree where substitution will occur
--
prop Pointers :: Nat ~> Tree d ~> Tree e ~> * where
  Finger :: Pointers 1t ()tr ()tr
  Finished :: Pointers 0t []tr []tr
  ThisWay :: Pointers 1t head' head -> Pointers n tail' tail -> Pointers (1+n)t [head'; tail']tr [head; tail]tr
  ElseWhere :: Pointers n tail' tail -> Pointers n [[]tr; tail']tr [head; tail]tr

-- http://en.wikipedia.org/wiki/Grafting
--
-- graft WHAT      WHERE     IN
graft :: Tree d ~> Tree e ~> Tree f ~> Tree f
{graft what ()tr ()tr} = what
{graft what []tr tr} = tr
{graft what [head'; tail']tr [head; tail]tr} = [{graft what head' head}; {graft what tail' tail}]tr

{- TODO! multiGraft :: Treelist -> where -> in -}

{- NOTE: we have an Omega bug here:

prompt> :norm {graft []tr ()tr ()tr}
Normalizes to:
  []tr

prompt> :kind []tr
[]tr :: Tree Hor  = []tr

prompt> :kind {graft []tr ()tr ()tr}
{graft []tr ()tr ()tr} :: Tree Ver  = {graft []tr ()tr ()tr}

... BUT: Hor /= Ver :-(
-}

-- substitution: replace a pointed node (of valence n) in a tree with an
-- other tree of (valence n) -- TODO

-- HERE IS A NICE RESEARCH QUESTION:
-- is it possible to "proof search" a Zoom?
-- i.e.
{-

class ZoomLike (int :: Tree) (out :: Tree) where
  zoom :: (Nodes int ~ Valence out) => Zoom int out

-}

-- Modeling Opetopes
-- here is Eric's editor: http://sma.epfl.ch/~finster/opetope/opetope.html
--
-- Note: Kock et al. use a similar scheme, where
--          - dots    <-->   lines
--          - spheres <-->   dots
--          - lines disappear
--          -                spheres appear

-- Note: In Eric's new work (at IAS) there are no
--       dots any more, instead he uses 'output cards', so
--          - (output) cards   <-->  lines
--          - space between stacked cards <--> output cards
--          - lines disappear
--          -                (regular) cards appear

import "../tests/Nat.prg"

data ZoomComplex :: Tree e ~> Tree f ~> * where
  Nil :: ZoomComplex a a
  Cons :: Stack a b -> ZoomComplex b c -> ZoomComplex a c
 deriving List(cplx)

data Dir :: *2 where
  Hor :: Dir
  Ver :: Dir

-- define the Tree kind, a rose tree
-- note: we may need a two-level kind, since we need to track disjointness
--       of subtrees
-- todo: later we may want to have a label kind parameter too

data Tree :: Dir ~> *1 where
  Unit :: Tree Ver
  Ni :: Tree Hor
  Fork :: Tree d ~> Tree Hor ~> Tree Hor
 deriving syntax (tr) List(Ni, Fork) Unit(Unit)

-- make it singleton

data Tree' :: Tree d ~> * where
  In :: Tree' ()tr
  Fork :: Tree' head -> Tree' tail -> Tree' [head; tail]tr
  Done :: Tree' []tr
 deriving syntax (ar) List(Done, Fork) Unit(In) -- "arbre"
-- http://www.papoulipoesique.com/wp-content/uploads/2013/06/arbre.jpg

-- define a proposition for subtrees
-- to be checked: TakeHead must ensure that all the node is consumed

prop Subtree :: Tree d ~> Tree e ~> * where
  UnitSub :: Subtree ()tr tr
  BothNil :: Subtree []tr []tr
  TakeHead :: Subtree head head' -> Subtree tail tail' -> Subtree [head; tail]tr [head'; tail']tr

-- now we can stack cards (these are zooms in Kock et al. parlance)

data Stack :: Tree d ~> Tree e ~> * where
  Empty :: Corolla tr => Tree' tr -> Stack tr ()tr
  SubDone :: Stack ()tr []tr
  SubCont :: Stack ()tr tr -> Stack ()tr [tr]tr
  --Subdivision :: Stack ()tr sub -> Stack tr rest -> Stack tr [sub; rest]tr
  Encompass :: Subtree consumed tr => Stack consumed prod -> Stack tr prod
  -- the following three grab a node (and possibly its offsprings) and incorporate it into a single card
  NodeDone :: Stack []tr [()tr]tr
  Pick :: {- EntireNode => -} Stack head prodhead -> Stack tail prodtail -> Stack [head; tail]tr [prodhead; prodtail]tr
  Exclude :: {- EntireNode => -} Stack tail prod -> Stack [()tr; tail]tr prod
  -- we need a way to sequence cards
  -- MultiCard :: ??? Disjoint a b 0 => Subtree a -> Subtree b -> Stack tr a [proda, prodb]tr

  On :: (Subtree tr' tr, Pointers 1t at out) => Stack tr' out' -> Stack tr out -> Tree' at -> Stack tr {graft out' at out}
  Beside :: () -- (Pointers 1t at tr, Pointers 1t {graft skipping at at} {graft skipping at tr})
         => Tree' at -> Tree' skipping -> Stack tr' [out']tr -> Stack tr out -> Stack {graft tr' {graft skipping at at} {graft skipping at tr}} [out'; out]tr

  -- WARNING: [out']tr ---> one sibling for now

-- it remains to define corollas

prop Corolla :: Tree d ~> * where
  None' :: Corolla []tr
  One' :: Corolla tail -> Corolla [()tr; tail]tr

--  o   --->  |
--  |         |

lolliCell :: Stack []tr ()tr
lolliCell = Empty Done

--  |         |
--  o   --->  |
--  |         |

dolliCell :: Stack [()tr]tr ()tr
dolliCell = Empty $ Fork In Done

--              |
--  [o]   --->  o
--   |          |

lolliFrame :: Stack []tr [()tr]tr
lolliFrame = Encompass NodeDone

--   |          |
--  [o]   --->  o
--   |          |

dolliFrame :: Stack [()tr]tr [()tr]tr
dolliFrame = Encompass (Exclude NodeDone)

--   |          |
--   |          o
-- [[o]]  --->  |
--   |          o
--   |          |

stacked :: Stack [()tr]tr [[()tr]tr]tr
stacked = (dolliFrame `On` dolliFrame) (In `Fork` Done)

--   |
--  [|]   --->  o
--   |          |

crossed :: Stack ()tr []tr
crossed = SubDone

-- we can now join things
--
dolliForever = [dolliFrame; dolliForever]cplx
nopetope = [crossed, lolliFrame; dolliForever]cplx

-- back to unit as fast as possible...
--
stopetope = [crossed, lolliFrame, dolliCell]cplx
neverstopetope = [crossed, lolliFrame, dolliCell; neverstopetope]cplx

--   |          o
-- [[|]]  --->  |
--   |          o
--   |          |

drossed :: Stack ()tr [[]tr]tr
drossed = SubCont SubDone
-- drossed = (SubDone `On` NodeDone) In
-- Note: can we find a way to graft here? Then On would be feasible

--                    |
--    |           o   o
-- | [o] |  --->   \ /
-- | [|] |          o
--    |             |

--cyclops :: Stack [()tr]tr [[]tr, ()tr]tr
--cyclops = Pick (Beside ()ar ()ar SubDone (Exclude NodeDone)) NodeDone

-- Stacking, Valence, Affine subtree, Substitute at an affine position

-- counting Units in a tree

valence :: Tree d ~> Nat
{valence []tr} = 0t
{valence [head; tail]tr} = {plus {valence head} {valence tail}}
{valence ()tr} = 1t

-- counting siblings of a tree

nodeValence :: Tree d ~> Nat
{nodeValence []tr} = 0t
{nodeValence [head; tail]tr} = (1+{nodeValence tail})t

-- nodeValenceAt: given a (multi)pointer, determine the node valences at those positions
--               WHERE     IN
nodeValenceAt :: Tree d ~> Tree e ~> Nat
{nodeValenceAt ()tr tree} = {nodeValence tree}
{nodeValenceAt []tr []tr} = 0t
{nodeValenceAt [head'; tail']tr [head; tail]tr} = {plus {nodeValenceAt head' head} {nodeValenceAt tail' tail}}

-- a pointer is a valence-1 subtree of a tree
-- it is used to mark a unit in a tree where substitution will occur
--
prop Pointers :: Nat ~> Tree d ~> Tree e ~> * where
  Finger :: Pointers 1t ()tr ()tr
  Finished :: Pointers 0t []tr []tr
  ThisWay :: Pointers 1t head' head -> Pointers n tail' tail -> Pointers (1+n)t [head'; tail']tr [head; tail]tr
  ElseWhere :: Pointers n tail' tail -> Pointers n [[]tr; tail']tr [head; tail]tr

-- http://en.wikipedia.org/wiki/Grafting
--
-- graft WHAT      WHERE     IN
graft :: Tree d ~> Tree e ~> Tree f ~> Tree f
{graft what ()tr ()tr} = what
{graft what []tr tr} = tr
{graft what [head'; tail']tr [head; tail]tr} = [{graft what head' head}; {graft what tail' tail}]tr

{- NOTE: we have an Omega bug here:

prompt> :norm {graft []tr ()tr ()tr}
Normalizes to:
  []tr

prompt> :kind []tr
[]tr :: Tree Hor  = []tr

prompt> :kind {graft []tr ()tr ()tr}
{graft []tr ()tr ()tr} :: Tree Ver  = {graft []tr ()tr ()tr}

... BUT: Hor /= Ver :-(
-}

-- substitution: replace a pointed node (of valence n) in a tree with an
-- other tree of (valence n) -- TODO

-- HERE IS A NICE RESEARCH QUESTION:
-- is it possible to "proof search" a Zoom?
-- i.e.
{-

class ZoomLike (int :: Tree) (out :: Tree) where
  zoom :: (Nodes int ~ Valence out) => Zoom int out

-}