Browse Source

* Rework testsuites to use punit (no dependency on fpcunit) and add tests for contnrs unit

Michaël Van Canneyt 1 month ago
parent
commit
d16ea18f27
44 changed files with 12301 additions and 9227 deletions
  1. 0 110
      packages/fcl-base/tests/fclbase-unittests.lpi
  2. 0 20
      packages/fcl-base/tests/fclbase-unittests.pp
  3. 3250 0
      packages/fcl-base/tests/punit.pp
  4. 0 393
      packages/fcl-base/tests/tcbufferedfilestream.pp
  5. 0 148
      packages/fcl-base/tests/tccsvdocument.pp
  6. 0 117
      packages/fcl-base/tests/tccsvreadwrite.pp
  7. 0 171
      packages/fcl-base/tests/tchashlist.pp
  8. 0 108
      packages/fcl-base/tests/tcinifile.pp
  9. 0 43
      packages/fcl-base/tests/tcmaskutils.pp
  10. 0 169
      packages/fcl-base/tests/testbasenenc.lpr
  11. 0 7281
      packages/fcl-base/tests/testexprpars.pp
  12. 178 0
      packages/fcl-base/tests/testfclbase.lpi
  13. 74 0
      packages/fcl-base/tests/testfclbase.pp
  14. 0 174
      packages/fcl-base/tests/testinterlocked.pp
  15. 0 192
      packages/fcl-base/tests/tests_fptemplate.pp
  16. 107 0
      packages/fcl-base/tests/utcbasenenc.pp
  17. 295 0
      packages/fcl-base/tests/utcbufferedfilestream.pp
  18. 145 0
      packages/fcl-base/tests/utcclasslist.pp
  19. 216 0
      packages/fcl-base/tests/utccomponentlist.pp
  20. 122 0
      packages/fcl-base/tests/utccsvdocument.pp
  21. 117 0
      packages/fcl-base/tests/utccsvreadwrite.pp
  22. 324 0
      packages/fcl-base/tests/utcdirwatch.pp
  23. 1018 0
      packages/fcl-base/tests/utcexprbuiltin.pp
  24. 419 0
      packages/fcl-base/tests/utcexprparsaggr.pp
  25. 2612 0
      packages/fcl-base/tests/utcexprparsnodes.pp
  26. 847 0
      packages/fcl-base/tests/utcexprparsops.pp
  27. 127 0
      packages/fcl-base/tests/utcexprparsparser.pp
  28. 243 0
      packages/fcl-base/tests/utcexprparsscanner.pp
  29. 228 0
      packages/fcl-base/tests/utcfphashobjectlist.pp
  30. 191 0
      packages/fcl-base/tests/utcfpobjecthashtable.pp
  31. 185 0
      packages/fcl-base/tests/utcfpobjectlist.pp
  32. 134 0
      packages/fcl-base/tests/utcfpstringhashtable.pp
  33. 206 0
      packages/fcl-base/tests/utcfptemplate.pp
  34. 113 0
      packages/fcl-base/tests/utcinifile.pp
  35. 250 0
      packages/fcl-base/tests/utcinterlocked.pp
  36. 12 13
      packages/fcl-base/tests/utclzw.pas
  37. 40 0
      packages/fcl-base/tests/utcmaskutils.pp
  38. 233 0
      packages/fcl-base/tests/utcobjectlist.pp
  39. 116 0
      packages/fcl-base/tests/utcobjectqueue.pp
  40. 116 0
      packages/fcl-base/tests/utcobjectstack.pp
  41. 163 0
      packages/fcl-base/tests/utcorderedlist.pp
  42. 110 0
      packages/fcl-base/tests/utcqueue.pp
  43. 110 0
      packages/fcl-base/tests/utcstack.pp
  44. 0 288
      packages/fcl-base/tests/utdirwatch.pas

+ 0 - 110
packages/fcl-base/tests/fclbase-unittests.lpi

@@ -1,110 +0,0 @@
-<?xml version="1.0" encoding="UTF-8"?>
-<CONFIG>
-  <ProjectOptions>
-    <Version Value="12"/>
-    <General>
-      <Flags>
-        <SaveOnlyProjectUnits Value="True"/>
-        <MainUnitHasCreateFormStatements Value="False"/>
-        <MainUnitHasTitleStatement Value="False"/>
-        <CompatibilityMode Value="True"/>
-      </Flags>
-      <SessionStorage Value="InProjectDir"/>
-      <Title Value="fclbase-unittests"/>
-      <UseAppBundle Value="False"/>
-      <ResourceType Value="res"/>
-    </General>
-    <i18n>
-      <EnableI18N LFM="False"/>
-    </i18n>
-    <BuildModes Count="1">
-      <Item1 Name="Default" Default="True"/>
-    </BuildModes>
-    <PublishOptions>
-      <Version Value="2"/>
-    </PublishOptions>
-    <RunParams>
-      <local>
-        <CommandLineParams Value="--suite=TTestCSVReadWrite.TestInlineQuotedLine"/>
-      </local>
-      <FormatVersion Value="2"/>
-      <Modes Count="1">
-        <Mode0 Name="default">
-          <local>
-            <CommandLineParams Value="--suite=TTestCSVReadWrite.TestInlineQuotedLine"/>
-          </local>
-        </Mode0>
-      </Modes>
-    </RunParams>
-    <Units Count="11">
-      <Unit0>
-        <Filename Value="fclbase-unittests.pp"/>
-        <IsPartOfProject Value="True"/>
-      </Unit0>
-      <Unit1>
-        <Filename Value="tchashlist.pp"/>
-        <IsPartOfProject Value="True"/>
-      </Unit1>
-      <Unit2>
-        <Filename Value="testexprpars.pp"/>
-        <IsPartOfProject Value="True"/>
-      </Unit2>
-      <Unit3>
-        <Filename Value="tcmaskutils.pp"/>
-        <IsPartOfProject Value="True"/>
-      </Unit3>
-      <Unit4>
-        <Filename Value="tcinifile.pp"/>
-        <IsPartOfProject Value="True"/>
-      </Unit4>
-      <Unit5>
-        <Filename Value="tccsvreadwrite.pp"/>
-        <IsPartOfProject Value="True"/>
-      </Unit5>
-      <Unit6>
-        <Filename Value="tcbufferedfilestream.pp"/>
-        <IsPartOfProject Value="True"/>
-      </Unit6>
-      <Unit7>
-        <Filename Value="tccsvdocument.pp"/>
-        <IsPartOfProject Value="True"/>
-      </Unit7>
-      <Unit8>
-        <Filename Value="utcchainstream.pp"/>
-        <IsPartOfProject Value="True"/>
-      </Unit8>
-      <Unit9>
-        <Filename Value="utclzw.pas"/>
-        <IsPartOfProject Value="True"/>
-      </Unit9>
-      <Unit10>
-        <Filename Value="utdirwatch.pas"/>
-        <IsPartOfProject Value="True"/>
-      </Unit10>
-    </Units>
-  </ProjectOptions>
-  <CompilerOptions>
-    <Version Value="11"/>
-    <Target>
-      <Filename Value="fclbase-unittests"/>
-    </Target>
-    <SearchPaths>
-      <IncludeFiles Value="$(ProjOutDir)"/>
-      <OtherUnitFiles Value="../src"/>
-      <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
-    </SearchPaths>
-  </CompilerOptions>
-  <Debugging>
-    <Exceptions Count="3">
-      <Item1>
-        <Name Value="EAbort"/>
-      </Item1>
-      <Item2>
-        <Name Value="ECodetoolError"/>
-      </Item2>
-      <Item3>
-        <Name Value="EFOpenError"/>
-      </Item3>
-    </Exceptions>
-  </Debugging>
-</CONFIG>

+ 0 - 20
packages/fcl-base/tests/fclbase-unittests.pp

@@ -1,20 +0,0 @@
-program fclbase_unittests;
-
-{$mode objfpc}{$H+}
-
-uses
-  Classes, consoletestrunner, tests_fptemplate, tchashlist,
-  testexprpars, tcmaskutils, tcinifile, tccsvreadwrite,tcbufferedfilestream, tccsvdocument, utcchainstream, utclzw;
-
-var
-  Application: TTestRunner;
-
-begin
-  DefaultFormat:=fPlain;
-  DefaultRunAllTests:=True;
-  Application := TTestRunner.Create(nil);
-  Application.Initialize;
-  Application.Title := 'FCL-Base unittests';
-  Application.Run;
-  Application.Free;
-end.

+ 3250 - 0
packages/fcl-base/tests/punit.pp

@@ -0,0 +1,3250 @@
+{
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2014 by Michael Van Canneyt,
+    member of the Free Pascal development team.
+
+    Complete Test unit framework relying only on system unit.
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+{$mode objfpc} // needed for exceptions
+{$IFDEF UNICODERTL}
+{$DEFINE USEUNICODE} // define this if you want to use unicode.
+{$ENDIF}
+
+unit punit;
+
+interface
+Type
+{$IFDEF USEUNICODE}
+   TTestString = UnicodeString;
+{$ELSE}
+   TTestString = AnsiString;
+{$ENDIF}
+
+{$IF NOT DECLARED(RTLString)}
+  RTLString = TTestString;
+{$endif}
+
+{ ---------------------------------------------------------------------
+  Some configuration
+  ---------------------------------------------------------------------}
+
+Var
+  InitListLength : Integer = 10; // Initial length of test/suite lists
+  GrowFactor : Double = 3/2; // Grow factor when list needs to be grown.
+  DefaultSuiteName : Shortstring = 'Globals'; // Default name to use
+  RequirePassed : Boolean = False; // If set to true, tests must explicitly call passed.
+  DefaultDoubleDelta : Double = 1E-14;
+  DefaultSingleDelta : Single = 1E-9;
+  DefaultExtendedDelta : Extended = 1E-14;
+
+{ ---------------------------------------------------------------------
+  Some test structures
+  ---------------------------------------------------------------------}
+
+Type
+  // General status code
+  TTestError = (
+    teOK,                  // All ok
+    teTestsRunning,        // Tests already running
+    teRegistryEmpty,       // no tests in registry
+    teNoMemory,            // Could not allocate memory
+    teNoSuite,             // No suite specified
+    teNoSuiteName,         // No suite name specified
+    teSuiteSetupFailed,    // Suite setup failed
+    teSuiteTeardownFailed, // Suite teardown failed
+    teDuplicateSuite,      // Duplicate suite name
+    teSuiteInactive,       // Attempt to run inactive suite
+    teNoTest,              // No test specified
+    teNoTestName,          // No test name specified
+    teDuplicateTest,       // Duplicate test name specified
+    teTestNotInSuite,      // Given Test not member of given suite
+    teTestInactive,        // Attempt to run inactive test
+    teRunStartHandler,      // An error occurred during the run start handler;
+    teRunCompleteHandler   // An error occurred during the run complete handler;
+  );
+
+  // What to do if an error occurs during test suite
+  TErrorAction = (
+    eaIgnore, // Ignore errors, continue testing
+    eaFail,   // Fail current test run.
+    eaAbort   // Abort all (Halt(1));
+  );
+
+  // Test prototypes. Empty result inficate succes, nonempty means failure
+
+  // test suite setup.
+  TTestSetup = Function : TTestString;
+  // test suite teardown.
+  TTestTearDown = Function : TTestString;
+  // test run.
+  TTestRun = Function : TTestString;
+  // test run procedure.
+  TTestRunProc = Procedure;
+
+  // A single test
+  TTestOption = (toInactive);
+  TTestOptions = Set of TTestOption;
+  PTest = ^TTest;
+  TTest = Record
+    Run : TTestRun;           // Function to execute when test is run.
+    RunProc : TTestRunProc;   // Procedure to execute when test is run. Run takes precedence.
+    Name : TTestString;       // Name of the test. Must not be empty.
+    Options : TTestOptions;   // True if the test is active (default). Inactive tests are not run.
+    Data : Pointer;           // Data to be associated with the test.
+  end;
+  TTestArray = Array of PTest;
+  // List of tests structure.
+  TTestList = Record
+    Items : TTestArray;  // Array of Test pointers. Can be oversized. Initialized to InitListLength
+    Count : Integer;     // Actual number of tests in list.
+  end;
+  PTestList = ^TTestList;
+
+  // A testsuite.
+  TSuiteOption = (soInactive,soSetupTearDownPerTest);
+  TSuiteOptions = Set of TSuiteOption;
+
+  PSuiteList = ^TSuiteList;
+  PSuite = ^TSuite;
+  TSuiteArray = Array of PSuite;
+  TSuiteList = Record
+    Items : TSuiteArray; // Array of Suite pointers. Can be oversized. Initialized to InitListLength
+    Count : Integer;      // Actual number of suites in list.
+  end;
+
+  TSuite = Record
+    Suites : TSuiteList;            // Test Suites inside this suite
+    Tests : TTestList;              // Tests in this suite
+    Setup : TTestSetup;             // Setup function, executed once at start of suite.
+    Teardown : TTestTearDown;       // Teardown function. By Default executed once at end of suite (regardless of errors)
+    Name : TTestString;             // Name of the suite, must not be empty.
+    Options: TSuiteOptions;         // True if the suite is active (
+    ParentSuite : PSuite;           // Parent suites of this suite
+    Data : Pointer;                 // Data to be associated with the suite
+  end;
+
+
+
+  TTestResult = (
+    trEmpty,               // test didn't call any assert or didn't report error.
+    trOK,                  // Test ran OK
+    trSuiteInactive,       // Suite was inactive (only on suite records)
+    trSuiteSetupFailed,    // Suite setup failed (only on suite records)
+    trSuiteTearDownFailed, // Suite setup failed (only on suite records)
+    trTestInactive,        // test was inactive
+    trTestIgnore,          // test was ignored
+    trAssertFailed,        // An assertion failed.
+    trTestError,           // An error happened during the test (exception)
+    trHandlerError         // An error occurred during the global test hooks (exception)
+    );
+
+  {
+    Results are stored in a tree. At each level if the
+  }
+
+  PResultRecord = ^TResultRecord;
+  TResultRecord = record
+    Suite : PSuite;             // Testsuite from which this is a result. If the global run handlers have an error, a result record is created with Suite=Nil.
+    Test : PTest;               // Test from which this is the result. If this is nil, then the result is the global testsuite result.
+    ElapsedTime : Integer;      // time spent in test, in milliseconds. Only calculated if time hook is set
+    TestResult : TTestResult;   // Result.
+    TestMessage : TTestString;  // Error message, if any. If an exception is expected, then the message is set PRIOR to the error.
+    ExpectException : TClass;   // Exception to expect.
+    ParentResult,               // Parent result (suite result)
+    ChildResults,               // Child result (tests or suites)
+    NextResult : PResultRecord; // Next result at this level.
+  end;
+
+  // Statistics about a suite test run.
+  TSuiteStats = Record
+    Suites,                       // Number of sub suites (recursively)
+    TestsFailed,                  // Number of failed tests.
+    TestsInactive,                // Number of inactive tests.
+    TestsIgnored,                 // Number of ignored tests.
+    TestsRun,                     // Number of run tests.
+    TestsError,                   // Number of tests with an error.
+    TestsUnimplemented : Integer; // Number of unimplemented tests (no result or no Assert calls)
+  end;
+
+  TRunSummary = Record
+    SuitesRun: Integer;       // Number of suites that were run.
+    SuitesFailed : Integer;   // Number of suites that failed in setup/teardown).
+    SuitesInactive : Integer; // Number of inactive suites in the test run
+    TestsRun : Integer;       // Number of tests that were run.
+    TestsFailed : Integer;    // Number of tests that failed.
+    TestsIgnored : Integer;   // Number of tests that were ignored.
+    TestsUnimplemented : Integer;    // Number of unimplemented tests.
+    TestsInactive : Integer;  // Number of inactive tests.
+    AssertCount : Integer;    // Number of times assert was called.
+    Results : TResultRecord;   // Detailed results for all tests/suites
+    ElapsedTime : Integer;    // time spent in test run, in milliseconds; Only calculated if time hook is set
+  end;
+  PRunSummary = ^TRunSummary;
+
+  { EFail }
+
+  // This exception can be raised to exit from a test. When caught, it will mark the test as failed, and copy the message to the testresult.
+  EFail = Class(TObject)
+  Private
+    FMessage : TTestString;
+  Public
+    Constructor Create(Const AMessage : TTestString);
+    Function ToString : RTLString; override;
+  end;
+  // This exception can be raised to exit from a test. When caught, it will mark the test as ignored, and copy the message to the testresult.
+  EIgnore = Class(EFail);
+
+{ ---------------------------------------------------------------------
+  Test Registry management
+  ---------------------------------------------------------------------}
+
+
+// Initialize the testregistry. The registry is implicitly initialized by the management functions
+Function SetupTestRegistry : TTestError;
+// Clean up the testregistry. The registry is implicitly cleaned up on program exit.
+Function TearDownTestRegistry : TTestError;
+// Check if the testregistry was initialized.
+Function TestRegistryOK : Boolean;
+
+// Suite management
+
+// Add a suite with name AName (Required, duplicates forbidden) and Setup/TearDown functions. Returns the new suite or nil on error.
+Function AddSuite(Const AName : TTestString; ASetup : TTestSetup = nil; ATearDown : TTestTearDown = Nil; AParent : PSuite = nil; aPerTestSetupTearDown : Boolean = false) : PSuite;
+Function AddSuite(Const AName : TTestString; AParent : PSuite) : PSuite;
+// Number of currently registered suites. If Recurse is false, only top-level suites are counted.
+Function GetSuiteCount(Recurse : Boolean = True) : Integer;
+// Number of currently registered nested suites. If Recurse is false, only directly nested suites are counted.
+Function GetSuiteCount(ASuite : PSuite; Recurse : Boolean = True) : Integer;
+// Return the 0-based index of the suite names AName (case sensitive). -1 if not found.
+Function GetSuiteIndex(Const AName : TTestString) : Integer;
+// Return the 0-based index of the nested suite names AName (case sensitive). -1 if not found.
+Function GetSuiteIndex(ASuite : PSuite; Const AName : TTestString) : Integer;
+// Return the suite at position AIndex. Nil on error.
+Function GetSuite(Const AIndex : Integer) : PSuite;overload;
+// Return the suite named AName, starting at AParent. Nil if it is not found. Suite can be named Suite1.Sub2.Sub3
+Function GetSuite(Const AName : TTestString; AParent : PSuite = Nil) : PSuite;overload;
+
+
+// Test management
+
+// Register a test with name ATestName in suite ASuiteName. The test function is ARun.
+// If Suitename is empty, DefaultSuiteName is used, and registered if it does not exist yet.
+// Returns the newly created test.
+// It is allowed to register the same function with different names
+Function AddTest(Const ATestName : TTestString; ARun : TTestRun; Const ASuiteName : TTestString = '') : PTest;
+Function AddTest(Const ATestName : TTestString; ARun : TTestRunProc; Const ASuiteName : TTestString = '') : PTest;
+// Same as above, only the suite is explitly given. It may not be nil.
+Function AddTest(Const ATestName : TTestString; ARUn : TTestRun; Const ASuite : PSuite) : PTest;
+Function AddTest(Const ATestName : TTestString; ARUn : TTestRunProc; Const ASuite : PSuite) : PTest;
+// Return the 0-Based index of ATestName in suite ASuitename. Returns -1 on error or if nor found.
+Function GetTestIndex(Const ASuiteName : TTestString; Const ATestName : TTestString) : Integer;
+// Return the 0-Based index of ATestName in suite ASuit. Returns -1 on error or if nor found.
+Function GetTestIndex(Const ASuite : PSuite; Const ATestName : TTestString) : Integer;
+// Return 0-Based index of ATest in ASuite. Returns -1 if not found or on error.
+Function GetTestIndex(Const ASuite : PSuite; Const ATest : PTest) : Integer;
+// Return the number of tests in testsuite. On Error -1 is returned.
+Function GetTestCount(Const ASuiteName : TTestString) : Integer;
+// Return the number of tests in testsuite. On Error -1 is returned.
+Function GetTestCount(Const ASuite : PSuite) : Integer;
+// Return the test named ATestName in ASuiteName. Returns Nil if not found.
+Function GetTest(Const ASuiteName : TTestString; Const ATestName : TTestString) : PTest;
+// Return the test named ATestName in ASuite. Returns Nil if not found.
+Function GetTest(Const ASuite : PSuite; Const ATestName : TTestString) : PTest;
+// Return the test with index ATestindex in ASuite. Returns Nil if not found.
+Function GetTest(Const ASuite : PSuite; Const ATestIndex : Integer) : PTest;
+// Return True if ATest is part of ASuite. False otherwise or on error.
+Function TestIsInSuite(Const ASuite : PSuite; Const ATest : PTest) : Boolean;
+
+{ ---------------------------------------------------------------------
+  Running tests
+  ---------------------------------------------------------------------}
+
+// The following are always complete test runs.
+// Results from previous runs are cleared when one of these functions is called.
+
+// Run all tests. Returns teOK if all tests were run without problems (failure is not a problem)
+Function RunAllTests : TTestError;
+// Run suite AName from the testsuite. Results can be viewed in GetCurrentRun.
+Function RunSuite(Const ASuiteName : TTestString) : TTestError;
+// Run suite ASuiteIndex in the testsuite. Results can be viewed in GetCurrentRun.
+Function RunSuite(ASuiteIndex : Integer) : TTestError;
+// Run suite ASuite (need not be registeredà. Results can be viewed in GetCurrentRun.
+Function RunSuite(ASuite : PSuite) : TTestError;
+
+// Running a test
+// Run test ATestName from Suite ASuiteName in the testsuite. Results can be viewed in GetCurrentRun.
+Function RunTest(Const ASuiteName : TTestString; Const ATestName: TTestString) : TTestError;
+// Run test ATestName from Suite ASuite. ASuite need not be registered. Results can be viewed in GetCurrentRun.
+Function RunTest(ASuite : PSuite; Const ATestName : TTestString) : TTestError;
+// Run test ATest from Suite ASuite. ASuite need not be registered. Results can be viewed in GetCurrentRun.
+Function RunTest(ASuite : PSuite; ATest : PTest) : TTestError;
+
+// Special function: will register a default test and runs all tests.
+// Intended for fast test suite creation and execution.
+// It will halt the program with the exit codes of RunAllSysTests
+// Additionally, an exit code of 2 may result if there was no test
+// Doing this will disable -t and -s command-line options..
+Procedure RunTest(ARun : TTestRun);
+
+// Get run summary of the current test run. Remains available after run is finished, before a new run is started.
+Function GetCurrentRun : TRunSummary;
+// Get currently running suite, may be nil.
+Function GetCurrentSuite : PSuite;
+// Get currently running test, may be nil.
+Function GetCurrentTest : PTest;
+// Get currently test result record, may be nil.
+Function GetCurrentResult : PResultRecord;
+// Get result stats for a suite result record.
+Procedure GetSuiteStats(AResults : PResultRecord; Out Stats : TSuiteStats);
+
+{ ---------------------------------------------------------------------
+  Test Result management
+  ---------------------------------------------------------------------}
+
+Function CountResults(Results : PResultRecord) : Integer;
+
+{ ---------------------------------------------------------------------
+  Assertions
+  ---------------------------------------------------------------------}
+
+// Mark test as ignored with given message. Always returns false.
+Function Ignore(Const Msg : TTestString) : Boolean;
+// Mark test as failed with given message.
+Function Fail(Const Msg : TTestString) : Boolean;
+// Mark test as failed with given message, raising EFail.
+// will not return, but for symmetry has the same call signature
+Function FailExit(Const Msg : TTestString) : Boolean;
+// Mark test as ignored with given message, raising EIgnore.
+// will not return, but for symmetry has the same call signature
+Function IgnoreExit(Const Msg : TTestString) : Boolean;
+// If RequirePassed = True, then this must be called to mark a test as passed.
+// Otherwise it is marked 'unimplemented' if assert was never called during execution of the test.
+Function AssertPassed (AMessage : TTestString=''): Boolean;
+ // Mark test as passed if ACondition = true, failed if False. Returns ACondition
+Function AssertTrue(const AMessage : TTestString; ACondition : Boolean): Boolean;
+// Mark test as passed if ACondition = false, failed if true. Returns Not ACondition
+Function AssertFalse(const AMessage : TTestString; ACondition : Boolean): Boolean;
+// Check if 2 strings are equal. Mark test as failed if not.
+Function AssertEquals(AMessage : TTestString; const AExpected, AActual : ShortString): Boolean;
+Function AssertEquals(AMessage : TTestString; const AExpected, AActual : AnsiString): Boolean;
+Function AssertEquals(AMessage : TTestString; const AExpected, AActual : UTF8String): Boolean;
+Function AssertEquals(AMessage : TTestString; const AExpected, AActual : UnicodeString): Boolean;
+Function AssertEquals(AMessage : TTestString; const AExpected: Char; AActual : UnicodeString): Boolean;
+// Check if 2 ordinals are equal. Mark test as failed if not.
+Function AssertEquals(AMessage : TTestString; const AExpected, AActual : Boolean): Boolean;
+Function AssertEquals(AMessage : TTestString; const AExpected, AActual : Shortint): Boolean;
+Function AssertEquals(AMessage : TTestString; const AExpected, AActual : Byte): Boolean;
+Function AssertEquals(AMessage : TTestString; const AExpected, AActual : Smallint): Boolean;
+Function AssertEquals(AMessage : TTestString; const AExpected, AActual : Word): Boolean;
+Function AssertEquals(AMessage : TTestString; const AExpected, AActual : Longint): Boolean;
+Function AssertEquals(AMessage : TTestString; const AExpected, AActual : Cardinal): Boolean;
+Function AssertEquals(AMessage : TTestString; const AExpected, AActual : Int64): Boolean;
+Function AssertEquals(AMessage : TTestString; const AExpected, AActual : QWord): Boolean;
+// Floating point types
+Function AssertEquals(AMessage : TTestString; const AExpected, AActual : Currency): Boolean;
+Function AssertEquals(AMessage : TTestString; const AExpected, AActual: Double; ADelta : Double = 0): Boolean;
+Function AssertEquals(AMessage : TTestString; const AExpected, AActual: Single; ADelta : Single = 0): Boolean;
+Function AssertEquals(AMessage : TTestString; const AExpected, AActual: Extended; ADelta : Extended = 0): Boolean;
+// Assert null
+Function AssertNull(AMessage : TTestString; const AValue : Pointer): Boolean;
+Function AssertNotNull(AMessage : TTestString; const AValue : Pointer): Boolean;
+
+// Check if 2 pointers are equal. Mark test as failed if not.
+Function AssertEquals(AMessage : TTestString; const AExpected, AActual : Pointer): Boolean;
+Function AssertDiffers(AMessage : TTestString; const AExpected, AActual : Pointer): Boolean;
+// Check if 2 class types are equal. Mark test as failed if not.
+Function AssertEquals(AMessage : TTestString; const AExpected, AActual : TClass): Boolean;
+// Check if 2 class types are equal. Mark test as failed if not.
+Function AssertInheritsFrom(AMessage : TTestString; const AChild, AParent : TObject): Boolean;
+Function AssertInheritsFrom(AMessage : TTestString; const AChild, AParent : TClass): Boolean;
+// Check if 2 object instances are equal. Mark test as failed if not.
+Function AssertSame(AMessage : TTestString; const AExpected, AActual : TObject): Boolean;
+// Check if 2 object instances are different. Mark test as failed if they are equal.
+Function AssertNotSame(AMessage : TTestString; const AExpected, AActual : TObject): Boolean;
+// Run procedure ARun. Expect an exception. If none is raised, or the class differs, mark the test as failed.
+Function AssertException(const AMessage: string; AExceptionClass: TClass; ARun: TProcedure) : boolean;
+Function AssertException(const AMessage: string; AExceptionClass: TClass; ARun: TTestRun) : boolean;
+
+// Tell the testsuite that the test will raise an exception of class ACLass.
+// If the test does not raise an exception, or the exception class differs, the test is marked as failed.
+Function ExpectException(AMessage : TTestString; AClass : TClass) : Boolean;
+
+{ ---------------------------------------------------------------------
+  Test Hooks (Decorators)
+  ---------------------------------------------------------------------}
+
+Type
+  // All arguments must be considered read-only.
+
+  // Test Run hooks.
+  // Handler called at the start of a testrun. Suites is an array of suites that will be run.
+  TRunStartHandler = Procedure(Const Suites : TSuiteArray);
+  // Handler called at the completion of a testrun. ARunResult is the run summary.
+  TRunCompleteHandler = Procedure(Const ARunResult : TRunSummary);
+
+  // Test suite hooks.
+
+  // Handler called at the start of a suite, before suite setup. ASuite is the result.
+  TSuiteStartHandler = Procedure(ASuite : PSuite);
+  // Handler called at the end of a suite, after suite teardown. SuiteResults is an array of test results. The first record is a global suite result.
+  TSuiteCompleteHandler = Procedure(ASuite : PSuite; Const SuiteResults : PResultRecord);
+  // Handler called if the suite setup function failed (non-empty string returned or exception)
+  TSuiteSetupFailureHandler = Procedure(ASuite : PSuite; Const AError : TTestString);
+  // Handler called if the suite teardown function failed.(non-empty string returned or exception)
+  TSuiteTearDownFailureHandler = Procedure(ASuite : PSuite; Const AError : TTestString);
+
+  // Test hooks.
+
+  // Handler called at the start of a test run.
+  TTestStartHandler = Procedure(ATest : PTest; ASuite : PSuite);
+  // Handler called at the end of a test run (regardless of pass/fail);
+  TTestCompleteHandler = Procedure(ATest: PTest; ASuite : PSuite; Const TestResult : PResultRecord);
+
+  // Other hooks
+
+  // The sysutils or dos unit are not available to get the time. Support for getting time
+  // can be enabled by including a function with the correct signature. For example:
+  // using sysutils:  SetTimeHook(@SysUtils.Now);
+
+  TTimeHook = Function : TDateTime;
+
+// These functions set the various hooks. The old value is returned, so hooks can be chained.
+Function SetRunStartHandler(AHandler : TRunStartHandler) : TRunStartHandler;
+Function SetRunCompleteHandler(AHandler : TRunCompleteHandler) : TRunCompleteHandler;
+Function SetSuiteStartHandler(AHandler : TSuiteStartHandler) : TSuiteStartHandler;
+Function SetSuiteCompleteHandler(AHandler : TSuiteCompleteHandler) : TSuiteCompleteHandler;
+Function SetSuitesetupFailureHandler(AHandler : TSuitesetupFailureHandler) : TSuitesetupFailureHandler;
+Function SetSuiteTearDownFailureHandler(AHandler : TSuiteTearDownFailureHandler) : TSuiteTearDownFailureHandler;
+Function SetTestStartHandler(AHandler : TTestStartHandler) : TTestStartHandler;
+Function SetTestCompleteHandler(AHandler : TTestCompleteHandler) : TTestCompleteHandler;
+
+// These functions get the current value of the various hooks.
+Function GetSuiteStartHandler : TSuiteStartHandler;
+Function GetTestStartHandler : TTestStartHandler;
+Function GetTestCompleteHandler : TTestCompleteHandler;
+Function GetSuiteCompleteHandler : TSuiteCompleteHandler;
+Function GetRunStartHandler : TRunStartHandler;
+Function GetRunCompleteHandler : TRunCompleteHandler;
+Function GetSuitesetupFailureHandler : TSuitesetupFailureHandler;
+Function GetSuiteTearDownFailureHandler : TSuiteTearDownFailureHandler;
+// Clear all handlers
+Procedure ClearTestHooks;
+
+// Time hook management:
+
+Function GetTimeHook : TTimeHook;
+Function SetTimeHook(AHook : TTimeHook) : TTimeHook;
+// Is the time hook set ?
+Function HaveTimeHook : Boolean; inline;
+
+// Current time as returned by hook, or 0 if hook not set.
+Function GetTimeFromHook : TDateTime;
+// Timespan in milliseconds between Current time as returned by hook and From. 0 if hook not set.
+Function GetTimeDiff(From : TDateTime) : Integer;
+// Convert timespan in milliseconds to human readable string hh:nn:ss.ZZZ (z milliseconds)
+Function SysTimeString(MSec : Integer) :  TTestString;
+
+{ ---------------------------------------------------------------------
+  Errors
+  ---------------------------------------------------------------------}
+
+// Get the current error status.
+Function GetTestError : TTestError;
+// Get a message corresponding to the error.
+Function GetTestErrorMessage : TTestString;
+// Set test error. If the current is not teOK, it cannot be overwritten except by teOK.
+Function SetTestError(AError : TTestError) : TTestError;
+// What to do if a non-teOK value is set ?
+Function GetErrorAction : TErrorAction;
+// Set the error action, returns the old value.
+Function SetErrorAction(AError : TErrorAction) : TErrorAction;
+
+
+
+// System hooks
+Type
+  // Verbosity of system hooks
+  TSysRunVerbosity = (
+    rvQuiet,  // No messages at all
+    rvFailures, // only output failures
+    rvNormal, // normal messages
+    rvVerbose // Lots of messages
+  );
+
+// Setup system hooks. Called by unit initialization.
+Procedure SetupSysHandlers;
+// Teardown system hooks. Called by unit finalization.
+Procedure TearDownSysHandlers;
+// Get current run mode.
+Function GetSysRunVerbosity: TSysRunVerbosity;
+/// Set currentsystem run mode
+Function SetSysRunVerbosity(AMode : TSysRunVerbosity) : TSysRunVerbosity;
+// Set system hook variables based on commandline.
+// -v --verbose: verbose messaging
+// -f --failures: only output failures
+// -q --quiet: no messaging
+// -n --normal: no messaging
+// -o --output=Name: write to named file.
+// -s --suite=Suite:  name of suite to run
+// -t --test=name of test to run. If no suite is specified, DefaultSuiteName is assumed.
+// -l --list simply list all tests.
+// -h --help show help
+Procedure ProcessSysCommandline;
+// Process command line, run tests based on variables set.
+// Program exit codes:
+// 0 : All tests completed succesfully
+// 1 : tests completed with failures.
+// 3 : Suite not found (-s --suite)
+// 4 : Testsuite didn't run correct.
+// 6 : Test not found (-t --test)
+Procedure RunAllSysTests;
+// Return the OS for which the system was compiled, as a lowercase string.
+// This can help when registering tests.
+Function GetSysTestOS : TTestString;
+// Get test setting. The settings file is by default a file called punit.cfg
+// Format is Name = Value. Comment lines start with ; or #
+Function SysGetSetting(Const AName : TTestString) : TTestString;
+
+implementation
+
+Const
+  SExpected = 'Expected';
+  SActual = 'Actual';
+  SErrNoTestProcedure = 'No test procedure';
+//  SIsNotNil = 'Is not nil';
+//  SIsNil = 'Is nil';
+
+Var
+  CurrentError : TTestError;
+  CurrentErrorAction : TErrorAction;
+  CurrentTimeHook : TTimeHook;
+
+  TestRegistry : TSuiteList;
+
+  GlobalSuiteStartHandler : TSuiteStartHandler;
+  GlobalTestStartHandler : TTestStartHandler;
+  GlobalTestCompleteHandler : TTestCompleteHandler;
+  GlobalSuiteCompleteHandler : TSuiteCompleteHandler;
+  GlobalRunStartHandler : TRunStartHandler;
+  GlobalRunCompleteHandler : TRunCompleteHandler;
+  GlobalSuitesetupFailureHandler : TSuitesetupFailureHandler;
+  GlobalSuiteTearDownFailureHandler : TSuiteTearDownFailureHandler;
+  CurrentSuite : PSuite;
+  CurrentTest : PTest;
+  CurrentRun : TRunSummary;
+  CurrentSuiteResult,
+  CurrentResult : PResultRecord;
+
+{ ---------------------------------------------------------------------
+  Handler management
+  ---------------------------------------------------------------------}
+
+function GetTimeHook: TTimeHook;
+
+begin
+  Result:=CurrentTimeHook;
+end;
+
+function SetTimeHook(AHook: TTimeHook): TTimeHook;
+
+begin
+  Result:=CurrentTimeHook;
+  CurrentTimeHook:=AHook;
+end;
+
+function HaveTimeHook: Boolean;
+begin
+  Result:=Assigned(CurrentTimeHook);
+end;
+
+function GetTimeFromHook: TDateTime;
+
+begin
+  if HaveTimeHook then
+    Result:=CurrentTimeHook()
+  else
+    Result:=0;
+end;
+
+function GetTimeDiff(From: TDateTime): Integer;
+
+const // Copied from sysutils;
+   HoursPerDay = 24;
+   MinsPerHour = 60;
+   SecsPerMin  = 60;
+   MSecsPerSec = 1000;
+   MinsPerDay  = HoursPerDay * MinsPerHour;
+   SecsPerDay  = MinsPerDay * SecsPerMin;
+   MSecsPerDay = SecsPerDay * MSecsPerSec;
+
+Var
+  T : TDateTime;
+
+begin
+  T:=GetTimeFromHook;
+  if (T=0) or (From=0) then
+    Result:=0
+  else
+    Result:=Round((T-From)*MSecsPerDay);
+end;
+
+function SetSuiteStartHandler(AHandler: TSuiteStartHandler): TSuiteStartHandler;
+begin
+  Result:=GlobalSuiteStartHandler;
+  GlobalSuiteStartHandler:=AHandler;
+end;
+
+function SetTestStartHandler(AHandler: TTestStartHandler): TTestStartHandler;
+
+begin
+  Result:=GlobalTestStartHandler;
+  GlobalTestStartHandler:=AHandler;
+end;
+
+function SetTestCompleteHandler(AHandler: TTestCompleteHandler
+  ): TTestCompleteHandler;
+
+begin
+  Result:=GlobalTestCompleteHandler;
+  GlobalTestCompleteHandler:=AHandler;
+end;
+
+function SetSuiteCompleteHandler(AHandler: TSuiteCompleteHandler
+  ): TSuiteCompleteHandler;
+
+begin
+  Result:=GlobalSuiteCompleteHandler;
+  GlobalSuiteCompleteHandler:=AHandler;
+end;
+
+function SetRunCompleteHandler(AHandler: TRunCompleteHandler
+  ): TRunCompleteHandler;
+
+begin
+  Result:=GlobalRunCompleteHandler;
+  GlobalRunCompleteHandler:=AHandler;
+end;
+
+function SetRunStartHandler(AHandler: TRunStartHandler): TRunStartHandler;
+
+begin
+  Result:=GlobalRunStartHandler;
+  GlobalRunStartHandler:=AHandler;
+end;
+
+function SetSuitesetupFailureHandler(AHandler: TSuitesetupFailureHandler
+  ): TSuitesetupFailureHandler;
+
+begin
+  Result:=GlobalSuitesetupFailureHandler;
+  GlobalSuitesetupFailureHandler:=AHandler;
+end;
+
+function SetSuiteTearDownFailureHandler(AHandler: TSuiteTearDownFailureHandler
+  ): TSuiteTearDownFailureHandler;
+
+begin
+  Result:=GlobalSuiteTearDownFailureHandler;
+  GlobalSuiteTearDownFailureHandler:=AHandler;
+end;
+
+
+function GetSuiteStartHandler: TSuiteStartHandler;
+begin
+  Result:=GlobalSuiteStartHandler;
+end;
+
+function GetTestStartHandler: TTestStartHandler;
+begin
+  Result:=GlobalTestStartHandler;
+end;
+
+function GetTestCompleteHandler: TTestCompleteHandler;
+begin
+  Result:=GlobalTestCompleteHandler;
+end;
+
+function GetSuiteCompleteHandler: TSuiteCompleteHandler;
+begin
+  Result:=GlobalSuiteCompleteHandler;
+end;
+
+function GetRunStartHandler: TRunStartHandler;
+begin
+  Result:=GlobalRunStartHandler;
+end;
+
+function GetRunCompleteHandler: TRunCompleteHandler;
+begin
+  Result:=GlobalRunCompleteHandler;
+end;
+
+function GetSuitesetupFailureHandler: TSuitesetupFailureHandler;
+
+begin
+  Result:=GlobalSuiteSetupFailureHandler;
+end;
+
+function GetSuiteTearDownFailureHandler: TSuiteTearDownFailureHandler;
+
+begin
+  Result:=GlobalSuiteTearDownFailureHandler;
+end;
+
+procedure ClearTestHooks;
+begin
+  SetSuiteStartHandler(Nil);
+  SetTestStartHandler(Nil);
+  SetTestCompleteHandler(Nil);
+  SetSuiteCompleteHandler(Nil);
+  SetRunStartHandler(Nil);
+  SetRunCompleteHandler(Nil);
+  SetSuiteSetupFailureHandler(Nil);
+  SetSuiteTearDownFailureHandler(Nil);
+end;
+
+{ ---------------------------------------------------------------------
+  Error management
+  ---------------------------------------------------------------------}
+
+Const
+   SErrUnknown             = 'Unknown error';
+   SErrOK                  = 'OK';
+   SErrTestsRunning        = 'Tests already running';
+   SErrRegistryEmpty       = 'Testregistry emmpty';
+   SErrNoMemory            = 'No memory available';
+   SErrNoSuite             = 'No suite available';
+   SErrNoSuiteName         = 'No suite name specified';
+   SErrSuiteSetupFailed    = 'Suite setup failed';
+   SerrSuiteTeardownFailed = 'Suite teardown failed';
+   SErrDuplicateSuite      = 'Duplicate suite name';
+   SErrSuiteInactive       = 'Attempt to run inactive suite';
+   SErrNoTest              = 'No test specified';
+   SErrNoTestName          = 'No test name specified';
+   SErrDuplicateTest       = 'Duplicate test name specified';
+   SErrTestNotInSuite      = 'Test not member of suite';
+   SErrTestInactive        = 'Attempt to run inactive test';
+
+function GetTestError: TTestError;
+begin
+  Result:=CurrentError;
+end;
+
+function GetTestErrorMessage: TTestString;
+
+begin
+  Case GetTestError of
+    teOK:                  Result:=SErrOK;
+    teTestsRunning:        Result:=SErrTestsRunning;
+    teRegistryEmpty:       Result:=SErrRegistryEmpty;
+    teNoMemory:            Result:=SErrNoMemory;
+    teNoSuite:             Result:=SErrNoSuite;
+    teNoSuiteName:         Result:=SErrNoSuiteName;
+    teSuiteSetupFailed:    Result:=SErrSuiteSetupFailed;
+    teSuiteTeardownFailed: Result:=SErrSuiteTeardownFailed;
+    teDuplicateSuite:      Result:=SErrDuplicateSuite;
+    teSuiteInactive:       Result:=SErrSuiteInactive;
+    teNoTest:              Result:=SErrNoTest;
+    teNoTestName:          Result:=SErrNoTestName;
+    teDuplicateTest:       Result:=SErrDuplicateTest;
+    teTestNotInSuite:      Result:=SErrTestNotInSuite;
+    teTestInactive:        Result:=SErrTestInactive;
+  else
+    Result:=SErrUnknown;
+  end;
+end;
+
+function SetTestError(AError: TTestError): TTestError;
+
+begin
+  // Forces us to reset the error at all points
+  if (AError=teOK) or (CurrentError=teOK)  then
+    CurrentError:=AError;
+  Result:=CurrentError;
+  If (AError<>teOK) and (CurrentErrorAction=eaAbort) then
+    Halt(1);
+end;
+
+Function CombineError(Original, Additional : TTestError) : TTestError;
+
+begin
+  if (teOK=Original) then
+    Result:=Additional
+  else
+    Result:=Original;
+end;
+
+function GetErrorAction: TErrorAction;
+
+begin
+  Result:=CurrentErrorAction;
+end;
+
+function SetErrorAction(AError: TErrorAction): TErrorAction;
+
+begin
+  Result:=CurrentErrorAction;
+  CurrentErrorAction:=AError;
+end;
+
+{ ---------------------------------------------------------------------
+  List management.
+  ---------------------------------------------------------------------}
+
+Procedure CheckGrowSuiteList(AList : PSuiteList);
+
+Var
+  L : Integer;
+
+begin
+  L:=Length(AList^.Items);
+  if (AList^.Count=L) then
+    begin
+    if (L=0) then
+      L:=InitListLength
+    else
+      L:=Round(L*3/2);
+    SetLength(AList^.Items,L);
+    end;
+end;
+
+Procedure DoneSuiteList(Var Suites : TSuiteList); forward;
+
+Function DoneSuite(ASuite : PSuite) : TTestError;
+
+Var
+  I : Integer;
+
+begin
+  SetTestError(teOK);
+  With ASuite^ do
+    begin
+    DoneSuiteList(Suites);
+    For I:=0 to Tests.Count-1 do
+      Dispose(Tests.Items[i]);
+    SetLength(Tests.Items,0);
+    Tests.Count:=0;
+    end;
+  Dispose(ASuite);
+  Result:=GetTestError;
+end;
+
+
+Procedure DoneSuiteList(Var Suites : TSuiteList);
+
+Var
+  I : Integer;
+
+begin
+  For I:=0 to Suites.Count-1 do
+    DoneSuite(Suites.Items[i]);
+  SetLength(Suites.Items,0);
+  Suites.Count:=0;
+end;
+
+
+Procedure CheckGrowTests(Var AList : TTestList);
+
+Var
+  L : Integer;
+
+begin
+  L:=Length(AList.Items);
+  if (L=AList.Count) then
+    begin
+    if L=0 then
+      L:=InitListLength
+    else
+      L:=Round(L*GrowFactor);
+    SetLength(AList.Items,L);
+    end;
+end;
+
+{ ---------------------------------------------------------------------
+  Testsuite Registry management
+  ---------------------------------------------------------------------}
+
+function TestRegistryOK: Boolean;
+begin
+  Result:=Length(TestRegistry.Items)<>0;
+end;
+
+
+Procedure InitSuiteList(Var Suites: TSuiteList);
+
+begin
+  Suites.Count:=0;
+  CheckGrowSuiteList(@Suites);
+end;
+
+Procedure DoSetupTestRegistry;
+
+begin
+  if TestRegistry.Count<>0 then exit;
+  InitSuiteList(TestRegistry);
+end;
+
+function SetupTestRegistry: TTestError;
+
+begin
+  Result:=SetTestError(teOK);
+  Result:=TearDownTestRegistry;
+  if Result=teOK then
+    DoSetupTestRegistry;
+end;
+
+function TearDownTestRegistry: TTestError;
+
+
+begin
+  SetTestError(teOK);
+  DoneSuiteList(TestRegistry);
+  Result:=GetTestError;
+end;
+
+{ ---------------------------------------------------------------------
+  Suite management
+  ---------------------------------------------------------------------}
+
+
+Function CheckInactive : Boolean;
+
+begin
+  Result:=(CurrentSuite=Nil);
+  If Not Result then
+    SetTestError(teTestsRunning);
+end;
+
+function AddSuite(const AName: TTestString; AParent: PSuite): PSuite;
+begin
+  Result:=AddSuite(AName,Nil,Nil,AParent);
+end;
+
+function GetSuiteCount(ASuite: PSuiteList; Recurse: Boolean): Integer;
+
+Var
+  I : Integer;
+
+begin
+  Result:=ASuite^.Count;
+  if Recurse then
+    For I:=0 to ASuite^.Count-1 do
+      Result:=Result+GetSuiteCount(ASuite^.Items[i],True);
+end;
+
+function GetSuiteCount(Recurse: Boolean): Integer;
+begin
+  Result:=GetSuiteCount(PsuiteList(@TestRegistry),Recurse);
+end;
+
+Function GetSuiteCount(ASuite : PSuite; Recurse : Boolean = True) : Integer;
+
+begin
+  if (ASuite=Nil) then
+    Result:=0
+  else
+    Result:=GetSuiteCount(PSuiteList(@ASuite^.Suites),Recurse);
+end;
+
+Function GetSuiteIndex(Const AList : PSuiteList; Const AName: TTestString): Integer;
+
+begin
+  Result:=-1;
+  if (AList=Nil) then
+    begin
+    SetTestError(teNoSuite);
+    Exit;
+    end;
+  SetTestError(teOK);
+  Result:=AList^.Count-1;
+  While (Result>=0) and (AList^.Items[Result]^.Name<>AName) do
+    Dec(Result);
+end;
+
+function GetSuiteIndex(ASuite : PSuite; const AName: TTestString): Integer;
+
+begin
+  if ASuite=Nil then
+    Result:=0
+  else
+    Result:=GetSuiteIndex(PSuiteList(@ASuite^.Suites),AName);
+end;
+
+function GetSuiteIndex(const AName: TTestString): Integer;
+
+begin
+  Result:=GetSuiteIndex(PSuiteList(@TestRegistry),AName);
+end;
+
+Function GetSuite(const AList : PSuiteList; Const AIndex: Integer): PSuite;
+
+begin
+  If (AIndex>=0) And (AIndex<AList^.Count) then
+    Result:=Alist^.Items[AIndex]
+  else
+    Result:=Nil;
+end;
+
+Function GetSuite(AList : PSuiteList; Const AName : TTestString) : PSuite;
+
+Var
+  I,P : Integer;
+  N : TTestString;
+  L : PSuiteList;
+
+begin
+  if AList=Nil then
+    Result:=Nil
+  else
+    begin
+    N:=AName;
+    L:=AList;
+    P:=0;
+    For I:=1 to Length(N) do
+      if N[i]='.' then
+        P:=I;
+    if (P>0) then
+      begin
+      Result:=GetSuite(L,Copy(N,1,P-1));
+      if (Result<>Nil) then
+        L:=@Result^.Suites
+      else
+        L:=Nil;
+      Delete(N,1,P);
+      end;
+    I:=GetSuiteIndex(L,N);
+    If I<0 then
+      Result:=Nil
+    else
+      Result:=L^.Items[I];
+    end;
+end;
+
+Function GetSuite(Const AName : TTestString; AParent : PSuite = Nil) : PSuite;
+
+Var
+  L : PSuiteList;
+
+begin
+  Result:=Nil;
+  if (AParent<>Nil) then
+    L:=@AParent^.Suites
+  else
+    L:=@TestRegistry;
+  if L<>Nil then
+    Result:=GetSuite(L,AName);
+end;
+
+function GetSuite(const AIndex: Integer): PSuite;
+begin
+  Result:=GetSuite(@TestRegistry,AIndex);
+end;
+
+function AddSuite(const AName: TTestString; ASetup: TTestSetup;
+  ATearDown: TTestTearDown; AParent: PSuite; aPerTestSetupTearDown : Boolean = false): PSuite;
+
+Var
+  S : PSuite;
+  L : PSuiteList;
+begin
+  Result:=Nil;
+  SetTestError(teOK);
+  If not CheckInactive then
+    exit;
+  DoSetupTestRegistry;
+  if AName='' then
+    begin
+    SetTestError(teNoSuiteName);
+    Exit;
+    end;
+  S:=GetSuite(AName,AParent);
+  if (S<>Nil) then
+    begin
+    SetTestError(teDuplicateSuite);
+    Exit;
+    end;
+  if AParent<>Nil then
+    L:=@AParent^.Suites
+  else
+    L:=@TestRegistry;
+  CheckGrowSuiteList(L);
+  New(Result);
+  if (Result=Nil) then
+    SetTestError(teNoMemory)
+  else
+    begin
+    L^.Items[L^.Count]:=Result;
+    FillChar(Result^,Sizeof(TSuite),0);
+    Result^.Name:=AName;
+    Result^.Setup:=ASetup;
+    Result^.Teardown:=ATearDown;
+    Result^.Options:=[];
+    if aPerTestSetupTearDown then
+      Include(Result^.Options,soSetupTearDownPerTest);
+    Result^.Tests.Count:=0;
+    Result^.ParentSuite:=AParent;
+    CheckGrowTests(Result^.Tests);
+    Inc(L^.Count);
+    end;
+  end;
+
+{ ---------------------------------------------------------------------
+  Test management
+  ---------------------------------------------------------------------}
+
+function DoAddTest(const ATestName: TTestString; const ASuite: PSuite): PTest;
+
+Var
+  I : Integer;
+  List : PTestList;
+
+begin
+  Result:=Nil;
+  SetTestError(teOK);
+  if not CheckInactive then
+    Exit;
+  if (ASuite=Nil) then
+    SetTestError(teNoSuite)
+  else If (ATestName='') then
+    SetTestError(teNoTestName)
+  else
+    begin
+    I:=GetTestIndex(ASuite,ATestName);
+    if (I<>-1) then
+      SetTestError(teDuplicateTest)
+    else
+      begin
+      List:=@ASuite^.Tests;
+      CheckGrowTests(List^);
+      New(Result);
+      if (Result=Nil) then
+        SetTestError(teNoMemory)
+      else
+        begin
+        FillChar(Result^,SizeOf(TTest),0);
+        Result^.Name:=ATestName;
+        Result^.Options:=[];
+        List^.Items[List^.Count]:=Result;
+        Inc(List^.Count);
+        end;
+      end;
+    end;
+end;
+
+function AddTest(const ATestName: TTestString; ARun: TTestRun; const ASuite: PSuite): PTest;
+begin
+  Result:=DoAddTest(aTestName,aSuite);
+  if assigned(Result) then
+    Result^.Run:=ARun;
+end;
+
+function AddTest(const ATestName: TTestString; ARun: TTestRunProc; const ASuite: PSuite): PTest;
+begin
+  Result:=DoAddTest(aTestName,aSuite);
+  if assigned(Result) then
+    Result^.RunProc:=ARun;
+end;
+
+
+// Easy access function
+function EnsureSuite(aSuiteName : TTestString) : PSuite;
+
+var
+  SN : TTestString;
+
+begin
+  SetTestError(teOK);
+  SN:=ASuiteName;
+  if (SN='') then
+    SN:=DefaultSuiteName;
+  Result:=GetSuite(SN);
+  if (Result=Nil) and (ASuiteName<>'') then
+    SetTestError(teNoSuite)
+  else
+    begin
+    If (Result=Nil) then
+      Result:=AddSuite(SN,Nil,Nil);
+    end;
+end;
+
+function AddTest(const ATestName: TTestString; ARun: TTestRun;
+  const ASuiteName: TTestString): PTest;
+
+Var
+  S : PSuite;
+
+begin
+  Result:=Nil;
+  S:=EnsureSuite(aSuiteName);
+  If (S<>Nil) then
+    Result:=AddTest(ATestName,ARun,S);
+end;
+
+Function AddTest(Const ATestName : TTestString; ARun : TTestRunProc; Const ASuiteName : TTestString = '') : PTest;
+
+Var
+  S : PSuite;
+
+begin
+  Result:=Nil;
+  S:=EnsureSuite(aSuiteName);
+  If (S<>Nil) then
+    Result:=AddTest(ATestName,ARun,S);
+end;
+
+Function GetTestIndex(Const ASuiteIndex: Integer; Const ATestName: TTestString): Integer;
+begin
+  Result:=GetTestIndex(GetSuite(ASuiteIndex),ATestName);
+end;
+
+function GetTestIndex(const ASuiteName: TTestString;
+  const ATestName: TTestString): Integer;
+begin
+  Result:=GetTestIndex(GetSuite(ASuiteName),ATestName);
+end;
+
+function GetTestIndex(const ASuite: PSuite; const ATestName: TTestString
+  ): Integer;
+
+Var
+  A  : TTestArray;
+
+begin
+  Result:=-1;
+  SetTestError(teOK);
+  if (ASuite=Nil) then
+    SetTestError(teNoSuite)
+  else
+    begin
+    Result:=ASuite^.Tests.Count-1;
+    A:=ASuite^.Tests.Items;
+    While (Result>=0) and (A[Result]^.Name<>ATestName) do
+      Dec(Result);
+    end;
+end;
+
+Function GetTest(Const ASuiteIndex: Integer; Const ATestName: TTestString
+  ): PTest;
+begin
+  Result:=GetTest(GetSuite(ASuiteIndex),ATestName);
+end;
+
+function GetTestCount(const ASuiteName: TTestString): Integer;
+begin
+  Result:=GetTestCount(GetSuite(ASuiteName));
+end;
+
+function GetTestCount(const ASuite: PSuite): Integer;
+begin
+  SetTestError(teOK);
+  Result:=-1;
+  if (ASuite=Nil) then
+    SetTestError(teNoSuite)
+  else
+    Result:=ASuite^.Tests.Count;
+end;
+
+function GetTest(const ASuiteName: TTestString; const ATestName: TTestString
+  ): PTest;
+begin
+  Result:=GetTest(GetSuite(ASuiteName),ATestName);
+end;
+
+function GetTest(const ASuite: PSuite; const ATestName: TTestString): PTest;
+
+Var
+  I,P : Integer;
+  N : TTestString;
+  S : PSuite;
+
+begin
+  N:=ATestName;
+  S:=ASuite;
+  P:=0;
+  For I:=1 to Length(N) do
+    if ATestName[I]='.' then
+      P:=i;
+  If (P>0) then
+    begin
+    S:=GetSuite(Copy(N,1,P-1),S);
+    Delete(N,1,P);
+    end;
+  if (S=Nil) then
+    begin
+    SetTestError(teNoSuite);
+    Exit;
+    end;
+  I:=GetTestIndex(S,N);
+  If (I=-1) then
+    Result:=Nil
+  else
+    Result:=S^.Tests.items[i];
+end;
+
+function GetTest(const ASuite: PSuite; const ATestIndex: Integer): PTest;
+begin
+  SetTestError(teOK);
+  Result:=Nil;
+  if (ASuite=Nil) then
+    SetTestError(teNoSuite)
+  else If (ATestIndex>=0) and (ATestIndex<GetTestCount(ASuite)) then
+    Result:=ASuite^.Tests.Items[ATestindex]
+end;
+
+function GetTestIndex(const ASuite: PSuite; const ATest: PTest): Integer;
+
+Var
+  T : TTestArray;
+
+begin
+  SetTestError(teOK);
+  Result:=-1;
+  if (ASuite=Nil) then
+    SetTestError(teNoSuite)
+  else if (ATest=Nil) then
+    SetTestError(teNoTest)
+  else
+    begin
+    Result:=GetTestCount(ASuite)-1;
+    T:=ASuite^.Tests.Items;
+    While (Result>=0) and (ATest<>T[Result]) do
+      Dec(Result);
+    end;
+end;
+
+function TestIsInSuite(const ASuite: PSuite; const ATest: PTest): Boolean;
+
+begin
+  Result:=GetTestIndex(ASuite,ATest)<>-1;
+end;
+
+{ ---------------------------------------------------------------------
+  Test result management
+  ---------------------------------------------------------------------}
+
+Procedure SetTestResult(Var AResult : TResultRecord; AResultType : TTestResult; AMessage : TTestString; Force : Boolean = False);
+
+Var
+  Prev : TTestResult;
+
+begin
+  if  Not ((AResult.TestResult=trEmpty) or Force) then
+    Exit;
+  Prev:=AResult.TestResult;
+  AResult.TestResult:=AResultType;
+  AResult.TestMessage:=AMessage;
+  // Only increas in case of switch from non-error -> error
+  if (Prev In [trEmpty,trOK]) and not (AResult.TestResult In [trEmpty,trOK])  And (AResult.Test<>Nil) then
+    if AResult.TestResult=trTestIgnore then
+      Inc(CurrentRun.TestsIgnored)
+    else
+      Inc(CurrentRun.TestsFailed);
+end;
+
+Procedure SetTestResult(AResultType : TTestResult; AMessage : TTestString; Force : Boolean = False);
+
+begin
+  if Assigned(CurrentResult) then
+    SetTestResult(CurrentResult^,AResultType,AMessage,Force);
+end;
+
+Function DoAssert(AResult : Boolean; ACondition : TTestString) : Boolean;
+
+begin
+  Inc(CurrentRun.AssertCount);
+  Result:=AResult;
+  if (Not Result) and (Assigned(CurrentResult)) then
+    SetTestResult(CurrentResult^,trAssertFailed,ACondition);
+end;
+
+function CountResults(Results: PResultRecord): Integer;
+begin
+  Result:=0;
+  While Results<>Nil do
+    begin
+    Inc(Result);
+    Results:=Results^.NextResult;
+    end;
+end;
+
+function Ignore(const Msg: TTestString): Boolean;
+
+begin
+  SetTestResult(CurrentResult^,trTestIgnore,Msg);
+  Result:=False;
+end;
+
+function Fail(const Msg: TTestString): Boolean;
+
+begin
+  Result:=DoAssert(False,Msg);
+end;
+
+function FailExit(const Msg: TTestString): Boolean;
+begin
+  Result:=False;
+  Raise EFail.Create(Msg);
+end;
+
+function IgnoreExit(const Msg: TTestString): Boolean;
+begin
+  Result:=False;
+  Raise EIgnore.Create(Msg);
+end;
+
+function AssertPassed(AMessage: TTestString): Boolean;
+begin
+  Result:=DoAssert(True,'');
+  if Assigned(CurrentResult) then
+    SetTestResult(CurrentResult^,trOK,AMessage);
+end;
+
+function AssertTrue(const AMessage: TTestString; ACondition: Boolean): Boolean;
+begin
+  DoAssert(ACondition,AMessage);
+  Result:=ACondition;
+end;
+
+Function ExpectMessage(AExpect,AActual : ShortString; Quote : Boolean = False) : ShortString;
+
+begin
+  if Quote then
+    begin
+    AExpect:='"'+AExpect+'"';
+    AActual:='"'+AActual+'"';
+    end;
+  Result:=SExpected+': '+AExpect+' '+SActual+': '+AActual;
+end;
+
+Function ExpectMessage(AExpect,AActual : AnsiString; Quote : Boolean = False) : AnsiString;
+
+begin
+  if Quote then
+    begin
+    AExpect:='"'+AExpect+'"';
+    AActual:='"'+AActual+'"';
+    end;
+  Result:=SExpected+': '+AExpect+' '+SActual+': '+AActual;
+end;
+
+Function ExpectMessage(AExpect,AActual : UnicodeString; Quote : Boolean = False) : UnicodeString;
+
+begin
+  if Quote then
+    begin
+    AExpect:='"'+AExpect+'"';
+    AActual:='"'+AActual+'"';
+    end;
+  Result:=SExpected+': '+AExpect+' '+SActual+': '+AActual;
+end;
+
+Function ExpectMessage(AExpect,AActual : UTF8String; Quote : Boolean = False) : UTF8String;
+
+begin
+  Result:=UTF8Encode(ExpectMessage(UTF8Decode(aExpect),UTF8Decode(aActual),Quote))
+end;
+
+
+
+function AssertFalse(const AMessage: TTestString; ACondition: Boolean): Boolean;
+begin
+  Result:=AssertTrue(AMessage,Not ACondition);
+end;
+
+function AssertEquals(AMessage: TTestString; const AExpected,
+  AActual: ShortString): Boolean;
+begin
+  Result:=AssertTrue(AMessage+'. '+ExpectMessage(AExpected,AActual,True),AExpected=AActual);
+end;
+
+function AssertEquals(AMessage: TTestString; const AExpected,
+  AActual: AnsiString): Boolean;
+begin
+  Result:=AssertTrue(AMessage+'. '+ExpectMessage(AExpected,AActual,True),AExpected=AActual);
+end;
+
+function AssertEquals(AMessage: TTestString; const AExpected,
+  AActual: UTF8String): Boolean;
+begin
+  Result:=AssertTrue(AMessage+'. '+ExpectMessage(AExpected,AActual,True),AExpected=AActual);
+end;
+
+function AssertEquals(AMessage: TTestString; const AExpected,
+  AActual: UnicodeString): Boolean;
+begin
+  Result:=AssertTrue(AMessage+'. '+UTF8Encode(ExpectMessage(AExpected,AActual,True)),AExpected=AActual);
+end;
+
+Function AssertEquals(AMessage : TTestString; const AExpected: Char; AActual : UnicodeString): Boolean;
+
+begin
+  Result:=AssertEquals(AMessage,RTLString(aExpected),aActual);
+end;
+
+function AssertEquals(AMessage: TTestString; const AExpected, AActual: Boolean
+  ): Boolean;
+
+Const
+   BStrs : Array[Boolean] of TTestString = ('False','True');
+
+begin
+  Result:=AssertTrue(AMessage+'. '+ExpectMessage(BStrs[AExpected],BStrs[AActual],False),AExpected=AActual);
+end;
+
+function AssertEquals(AMessage: TTestString; const AExpected, AActual: Shortint
+  ): Boolean;
+Var
+  SE,SA : TTestString;
+
+begin
+  Str(AExpected,SE);
+  Str(AActual,SA);
+  Result:=AssertTrue(AMessage+'. '+ExpectMessage(SE,SA),AExpected=AActual);
+end;
+
+function AssertEquals(AMessage: TTestString; const AExpected, AActual: Byte
+  ): Boolean;
+Var
+  SE,SA : TTestString;
+
+begin
+  Str(AExpected,SE);
+  Str(AActual,SA);
+  Result:=AssertTrue(AMessage+'. '+ExpectMessage(SE,SA),AExpected=AActual);
+end;
+
+function AssertEquals(AMessage: TTestString; const AExpected, AActual: Smallint
+  ): Boolean;
+Var
+  SE,SA : TTestString;
+
+begin
+  Str(AExpected,SE);
+  Str(AActual,SA);
+  Result:=AssertTrue(AMessage+'. '+ExpectMessage(SE,SA),AExpected=AActual);
+end;
+
+function AssertEquals(AMessage: TTestString; const AExpected, AActual: Word
+  ): Boolean;
+Var
+  SE,SA : TTestString;
+
+begin
+  Str(AExpected,SE);
+  Str(AActual,SA);
+  Result:=AssertTrue(AMessage+'. '+ExpectMessage(SE,SA),AExpected=AActual);
+end;
+
+function AssertEquals(AMessage: TTestString; const AExpected, AActual: Longint
+  ): Boolean;
+
+Var
+  SE,SA : TTestString;
+
+begin
+  Str(AExpected,SE);
+  Str(AActual,SA);
+  Result:=AssertTrue(AMessage+'. '+ExpectMessage(SE,SA),AExpected=AActual);
+end;
+
+function AssertEquals(AMessage: TTestString; const AExpected, AActual: Cardinal
+  ): Boolean;
+Var
+  SE,SA : TTestString;
+
+begin
+  Str(AExpected,SE);
+  Str(AActual,SA);
+  Result:=AssertTrue(AMessage+'. '+ExpectMessage(SE,SA),AExpected=AActual);
+end;
+
+function AssertEquals(AMessage: TTestString; const AExpected, AActual: Int64
+  ): Boolean;
+Var
+  SE,SA : TTestString;
+
+begin
+  Str(AExpected,SE);
+  Str(AActual,SA);
+  Result:=AssertTrue(AMessage+'. '+ExpectMessage(SE,SA),AExpected=AActual);
+end;
+
+function AssertEquals(AMessage: TTestString; const AExpected, AActual: QWord
+  ): Boolean;
+Var
+  SE,SA : TTestString;
+
+begin
+  Str(AExpected,SE);
+  Str(AActual,SA);
+  Result:=AssertTrue(AMessage+'. '+ExpectMessage(SE,SA),AExpected=AActual);
+end;
+
+function AssertEquals(AMessage: TTestString; const AExpected, AActual: Currency
+  ): Boolean;
+Var
+  SE,SA : TTestString;
+
+begin
+  Str(AExpected,SE);
+  Str(AActual,SA);
+  Result:=AssertTrue(AMessage+'. '+ExpectMessage(SE,SA),AExpected=AActual);
+end;
+
+function AssertEquals(AMessage: TTestString; const AExpected, AActual: Double;
+  ADelta: Double): Boolean;
+
+Var
+  SE,SA : TTestString;
+
+begin
+  Str(AExpected,SE);
+  Str(AActual,SA);
+  If ADelta=0 then
+    ADelta:=DefaultDoubleDelta;
+  Result:=AssertTrue(AMessage+'. '+ExpectMessage(SE,SA),Abs(AExpected-AActual)<ADelta);
+end;
+
+function AssertEquals(AMessage: TTestString; const AExpected, AActual: Single;
+  ADelta: Single): Boolean;
+
+Var
+  SE,SA : TTestString;
+
+begin
+  Str(AExpected,SE);
+  Str(AActual,SA);
+  If ADelta=0 then
+    ADelta:=DefaultSingleDelta;
+  Result:=AssertTrue(AMessage+'. '+ExpectMessage(SE,SA),Abs(AExpected-AActual)<ADelta);
+end;
+
+function AssertEquals(AMessage: TTestString; const AExpected,
+  AActual: Extended; ADelta: Extended): Boolean;
+
+Var
+  SE,SA : TTestString;
+
+begin
+  Str(AExpected,SE);
+  Str(AActual,SA);
+  If ADelta=0 then
+    ADelta:=DefaultExtendedDelta;
+  Result:=AssertTrue(AMessage+'. '+ExpectMessage(SE,SA),Abs(AExpected-AActual)<ADelta);
+end;
+
+function AssertNull(AMessage: TTestString; const AValue: Pointer): Boolean;
+begin
+  Result:=AssertEquals(AMessage,Nil,AValue);
+end;
+
+function AssertNotNull(AMessage: TTestString; const AValue: Pointer): Boolean;
+begin
+  Result:=AssertDiffers(AMessage,Nil,AValue);
+end;
+
+Function PointerToStr(P : Pointer) : TTestString;
+
+begin
+  if P=Nil then
+    Result:='Nil'
+  else
+    Result:=HexStr(P);
+end;
+
+function AssertEquals(AMessage: TTestString; const AExpected, AActual: Pointer
+  ): Boolean;
+Var
+  SE,SA : TTestString;
+
+begin
+  SE:=PointerToStr(AExpected);
+  SA:=PointerToStr(AActual);
+  Result:=AssertTrue(AMessage+'. '+ExpectMessage(SE,SA),AExpected=AActual);
+end;
+
+function AssertDiffers(AMessage: TTestString; const AExpected, AActual: Pointer
+  ): Boolean;
+
+Var
+  SE,SA : TTestString;
+
+begin
+  SE:=PointerToStr(AExpected);
+  SA:=PointerToStr(AActual);
+  Result:=AssertTrue(AMessage+'. '+ExpectMessage(SE,SA),AExpected<>AActual)
+end;
+
+function AssertEquals(AMessage: TTestString; const AExpected, AActual: TClass
+  ): Boolean;
+
+  Function CN (AClass : TClass) : TTestString;
+
+  begin
+    If Assigned(AClass) then
+      Result:=AClass.ClassName
+    else
+      Result:='Nil'
+  end;
+
+Var
+  SE,SA : TTestString;
+
+begin
+  SE:=CN(AExpected);
+  SA:=CN(AActual);
+  Result:=AssertTrue(AMessage+'. '+ExpectMessage(SE,SA),AExpected=AActual);
+end;
+
+function AssertInheritsFrom(AMessage: TTestString; const AChild,
+  AParent: TObject): Boolean;
+
+Var
+  CC,CP : TClass;
+
+begin
+  if Assigned(AParent) then
+    CP:=AParent.ClassType
+  else
+    CP:=Nil;
+  if Assigned(AChild) then
+    CC:=AChild.ClassType
+  else
+    CC:=Nil;
+  Result:=AssertInheritsFrom(AMessage,CC,CP)
+end;
+
+function AssertInheritsFrom(AMessage: TTestString; const AChild, AParent: TClass
+  ): Boolean;
+begin
+  Result:=AssertNotNull(AMessage,AChild);
+  if Result then
+    begin
+    Result:=AssertNotNull(AMessage,AParent);
+    if Result then
+      Result:=AssertTrue(AMessage,AChild.InheritsFrom(AParent));
+    end;
+end;
+
+function AssertSame(AMessage: TTestString; const AExpected, AActual: TObject
+  ): Boolean;
+
+  Function CN (AClass : TObject) : TTestString;
+
+  begin
+    If Assigned(ACLass) then
+      Result:=AClass.ClassName
+    else
+      Result:='Nil'
+  end;
+
+Var
+  SE,SA : TTestString;
+
+begin
+  SE:=CN(AExpected);
+  if AExpected<>Nil then
+    SE:=SE+'('+HexStr(AExpected)+')';
+  SA:=CN(AActual);
+  if AActual<>Nil then
+    SA:=SA+'('+HexStr(AActual)+')';
+  Result:=AssertTrue(AMessage+'. '+ExpectMessage(SE,SA),AExpected=AActual);
+end;
+
+function AssertNotSame(AMessage: TTestString; const AExpected, AActual: TObject
+  ): Boolean;
+
+  Function CN (AClass : TObject) : TTestString;
+
+  begin
+    If Assigned(ACLass) then
+      Result:=AClass.ClassName
+    else
+      Result:='Nil'
+  end;
+
+Var
+  SE,SA : TTestString;
+
+begin
+  SE:=CN(AExpected);
+  if AExpected<>Nil then
+    SE:=SE+'('+HexStr(AExpected)+')';
+  SA:=CN(AActual);
+  if AActual<>Nil then
+    SA:=SA+'('+HexStr(AActual)+')';
+  Result:=AssertTrue(AMessage+'. '+ExpectMessage(SE,SA),AExpected<>AActual);
+end;
+
+function AssertException(const AMessage: string; AExceptionClass: TClass;
+  ARun: TProcedure): boolean;
+
+Var
+  EC : TClass;
+
+begin
+  EC:=Nil;
+  Try
+    ARun();
+  except
+    On E : TObject do
+      EC:=E.ClassType;
+  end;
+  Result:=AssertNotNull(AMessage,EC);
+  if Result then
+    Result:=AssertEquals(AMessage,AExceptionClass,EC);
+end;
+
+function AssertException(const AMessage: string; AExceptionClass: TClass;
+  ARun: TTestRun): boolean;
+Var
+  EC : TClass;
+  S : TTestString;
+begin
+  EC:=Nil;
+  S:='';
+  Try
+    S:=ARun();
+  except
+    On E : TObject do
+      EC:=E.ClassType;
+  end;
+  Result:=AssertNotNull(AMessage,EC) and AssertEquals(AMessage,TTestString(''),S);
+  if Result then
+    Result:=AssertEquals(AMessage,AExceptionClass,EC);
+end;
+
+function ExpectException(AMessage: TTestString; AClass: TClass): Boolean;
+begin
+  Result:=SetTestError(teOK)=teOK;
+  Result:=AssertTrue(AMessage,Result and Assigned(CurrentResult) and (CurrentResult^.TestResult in [trEmpty,trOK]));
+  If Result then
+    begin
+    CurrentResult^.ExpectException:=AClass;
+    CurrentResult^.TestMessage:=AMessage;
+    end;
+end;
+
+{ ---------------------------------------------------------------------
+  Auxiliary test run routines
+  ---------------------------------------------------------------------}
+
+// Reset run summary results
+Procedure FreeResultRecord(P : PResultRecord; Recurse : Boolean);
+
+Var
+  N : PResultRecord;
+
+begin
+  if Not Assigned(P) then
+    exit;
+  Repeat
+    Finalize(p^);
+    N:=P^.NextResult;
+    If Recurse then
+      FreeResultRecord(P^.ChildResults,Recurse);
+    FreeMem(P);
+    P:=N;
+  Until (P=Nil);
+end;
+
+Procedure ResetRun(Var ARun : TRunSummary);
+
+begin
+  FreeResultRecord(ARun.Results.ChildResults,True);
+  ARun:=Default(TRunSummary);
+  ARun.Results:=Default(TResultRecord);
+  CurrentSuiteResult:[email protected];
+  CurrentResult:[email protected];
+end;
+
+// Check if the test run must be continued ?
+Function ContinueTest(AResult : TTestError) : Boolean;
+
+begin
+  Result:=(AResult=teOK) or (CurrentErrorAction=eaIgnore);;
+end;
+
+// Set current test result
+
+Function AllocateCurrentSuiteResult(ASuite: PSuite; IsChild : Boolean): TTestError;
+
+Var
+  P : PResultRecord;
+
+begin
+  Result:=SetTestError(teOK);
+  New(P);
+  If (P=Nil) then
+    SetTestError(teNoMemory)
+  else
+    begin
+    P^:=Default(TResultRecord);
+    p^.Suite:=ASuite;
+    If IsChild then
+      begin
+      CurrentSuiteResult^.ChildResults:=P;
+      P^.ParentResult:=CurrentSuiteResult;
+      end
+    else
+      Begin
+      CurrentSuiteResult^.NextResult:=P;
+      P^.ParentResult:=CurrentSuiteResult^.ParentResult;
+      end;
+    CurrentSuiteResult:=P;
+    CurrentResult:=CurrentSuiteResult;
+    end;
+end;
+
+Function AllocateCurrentResult(ASuite: PSuite; ATest: PTest): TTestError;
+
+Var
+  N,P : PResultRecord;
+
+
+begin
+  Result:=SetTestError(teOK);
+  New(P);
+  If (P=Nil) then
+    SetTestError(teNoMemory)
+  else
+    begin
+    P^:=Default(TResultRecord);
+    P^.TestResult:=trEmpty;
+    P^.Suite:=ASuite;
+    P^.Test:=ATest;
+    P^.ExpectException:=Nil;
+    // Hook up in tree.
+    N:=CurrentSuiteResult^.ChildResults;
+    if N=Nil then
+      begin
+      CurrentSuiteResult^.ChildResults:=P;
+      P^.ParentResult:=CurrentSuiteResult;
+      end
+    else
+      begin
+      While (N^.NextResult<>Nil) do
+        N:=N^.NextResult;
+      N^.NextResult:=P;
+      P^.ParentResult:=N^.ParentResult;
+      end;
+    CurrentResult:=P;
+    end;
+end;
+
+{ ---------------------------------------------------------------------
+  Protected run of hook handlers. Catch exceptions and report them.
+  ---------------------------------------------------------------------}
+
+// Run start hook
+Function RunGLobalRunStartHandler(Suites : TSuiteArray) : TTestError;
+
+begin
+  Result:=SetTestError(teOK);
+  Try
+    GlobalRunStartHandler(Suites);
+  except
+    On E : TObject do
+      begin
+      CurrentResult:[email protected];
+      SetTestResult(trHandlerError,E.ToString,True);
+      Result:=(SetTestError(teRunStartHandler));
+      end;
+  end;
+end;
+
+// Run complete hook
+Function RunGLobalRunCompleteHandler(Run : TRunSummary) : TTestError;
+
+begin
+  Result:=SetTestError(teOK);
+  if Assigned(GlobalRunCompleteHandler) then
+    Try
+      GlobalRunCompleteHandler(Run);
+    except
+      On E : TObject do
+        begin
+        CurrentResult:[email protected];
+        SetTestResult(trHandlerError,E.ToString,False);
+        Result:=(SetTestError(teRunCompleteHandler));
+        end;
+    end;
+end;
+
+// Run suite start hook
+Function RunGlobalSuiteStartHandler(ASuite : PSuite) : TTestError;
+
+begin
+  Result:=SetTestError(teOK);
+  If Assigned(GlobalSuiteStartHandler) then
+    try
+      GlobalSuiteStartHandler(ASuite);
+    except
+      On E : EIgnore do
+       SetTestResult(trTestIgnore,E.ToString);
+      On E : EFail do
+       SetTestResult(trAssertFailed,E.ToString);
+      On E : TObject do
+       SetTestResult(trHandlerError,E.ToString);
+    end;
+end;
+
+// Run suite complete hook
+Function RunGlobalSuiteCompleteHandler(ASuite : PSuite; SuiteResult : PResultRecord) : TTestError;
+
+Var
+  C : PresultRecord;
+
+begin
+  Result:=SetTestError(teOK);
+  If Assigned(GlobalSuiteCompleteHandler) then
+    begin
+    C:=CurrentResult;
+    CurrentResult:=SuiteResult;
+    try
+      GlobalSuiteCompleteHandler(ASuite,SuiteResult);
+    except
+      On E : EIgnore do
+       SetTestResult(trTestIgnore,E.ToString);
+      On E : EFail do
+        SetTestResult(SuiteResult^,trAssertFailed,E.ToString);
+      On E : TObject do
+        SetTestResult(SuiteResult^,trHandlerError,E.ToString);
+    end;
+    CurrentResult:=C;
+    end;
+end;
+
+// Run suite setup
+Function RunSuiteSetup(ASuite : PSuite; SuiteResult : PResultRecord) : TTestError;
+
+var
+  S : TTestString;
+
+begin
+  Result:=SetTestError(teOK);
+  if Not Assigned(ASuite^.Setup) then
+     exit;
+  S:='';
+  try
+    S:=ASuite^.Setup();
+  Except
+    On E : TObject Do
+      S:=E.ToString;
+  end;
+  if (S<>'') then
+    begin
+    SetTestResult(SuiteResult^,trSuiteSetupFailed,S,True);
+    Result:=SetTestError(teSuiteSetupFailed);
+    Inc(CurrentRun.SuitesFailed);
+    If Assigned(GlobalSuiteSetupFailureHandler) then
+      GlobalSuiteSetupFailureHandler(ASuite,S);
+    end
+end;
+
+// Run suite teardown
+Function RunSuiteTearDown(ASuite : PSuite; SuiteResult : PResultRecord) : TTestError;
+
+var
+  S : TTestString;
+  C : PresultRecord;
+
+begin
+  Result:=SetTestError(teOK);
+  if Not Assigned(ASuite^.Teardown) then
+     exit;
+  C:=CurrentResult;
+  CurrentResult:=SuiteResult;
+  S:='';
+  try
+    S:=ASuite^.TearDown();
+  Except
+    On E : TObject Do
+      S:=E.ToString;
+  end;
+  if (S<>'') then
+    begin
+    SetTestResult(SuiteResult^,trSuiteTearDownFailed,S,True);
+    Result:=SetTestError(teSuiteTeardownFailed);
+    Inc(CurrentRun.SuitesFailed);
+    If Assigned(GlobalSuiteTearDownFailureHandler) then
+      GlobalSuiteTearDownFailureHandler(ASuite,S);
+    end;
+  CurrentResult:=C;
+end;
+
+// Run test handler
+
+Var
+  SavedDefaultSystemCodePage,
+  SavedDefaultUnicodeCodePage,
+  SavedDefaultFileSystemCodePage,
+  SavedDefaultRTLFileSystemCodePage,
+  SavedUTF8CompareLocale : TSystemCodePage;
+
+Procedure SaveCodePages;
+
+begin
+  SavedDefaultSystemCodePage:=DefaultSystemCodePage;
+  SavedDefaultUnicodeCodePage:=DefaultUnicodeCodePage;
+  SavedDefaultFileSystemCodePage:=DefaultFileSystemCodePage;
+  SavedDefaultRTLFileSystemCodePage:=DefaultRTLFileSystemCodePage;
+  SavedUTF8CompareLocale:=UTF8CompareLocale;
+end;
+
+Procedure RestoreCodePages;
+
+begin
+  DefaultSystemCodePage:=SavedDefaultSystemCodePage;
+  DefaultUnicodeCodePage:=SavedDefaultUnicodeCodePage;
+  DefaultFileSystemCodePage:=SavedDefaultFileSystemCodePage;
+  DefaultRTLFileSystemCodePage:=SavedDefaultRTLFileSystemCodePage;
+  UTF8CompareLocale:=SavedUTF8CompareLocale;
+end;
+
+
+Function RunTestHandler(aTest : PTest) : String;
+
+Var
+  EC : TClass;
+  EM : TTestString;
+
+begin
+  Result:='';
+  EC:=Nil;
+  EM:='';
+  SaveCodePages;
+  try
+    if assigned(aTest^.Run) then
+      Result:=aTest^.Run()
+    else if assigned(aTest^.RunProc) then
+      begin
+      Result:='';
+      aTest^.RunProc();
+      end
+    else
+      Result:=SErrNoTestProcedure;
+    RestoreCodePages;
+  except
+    On E : TObject do
+      begin
+      RestoreCodePages;
+      EC:=E.ClassType;
+      EM:=E.TOString;
+      end;
+  end;
+  // Read IOResult so it is reset.
+  if IOResult<>0 then;
+  // Treat exception.
+  if (EC<>CurrentResult^.ExpectException) then
+    begin
+    if (CurrentResult^.ExpectException=Nil) then
+      Result:=EM
+    else
+      With CurrentResult^ do
+        if (EC=Nil) then
+          Result:=TestMessage+' '+ExpectMessage(ExpectException.ClassName,'Nil')
+        else
+          Result:=TestMessage+' '+ExpectMessage(ExpectException.ClassName,EC.ClassName);
+    end;
+end;
+
+
+{ ---------------------------------------------------------------------
+  Running tests
+  ---------------------------------------------------------------------}
+
+Function RunSingleTest(T : PTest) : TTestError;
+
+Type
+  TTestStage = (tsStartHandler,tsSetup,tsRun,tsTearDown,tsCompleteHandler);
+
+Const
+  Prefixes : Array[TTestStage] of TTestString =
+     ('Test start handler','Test Setup','','Test TearDown','Test complete handler');
+  Errors : Array[TTestStage] of TTestResult =
+     (trHandlerError,trSuiteSetupFailed, trTestError,trSuiteTearDownFailed,trHandlerError);
+
+Var
+  S : TTestString;
+  Stage : TTestStage;
+  StartTime : TDateTime;
+  CurrentAsserts : Integer;
+
+begin
+  SetTestError(teOK);
+  Assert(CurrentSuite<>Nil);
+  CurrentTest:=T;
+  try
+    CurrentAsserts:=CurrentRun.AssertCount;
+    Result:=AllocateCurrentResult(CurrentSuite,T);
+    if (Result<>teOK) then
+      Exit;
+    Stage:=tsStartHandler;
+    // We don't use a protected method. We use 1 try/except block that keeps track of the 'stage'.
+    If Assigned(GlobalTestStartHandler) then
+      GlobalTestStartHandler(T,CurrentSuite);
+    if (soSetupTearDownPerTest in CurrentSuite^.Options) then
+      begin
+      Stage:=tsSetup;
+      Result:=RunSuiteSetup(CurrentSuite,CurrentResult);
+      end;
+    if (Result=teOK) then
+      If Not (toInactive in T^.Options) then
+        begin
+        StartTime:=GetTimeFromHook;
+        try
+          Stage:=tsRun;
+          S:=RunTestHandler(T); // Protect and handle exception.
+          if (S<>'') then
+            Fail(S)
+          else if (CurrentResult^.TestResult=trEmpty) then
+            if (CurrentAsserts=CurrentRun.AssertCount) and RequirePassed then
+              Inc(CurrentRun.TestsUnimplemented)
+            else
+              SetTestResult(trOK,'');
+        Finally
+          CurrentResult^.ElapsedTime:=GetTimeDiff(StartTime);
+          Inc(CurrentRun.TestsRun);
+        end;
+        if (soSetupTearDownPerTest in CurrentSuite^.Options) then
+          begin
+          Stage:=tsTearDown;
+          Result:=RunSuiteTearDown(CurrentSuite,CurrentResult);
+          end;
+        Stage:=tsCompleteHandler;
+        end
+      else
+        begin
+        Inc(CurrentRun.TestsInactive);
+        SetTestResult(trTestInactive,'',True);
+        Result:=SetTestError(teTestInactive);
+        end;
+    if Assigned(GlobalTestCompleteHandler) then
+      GlobalTestCompleteHandler(T,CurrentSuite,CurrentResult);
+  except
+    On E : TObject do
+      begin
+      S:=Prefixes[Stage];
+      if (S<>'') then S:='['+S+'] ';
+      S:=S+E.Tostring;
+      SetTestResult(CurrentResult^,Errors[Stage],S,True);
+      end;
+  end;
+  CurrentTest:=Nil;
+end;
+
+
+// Internal, run a single suite, collect results in RunSummary.
+Function RunSingleSuite(ASuite : PSuite; isChild : Boolean) : TTestError;
+
+Type
+  TSuiteStage = (ssStartHandler,ssSetup,ssRun,ssTearDown,ssEndHandler);
+
+Const
+  Prefixes : Array [TSuiteStage] of TTestString =
+       ('Start handler','Setup','','Teardown','End Handler');
+  StageErrors :  Array [TSuiteStage] of TTestResult =
+       (trHandlerError,trSuiteSetupFailed,trTestError,trSuiteTearDownFailed,trHandlerError);
+
+Var
+  S : TTestString;
+  T : PTest;
+  Stage : TSuiteStage;
+  I : Integer;
+  StartTime : TDateTime;
+  R2 : TTestError;
+  OldCurrentSuite : PSuite;
+  SuiteResult : PResultRecord;
+
+begin
+  if AllocateCurrentSuiteResult(ASuite,IsChild)<>teOK then
+    exit;
+  SetTestError(teOK);
+  OldCurrentSuite:=CurrentSuite;
+  SuiteResult:=CurrentSuiteResult;
+  CurrentSuite:=ASuite;
+  try
+    Result:=teOK;
+    Stage:=ssStartHandler;
+    RunGlobalSuiteStartHandler(ASuite);
+    // First, run all sub suites.
+    If (soInactive in ASuite^.Options) then
+      Inc(CurrentRun.SuitesInactive)
+    else
+      begin
+      StartTime:=GetTimeFromHook;
+      S:='';
+      try
+        if not (soSetupTearDownPerTest in ASuite^.Options) then
+          begin
+          Stage:=ssSetup;
+          Result:=RunSuiteSetup(ASuite,SuiteResult);
+          end;
+        Stage:=ssRun;
+        For I:=0 to Asuite^.Suites.Count-1 do
+          If (Result=teOK) or (CurrentErrorAction=eaIgnore) then
+            Result:=RunSingleSuite(ASuite^.Suites.Items[i],I=0);
+        // Reset current result
+        CurrentSuiteResult:=SuiteResult;
+        CurrentResult:=SuiteResult;
+        For I:=0 to Asuite^.Tests.Count-1 do
+          If (Result=teOK) or (CurrentErrorAction=eaIgnore) then
+            begin
+            T:=Asuite^.Tests.Items[i];
+            if Not (toInactive in T^.Options) then
+              Result:=RunSingleTest(T)
+            else
+              Inc(CurrentRun.TestsInactive)
+            end;
+        Stage:=ssTeardown;
+        Result:=RunSuiteTearDown(ASuite,SuiteResult);
+      Finally
+         Inc(CurrentRun.SuitesRun);
+         SuiteResult^.ElapsedTime:=GetTimeDiff(StartTime);
+      end;
+      Stage:=ssEndHandler;
+      R2:=RunGLobalSuiteCompleteHandler(ASuite,SuiteResult);
+      if (Result=teOK) and (R2<>teOK) then
+        Result:=R2;
+      SetTestResult(SuiteResult^,trOK,'',False);
+      end;
+  except
+    On E : TObject do
+      begin
+      S:=Prefixes[Stage];
+      if (S<>'') then S:='['+S+'] ';
+      S:=S+E.Tostring;
+      SetTestResult(SuiteResult^,StageErrors[Stage],S,True);
+      end;
+  end;
+  CurrentSuite:=OldCurrentSuite;
+end;
+
+
+// Internal. At this point, ASuite and ATest are valid.
+Function DoRunTest(ASuite: PSuite; ATest: PTest): TTestError;
+
+Var
+  A : TSuiteArray;
+  StartTime : TDateTime;
+  SuiteResult : PResultRecord;
+begin
+  A:=[];
+  ResetRun(CurrentRun);
+  if AllocateCurrentSuiteResult(ASuite,True)<>teOK then
+    exit;
+  Result:=SetTestError(teOK);
+  SuiteResult:=CurrentResult;
+  If Assigned(GlobalRunStartHandler) then
+    begin
+    SetLength(A,1);
+    A[0]:=ASuite;
+    Result:=RunGlobalRunStartHandler(A);
+    SetLength(A,0);
+    If not ContinueTest(Result) then
+      exit;
+    end;
+  if (soInactive in ASuite^.Options) then
+    begin
+    SetTestResult(trSuiteInactive,'',True);
+    Inc(CurrentRun.SuitesInactive);
+    Inc(CurrentRun.SuitesFailed);
+    RunGlobalRunCompleteHandler(CurrentRun); // Ignore status
+    Exit(SetTestError(teSuiteInactive));
+    end;
+  StartTime:=GetTimeFromHook;
+  if Not ContinueTest(Result)then
+    begin
+    Result:=CombineError(Result,RunGlobalRunCompleteHandler(CurrentRun));
+    exit;
+    end;
+  CurrentSuite:=ASuite;
+  try
+    Result:=RunGlobalSuiteStartHandler(ASuite);
+    if ContinueTest(Result) then
+      begin
+      Result:=RunSuiteSetup(ASuite,SuiteResult);
+      if ContinueTest(Result) then
+        begin
+        Result:=CombineError(Result,RunSingleTest(ATest));
+        Result:=CombineError(Result,RunSuiteTearDown(ASuite,SuiteResult));
+        end;
+      end;
+  finally
+     SetTestResult(SuiteResult^,trOK,'');
+     Inc(CurrentRun.SuitesRun);
+     CurrentSuite:=Nil;
+  end;
+  Result:=CombineError(Result,RunGlobalSuiteCompleteHandler(ASuite,SuiteResult));
+  CurrentRun.ElapsedTime:=GetTimeDiff(StartTime);
+  Result:=CombineError(Result,RunGlobalRunCompleteHandler(CurrentRun));
+end;
+
+
+// Internal. At this point, ASuite is valid.
+Function DoRunSuite(ASuite: PSuite): TTestError;
+
+Var
+  A : TSuiteArray;
+  StartTime : TDateTime;
+begin
+  A:=[];
+  SetTestError(teOK);
+  ResetRun(CurrentRun);
+  If Assigned(GlobalRunStartHandler) then
+    begin
+    SetLength(A,1);
+    A[0]:=ASuite;
+    Result:=RunGlobalRunStartHandler(A);
+    SetLength(A,0);
+    if not ContinueTest(Result) then
+      Exit;
+    end;
+  SetTestError(teOK);
+  StartTime:=GetTimeFromHook;
+  Result:=teOK;
+  Result:=RunSingleSuite(ASuite,True);
+  CurrentRun.ElapsedTime:=GetTimeDiff(StartTime);
+  Result:=CombineError(Result,RunGlobalRunCompleteHandler(CurrentRun));
+end;
+
+function RunSuite(ASuite: PSuite): TTestError;
+
+begin
+  SetTestError(teOK);
+  if (ASuite=Nil) then
+    Result:=SetTestError(teNoSuite)
+  else
+    Result:=DoRunSuite(ASuite);
+end;
+
+function RunSuite(const ASuiteName: TTestString): TTestError;
+begin
+  Result:=RunSuite(GetSuite(ASuiteName));
+end;
+
+function RunSuite(ASuiteIndex: Integer): TTestError;
+begin
+  Result:=RunSuite(GetSuite(ASuiteIndex))
+end;
+
+Function RunTest(ASuiteIndex: Integer; Const ATestName: TTestString): TTestError;
+
+Var
+  S : PSuite;
+
+begin
+  S:=GetSuite(ASuiteIndex);
+  Result:=RunTest(S,GetTest(S,ATestName));
+end;
+
+Function RunTest(ASuite: PSuite; ATestIndex: Integer): TTestError;
+begin
+  Result:=RunTest(ASuite,GetTest(ASuite,ATestIndex));
+end;
+
+function RunTest(ASuite: PSuite; const ATestName: TTestString): TTestError;
+begin
+  Result:=RunTest(ASuite,GetTest(ASuite,ATestName));
+end;
+
+function RunTest(const ASuiteName: TTestString; const ATestName: TTestString
+  ): TTestError;
+
+Var
+  S : PSuite;
+begin
+  S:=GetSuite(ASuiteName);
+  Result:=RunTest(S,GetTest(S,ATestName));
+end;
+
+
+function RunTest(ASuite: PSuite; ATest: PTest): TTestError;
+begin
+  Result:=SetTestError(teOK);
+  ProcessSysCommandline;
+  if (ASuite=Nil) then
+    Result:=SetTestError(teNoSuite)
+  else if (ATest=Nil) then
+    Result:=SetTestError(teNoTest)
+  else if not TestIsInSuite(ASuite,ATest) then
+    Result:=SetTestError(teTestNotInSuite)
+  else
+    Result:=DoRunTest(ASuite,ATest);
+end;
+
+Procedure SysHalt;
+
+begin
+  if CurrentRun.TestsFailed<>0 then
+    Halt(1)
+  else
+    Halt(0);
+end;
+
+Procedure DoRunSysTests(S : PSuite; T : PTest); forward;
+
+procedure RunTest(ARun: TTestRun);
+
+begin
+  ProcessSysCommandLine;
+  if ARun=Nil then
+    Halt(2);
+  if (AddTest('Global',ARun)=Nil) then
+    Halt(3);
+  DoRunSysTests(Nil,Nil);
+end;
+
+function GetCurrentRun: TRunSummary;
+begin
+  Result:=CurrentRun;
+end;
+
+function GetCurrentSuite: PSuite;
+begin
+  Result:=CurrentSuite;
+end;
+
+function GetCurrentTest: PTest;
+begin
+  Result:=CurrentTest;
+end;
+
+function GetCurrentResult: PResultRecord;
+begin
+  Result:=CurrentResult;
+end;
+
+
+function RunAllTests: TTestError;
+
+Var
+  I : Integer;
+  A : TSuiteArray;
+  StartTime : TDateTime;
+begin
+  A:=[];
+  Result:=SetTestError(teOK);
+  ResetRun(CurrentRun);
+  StartTime:=GetTimeFromHook;
+  If Assigned(GlobalRunStartHandler) then
+    begin
+    // Array of actual size.
+    SetLength(A,TestRegistry.Count);
+    For I:=0 to TestRegistry.Count-1 do
+      A[I]:=TestRegistry.Items[i];
+    GlobalRunStartHandler(A);
+    SetLength(A,0);
+    end;
+  If (TestRegistry.Count=0) then
+    Result:=SetTestError(teRegistryEmpty)
+  else
+    begin
+    I:=0;
+    While (I<TestRegistry.Count) and ContinueTest(Result) do
+      begin
+      Result:=CombineError(Result,RunSingleSuite(TestRegistry.Items[I],I=0));
+      Inc(I);
+      end;
+    end;
+  CurrentRun.ElapsedTime:=GetTimeDiff(StartTime);
+  Result:=CombineError(Result,RunGlobalRunCompleteHandler(CurrentRun));
+end;
+
+{ ---------------------------------------------------------------------
+  Systemm hooks
+  ---------------------------------------------------------------------}
+
+Const
+
+  // Run
+  STestRun = 'Test run';
+  SRunSummary   = 'Run summary';
+
+  // Suites
+  SSuites = 'Suites';
+  SSuite = 'Suite';
+  SSummary = 'summary';
+  SSuitesSummary  = 'Suites summary';
+
+  // Tests
+  STests = 'Tests';
+  STest  = 'Test';
+  STestsSummary   = 'Tests summary';
+
+  // Counts
+  SInactiveCount = 'Inactive';
+  SIgnoredCount  = 'Ignored';
+  SRunCount      = 'Run';
+  SFailedCount   = 'Failed';
+  SUnimplementedCount = 'Unimplemented';
+
+  // test Status/Result
+  SPassed = 'Passed';
+  SIgnored = 'Ignored';
+  SFailed = 'Failed';
+  SError = 'Error';
+  SInactive = 'Inactive';
+  SNotImplemented = 'Not implemented';
+  SUnknown = 'Unknown';
+  SErrorMessage = 'Error message';
+  SSuiteSetupFailed = 'Suite setup failed';
+  SSuiteTearDownFailed = 'Suite setup failed';
+  // Elapsed time
+  STime = 'Time';
+
+  SUsage = 'Usage:';
+  SHelpL = '-l --list         list all tests (observes -s)';
+  SHelpF = '-f --failures     only show names and errors of failed tests';
+  SHelpH = '-h --help         this help message';
+  SHelpN = '-n --normal       normal log level';
+  SHelpO = '-o --output=file  log output file name (default is standard output)';
+  SHelpQ = '-q --quiet        Do not display messages ';
+  SHelpS = '-s --suite=name   Only run/list tests in given suite';
+  SHelpT = '-t --test=name    Only run/list tests matching given test (requires -s)';
+  SHelpV = '-v --verbose      Verbose output logging';
+  SHelpHasTime = 'This binary has support for displaying time';
+  SHelpNoTime = 'This binary has no support for displaying time';
+  SHelpExitCodes = 'Possible exit codes:';
+  SHelpExit0 = '0 - All actions (tests) completed successfully';
+  SHelpExit1 = '1 - All tests were run, but some tests failed.';
+  SHelpExit2 = '2 - An empty test function was given to runtest';
+  SHelpExit3 = '3 - The requested suite was not found';
+  SHelpExit4 = '4 - The requested test was not found';
+  SHelpExit5 = '5 - An unexpected error occurred in the testsuite';
+
+Type
+  TRunMode = (rmHelp,rmList,rmTest);
+
+Var
+  FSys : ^Text;
+  LogFile : Text;
+  CurrentRunMode : TSysRunVerbosity;
+  SysSuite : PSuite;
+  SysOutputFileName : TTestString;
+  SysTestName : TTestString;
+  SysSuiteName : TTestString;
+  SysRunMode : TRunMode;
+  SysSuiteIndent : String;
+
+Procedure SysSuiteStartHandler (ASuite : PSuite);
+
+begin
+  if (ASuite<>SysSuite) then
+    begin
+    SysSuiteIndent:=SysSuiteIndent+'  ';
+    Write(FSys^,SysSuiteIndent,SSuite,' ',ASuite^.Name,':');
+    if CurrentRunMode=rvVerbose then
+      Writeln(FSys^,' (',ASuite^.Tests.Count,' ',STests+')')
+    else
+      Writeln(FSys^);
+    SysSuite:=ASuite;
+    end;
+end;
+
+Procedure SysTestStartHandler (ATest : PTest; ASuite : PSuite);
+
+begin
+  if CurrentRunMode in [rvQuiet,rvFailures] then
+    Exit;
+  Write(FSys^,SysSuiteIndent+'  ',STest,' ',ATest^.Name,': ');
+end;
+
+function SysTimeString(MSec: Integer): TTestString;
+
+Var
+  S : TTestString;
+
+begin
+  S:='';
+  Str(Msec mod 1000,Result);
+  MSec:=Msec div 1000;
+  If (Msec=0) then
+    Result:='0.'+Result
+  else
+    begin
+    Str(Msec mod 60,S);
+    Result:=S+'.'+Result;
+    Msec:=Msec div 60;
+    If (Msec<>0) then
+      begin
+      Str(Msec mod 60,S);
+      Result:=S+':'+Result;
+      Msec:=Msec div 60;
+      If (Msec<>0) then
+        begin
+        Str(Msec,S);
+        Result:=S+':'+Result;
+        end;
+      end;
+    end;
+  Result:=STime+': '+Result;
+end;
+
+Procedure SysTestCompleteHandler (ATest: PTest; ASuite : PSuite; Const AResultRecord : PResultRecord);
+
+Var
+  S : TTestString;
+  F,O : Boolean;
+  TR : TTestResult;
+
+begin
+  if (CurrentRunMode=rvQuiet) then exit;
+  F:=CurrentRunMode=rvFailures;
+  O:=False;
+  S:=AResultRecord^.TestMessage;
+  TR:=AResultRecord^.TestResult;
+  Case TR of
+    trEmpty :
+      if not F then
+        Write(FSys^,SNotImplemented);
+    trOK :
+      if not F then
+        Write(FSys^,SPassed);
+    trTestIgnore:
+      if not F then
+       Write(FSys^,SIgnored,' (',S,')');
+    trSuiteSetupFailed,
+    trSuiteTearDownFailed,
+    trAssertFailed,
+    trTestError,
+    trHandlerError:
+      begin
+      if F then
+        Write(FSys^,STest,' ',ASuite^.Name,'.',ATest^.Name,': ');
+      if TR in [trTestError,trHandlerError] then
+        Write(FSys^,SError)
+      else
+        Write(FSys^,SFailed);
+      Write(FSys^,' (',SErrorMessage,': ',S,')');
+      O:=True;
+      end;
+    trTestInactive:
+      if not F then
+        Write(FSys^,SInactive);
+  else
+    if not F then
+      Write(FSys^,SUnknown,' : ',AResultRecord^.TestMessage);
+  end;
+  if (not F) and HaveTimeHook then
+    Writeln(FSys^,' ',SysTimeString(AResultRecord^.ElapsedTime))
+  else if (O or Not F) then
+    Writeln(FSys^);
+end;
+
+Procedure GetResultStats(AResults : PResultRecord; Var Stats : TSuiteStats);
+
+begin
+  If AResults^.Test<>Nil then
+    begin
+    Inc(Stats.TestsRun);
+    Case AResults^.TestResult of
+      trEmpty : Inc(Stats.TestsUnimplemented);
+      trAssertFailed : Inc(Stats.TestsFailed);
+      trTestInactive : Inc(Stats.TestsInactive);
+      trTestIgnore : Inc(Stats.TestsIgnored);
+      trTestError : Inc(Stats.TestsError);
+    else
+      // Do nothing, silence compiler warning
+    end;
+    end;
+end;
+
+Procedure DoGetSuiteStats(AResults : PResultRecord; Var Stats : TSuiteStats);
+
+Var
+  R : PResultRecord;
+
+begin
+  if AResults^.Test<>Nil then
+     Exit;
+  Inc(Stats.Suites);
+  R:=AResults^.ChildResults;
+  While R<>Nil do
+    begin
+    if R^.Test=Nil then
+      DoGetSuiteStats(R,Stats)
+    else
+      GetResultStats(R,Stats);
+    R:=R^.NextResult;
+    end;
+end;
+
+Procedure GetSuiteStats(AResults : PResultRecord; Out Stats : TSuiteStats);
+
+begin
+  Stats:=Default(TSuiteStats);
+  DoGetSuiteStats(AResults,Stats);
+end;
+
+Procedure SysSuiteCompleteHandler (ASuite : PSuite; Const AResults : PResultRecord);
+
+Var
+  Stats : TSuiteStats;
+
+begin
+  if CurrentRunMode=rvFailures then
+    Delete(SysSuiteIndent,1,2);
+  if CurrentRunMode in [rvQuiet,rvFailures] then
+    exit;
+  Write(FSys^,SysSuiteIndent,SSuite,' ',ASuite^.Name,' ',SSummary,': ');
+  GetSuiteStats(AResults,Stats);
+  With Stats do
+    begin
+    Write(FSys^,SRunCount,': ',TestsRun,' ',SFailedCount,': ',TestsFailed,' ',SInactiveCount,': ',TestsInactive,' ',SIgnoredCount,': ',TestsIgnored);
+    if RequirePassed then
+      Write(FSys^,' ',SUnimplementedCount,': ',TestsUnimplemented);
+    end;
+  if HaveTimeHook then
+    Writeln(FSys^,' ',SysTimeString(AResults^.ElapsedTime))
+  else
+    Writeln(FSys^);
+  Flush(FSys^);
+  Delete(SysSuiteIndent,1,2);
+end;
+
+
+Procedure SysRunStartHandler (Const Suites: TSuiteArray);
+
+Var
+  I,TC : Integer;
+
+begin
+  if (CurrentRunmode in [rvQuiet,rvFailures]) then
+    exit;
+  TC:=0;
+  For I:=0 to Length(Suites)-1 do
+    Inc(TC,Suites[i]^.Tests.Count);
+  Write(FSys^,STestRun,':');
+  If (CurrentRunMode<>rvVerbose) then
+    Writeln(FSys^)
+  else
+    Writeln(FSys^,' ',Length(Suites),' ',SSuites,', ',TC,' ',STests);
+end;
+
+Procedure SysRunCompleteHandler (Const AResult : TRunSummary);
+
+
+begin
+  if (CurrentRunMode=rvQuiet) then exit;
+  if (CurrentRunMode=rvFailures) then
+    begin
+    Writeln(FSys^,SFailedCount,': ',AResult.TestsFailed);
+    exit;
+    end;
+  Writeln(FSys^);
+  Write(FSys^,SRunSummary,':');
+  if HaveTimeHook then
+    Writeln(FSys^,' ',SysTimeString(AResult.ElapsedTime))
+  else
+    Writeln(FSys^);
+  Write(FSys^,'  ',SSuitesSummary,':');
+  With AResult do
+    if CurrentRunMode=rvVerbose then
+      begin
+      Writeln(FSys^);
+      Writeln(FSys^,'    ',SRunCount,': ',SuitesRun);
+      Writeln(FSys^,'    ',SFailedCount,': ',SuitesFailed);
+      Writeln(FSys^,'    ',SInactiveCount,': ',SuitesInactive);
+      end
+    else
+      Writeln(FSys^,' ',SRunCount,': ',SuitesRun,' ',SFailedCount,': ',SuitesFailed,' ',SInactiveCount,': ',SuitesInactive);
+  Write(FSys^,'  ',STestsSummary,':');
+  With AResult do
+    if CurrentRunMode=rvVerbose then
+      begin
+      Writeln(FSys^);
+      Writeln(FSys^,'    ',SRunCount,': ',TestsRun);
+      Writeln(FSys^,'    ',SInactiveCount,': ',TestsInactive);
+      Writeln(FSys^,'    ',SFailedCount,': ',TestsFailed);
+      Writeln(FSys^,'    ',SIgnoredCount,': ',TestsIgnored);
+      if RequirePassed then
+        Writeln(FSys^,'    ',SUnimplementedCount,': ',TestsUnimplemented);
+      end
+    else
+      begin
+      Write(FSys^,' ',SRunCount,': ',TestsRun,' ',SFailedCount,': ',TestsFailed,' ',SInactiveCount,': ',TestsInactive,' ',SIgnoredCount,': ',TestsIgnored);
+      if RequirePassed then
+        Writeln(FSys^,' ',SUnimplementedCount,': ',TestsUnimplemented)
+      else
+        Writeln(FSys^);
+      end;
+  Flush(FSys^);
+end;
+
+Procedure SysSuiteSetupFailedHandler (ASuite : PSuite; Const AError : TTestString);
+
+begin
+  If (CurrentRunMode=rvVerbose) then
+    Writeln(FSys^,SSuiteSetupFailed,' : ',ASuite^.Name,' : ',AError)
+end;
+
+Procedure SysSuiteTearDownFailedHandler (ASuite : PSuite; Const AError : TTestString);
+
+begin
+  If (CurrentRunMode=rvVerbose) then
+    Writeln(FSys^,SSuiteTeardownFailed,' : ',ASuite^.Name,' : ',AError)
+end;
+
+procedure SetupSysIO;
+
+begin
+  FSys:=@Output;
+  CurrentRunmode:=rvNormal;
+end;
+
+procedure SetupSysHandlers;
+
+begin
+  // Run
+  SetRunStartHandler(@SysRunStartHandler);
+  SetRunCompleteHandler(@SysRunCompleteHandler);
+  // Suite
+  SetSuiteCompleteHandler(@SysSuiteCompleteHandler);
+  SetSuiteStartHandler(@SysSuiteStartHandler);
+  SetSuiteSetupFailureHandler(@SysSuiteSetupFailedHandler);
+  SetSuiteTearDownFailureHandler(@SysSuiteTearDownFailedHandler);
+  // Test
+  SetTestStartHandler(@SysTestStartHandler);
+  SetTestCompleteHandler(@SysTestCompleteHandler);
+end;
+
+procedure TearDownSysHandlers;
+
+begin
+{$I-}
+  Close(LogFile);
+{$I+}
+  ClearTestHooks;
+end;
+
+function GetSysRunVerbosity: TSysRunVerbosity;
+begin
+  Result:=CurrentRunMode;
+end;
+
+function SetSysRunVerbosity(AMode: TSysRunVerbosity): TSysRunVerbosity;
+begin
+  Result:=CurrentRunMode;
+  CurrentRunMode:=AMode;
+end;
+
+
+Function FullSuiteName(ASuite : PSuite) : AnsiString;
+
+begin
+  Result:='';
+  While (ASuite<>Nil) do
+    begin
+    If (Result<>'') then
+      Result:='.'+Result;
+    Result:=ASuite^.Name+Result;
+    ASuite:=ASuite^.ParentSuite;
+    end;
+end;
+
+Procedure SysListTests(ASuiteList : PSuiteList; ASuite : Psuite; ATest : PTest);
+
+Var
+  I,J : Integer;
+  S : PSuite;
+  T : PTest;
+
+begin
+  if ASuiteList=Nil then
+    exit;
+  For i:=0 to ASuiteList^.Count-1 do
+    begin
+    S:=ASuiteList^.Items[I];
+    If (ASuite=Nil) or (ASuite=S) then
+      Begin
+      if (CurrentRunMode=rvVerbose) then
+        Writeln(FSys^,SSuite,': ',FullSuiteName(S));
+      // First, list all sub suites.
+      SysListTests(@S^.Suites,ASuite,ATest);
+      For J:=0 to S^.Tests.Count-1 do
+        begin
+        T:=S^.Tests.Items[J];
+        If (ATest=Nil) or (ATest=T) then
+          begin
+          if (CurrentRunMode=rvVerbose) then
+            Write(FSys^,'  ',STest,': ');
+          Writeln(FSys^,FullSuiteName(S),'.',T^.Name);
+          end;
+        end;
+      end;
+    end;
+end;
+
+procedure ProcessSysCommandline;
+
+Var
+  i: Integer;
+  S: TTestString;
+
+  Function TestO(Const Short,Long: TTestString) : Boolean;
+
+  Var
+    L : Integer;
+    LO  : String;
+
+  begin
+    Result:=(S='-'+Short);
+    if Result then
+      begin
+      Inc(I);
+      S:=Paramstr(i);
+      end
+    else
+      begin
+      Lo:='--'+Long+'=';
+      L:=Length(Lo);
+      Result:=(Copy(S,1,L)=LO);
+      if Result then
+        Delete(S,1,L);
+      end;
+  end;
+
+begin
+  SysRunMode:=rmTest;
+  I:=1;
+  While I<=ParamCount do
+    begin
+    S:=ParamStr(i);
+    if (S='-v') or (S='--verbose') then
+      SetSysRunVerbosity(rvverbose)
+    else if (S='-q') or (S='--quiet') then
+      SetSysRunVerbosity(rvQuiet)
+    else if (S='-n') or (S='--normal') then
+      SetSysRunVerbosity(rvNormal)
+    else if (S='-f') or (S='--failures') then
+      SetSysRunVerbosity(rvFailures)
+    else if (S='-l') or (S='--list') then
+      SysRunMode:=rmList
+    else if (S='-h') or (S='--help') then
+      SysRunMode:=rmHelp
+    else if TestO('o','output') then
+      begin
+      If (S='') then
+        begin
+        S:=ParamStr(0)
+        end;
+      SysOutputFileName:=S;
+      end
+    else if TestO('s','suite') then
+      SysSuiteName:=S
+    else if TestO('t','test') then
+      SysTestName:=S;
+    Inc(i);
+    end;
+  if (SysOutputFileName<>'') then
+    begin
+    {$i-}
+    Close(LogFile);
+    Assign(LogFile,SysOutputFileName);
+    Rewrite(LogFile);
+    if (IOResult<>0) then
+      FSys:=@LogFile
+    else
+      CurrentRunMode:=rvQuiet
+    {$i+}
+    end
+  else
+
+end;
+
+
+
+Procedure SysShowHelp;
+
+begin
+  Writeln(SUsage);
+  Writeln(SHelpF);
+  Writeln(SHelpH);
+  Writeln(SHelpL);
+  Writeln(SHelpN);
+  Writeln(SHelpO);
+  Writeln(SHelpQ);
+  Writeln(SHelpS);
+  Writeln(SHelpT);
+  Writeln(SHelpV);
+  If HaveTimeHook then
+    Writeln(SHelpHasTime)
+  else
+    Writeln(SHelpNoTime);
+  Writeln(SHelpExitCodes);
+  Writeln(SHelpExit0);
+  Writeln(SHelpExit1);
+  Writeln(SHelpExit2);
+  Writeln(SHelpExit3);
+  Writeln(SHelpExit4);
+  Writeln(SHelpExit5);
+end;
+
+procedure DoRunSysTests(S: PSuite; T: PTest);
+
+Var
+  r : TTestError;
+
+begin
+  Case SysRunMode of
+    rmHelp:
+      begin
+      SysShowHelp;
+      Halt(0);
+      end;
+    rmList:
+      begin
+      SysListTests(@TestRegistry,S,T);
+      Halt(0);
+      end;
+    rmTest:
+      begin
+      if Assigned(T) then
+        R:=RunTest(S,T)
+      else if Assigned(S) then
+        R:=RunSuite(S)
+      else
+        R:=RunAllTests;
+      If (R<>teOK) then
+        Halt(5)
+      else
+        SysHalt;
+      end;
+  end;
+end;
+
+procedure RunAllSysTests;
+
+Var
+  S : PSuite;
+  T : PTest;
+  P : Integer;
+
+begin
+  S:=Nil;
+  T:=Nil;
+  ProcessSysCommandline;
+  P:=Pos('.',SysTestName);
+  if (P>0) then
+    begin
+    SysSuiteName:=Copy(SysTestName,1,P-1);
+    Delete(SysTestName,1,P);
+    P:=Pos('.',SysTestName);
+    While P<>0 do
+      begin
+      SysSuiteName:=SysSuiteName+'.'+Copy(SysTestName,1,P-1);
+      Delete(SysTestName,1,P);
+      P:=Pos('.',SysTestName);
+      end;
+    end;
+  if (SysSuiteName<>'') then
+    begin
+    S:=GetSuite(SysSuiteName);
+    if (S=Nil) then
+      Halt(3);
+    end;
+  if (SysTestName<>'') then
+    begin
+    if (S=Nil) then
+      begin
+      S:=GetSuite(DefaultSuiteName);
+      if (S=Nil) then
+        Halt(3);
+      end;
+    T:=GetTest(S,SysTestName);
+    if (T=Nil) then
+      Halt(4);
+    end;
+  DoRunSysTests(S,T);
+end;
+
+{ EFail }
+
+Constructor EFail.Create(Const AMessage: TTestString);
+begin
+  FMessage:=AMessage;
+end;
+
+Function EFail.ToString: RTLString;
+begin
+  Result:=FMessage;
+end;
+
+function GetSysTestOS: TTestString;
+
+begin
+  GetSysTestOS := lowercase({$I %FPCTARGETOS%});
+end;
+
+function SysGetSetting(const AName: TTestString): TTestString;
+
+  Procedure Trim(Var S : TTestString);
+
+  begin
+    While (S<>'') and (S[1] in [' ',#9]) do Delete(S,1,1);
+    While (S<>'') and (S[Length(S)] in [' ',#9]) do S:=Copy(S,1,Length(S)-1);
+  end;
+
+Var
+  F : Text;
+  I: Integer;
+  FN,N,V : TTestString;
+
+begin
+  Result:='';
+  FN:=paramstr(0);
+  I:=Length(Fn);
+  While (I>0) and (FN[I]<>DirectorySeparator) do
+    Dec(I);
+  FN:=Copy(FN,1,I);
+  Assign(f,FN+'punit.cfg');
+  {$i-}
+  Reset(f);
+  if IOResult<>0 then
+    exit;
+  {$i+}
+  While (Result='') and not EOF(F) do
+    begin
+    ReadLn(F,V);
+    N:='';
+    I:=Pos('=',V);
+    if I>0 then
+      begin
+      N:=Copy(V,1,I-1);
+      Delete(V,1,I);
+      end;
+    if (N<>'') and (Pos(';',N)<>1) and (Pos('#',N)<>1) then
+      begin
+      Trim(N);
+      If upcase(N)=upcase(AName) then
+        begin
+        Result:=V;
+        Trim(Result);
+        end;
+      end;
+    end;
+  Close(F);
+end;
+
+initialization
+  SetupSysIO;
+  SetupTestRegistry;
+  SetupSysHandlers;
+
+finalization
+
+  TearDownSysHandlers;
+  TearDownTestRegistry;
+  ResetRun(CurrentRun);
+end.
+

+ 0 - 393
packages/fcl-base/tests/tcbufferedfilestream.pp

@@ -1,393 +0,0 @@
-unit tcbufferedfilestream;
-
-{$mode objfpc}{$H+}
-
-interface
-
-uses
-  Classes, SysUtils, fpcunit, testregistry, bufstream;
-
-type
-
-  { TTestBufferedFileStream }
-
-  TTestBufferedFileStream= class(TTestCase)
-  private
-  const
-    TEST_RANDOM_READS=10000;
-    TEST_SEQUENTIAL_READS=1000000;
-    TEST_FILENAME='testfile.bin';
-    TEST_WRITEC_FILE='testwritecache.bin';
-    TEST_WRITEF_FILE='testwritedirec.bin';
-  private
-    function CompareStreams(const aStream1: TStream; const aStream2: TStream): Boolean;
-  protected
-    procedure SetUp; override;
-    procedure TearDown; override;
-  published
-    procedure TestCacheRead;
-    procedure TestCacheWrite;
-    procedure TestCacheSeek;
-  end;
-
-implementation
-
-procedure TTestBufferedFileStream.TestCacheRead;
-var
-  lBufferedStream: TBufferedFileStream;
-  lStream: TFileStream;
-  b: array [0..10000-1] of AnsiChar;
-  j,k: integer;
-  lBytesToRead: integer;
-  lEffectiveRead: integer;
-  {$IFDEF CHECK_AGAINST_FILE}
-  lEffectiveRead2: integer;
-  {$ENDIF}
-  lReadPosition: int64;
-  lCheckInitV: integer;
-  lTick: QWord;
-begin
-  b[0]:=#0; // Avoid initalization hint
-  lBufferedStream:=TBufferedFileStream.Create(TEST_FILENAME,fmOpenRead or fmShareDenyWrite);
-  lStream:=TFileStream.Create(TEST_FILENAME,fmOpenRead or fmShareDenyWrite);
-  try
-    RandSeed:=1;
-    Randomize;
-    lTick:=GetTickCount64;
-    for j := 0 to Pred(TEST_RANDOM_READS) do begin
-      lBytesToRead:=Random(10000);
-      lReadPosition:=Random(lBufferedStream.Size);
-      lBufferedStream.Position:=lReadPosition;
-
-      lEffectiveRead:=lBufferedStream.Read(b,lBytesToRead);
-
-      {$IFDEF CHECK_AGAINST_FILE}
-      // Now read without cache
-      lStream.Position:=lReadPosition;
-      lEffectiveRead2:=lStream.Read(b2,lBytesToRead);
-      if lEffectiveRead<>lEffectiveRead2 then begin
-        FAIL('Read length mismatch');
-      end;
-      if not CompareMem(@b[0],@b2[0],lEffectiveRead) then begin
-        FAIL('Compare buffer data error');
-      end;
-      F.Position:=0;
-      {$ELSE}
-      lCheckInitV:=lReadPosition mod 10;
-      for k := 0 to Pred(lEffectiveRead) do begin
-        if b[k]<>AnsiChar(ord('0')+lCheckInitV mod 10) then begin
-          FAIL('Expected data error');
-        end;
-        inc(lCheckInitV);
-      end;
-      {$ENDIF}
-    end;
-    // Writeln('CACHE ',TEST_RANDOM_READS,' random reads in ',GetTickCount64-lTick,' ms.');
-
-    RandSeed:=1;
-    Randomize;
-
-    // Writeln('Same operation without cache');
-    lTick:=GetTickCount64;
-    for j := 0 to Pred(TEST_RANDOM_READS) do begin
-      lBytesToRead:=Random(10000);
-      lReadPosition:=Random(lBufferedStream.Size);
-
-      lStream.Position:=lReadPosition;
-      lEffectiveRead:=lStream.Read(b,lBytesToRead);
-
-      lCheckInitV:=lReadPosition mod 10;
-      for k := 0 to Pred(lEffectiveRead) do begin
-        if b[k]<>AnsiChar(ord('0')+lCheckInitV mod 10) then begin
-          FAIL('Expected data error');
-        end;
-        inc(lCheckInitV);
-      end;
-    end;
-    // Writeln('FILE ',TEST_RANDOM_READS,' random reads in ',GetTickCount64-lTick,' ms.');
-
-    // Writeln('Check sequential read');
-
-    RandSeed:=1;
-    Randomize;
-    lTick:=GetTickCount64;
-    lBytesToRead:=1;
-    lReadPosition:=0;
-    lBufferedStream.Position:=lReadPosition;
-    lStream.Position:=lReadPosition;
-    for j := 0 to Pred(TEST_SEQUENTIAL_READS) do begin
-
-      lEffectiveRead:=lBufferedStream.Read(b,lBytesToRead);
-
-      {$IFDEF CHECK_AGAINST_FILE}
-      // Now read without cache
-      lEffectiveRead2:=lStream.Read(b2,lBytesToRead);
-      if lEffectiveRead<>lEffectiveRead2 then begin
-        FAIL('Read length mismatch');
-      end;
-      if not CompareMem(@b[0],@b2[0],lEffectiveRead) then begin
-        FAIL('Compare buffer data error');
-      end;
-      F.Position:=0;
-      {$ELSE}
-      lCheckInitV:=lReadPosition mod 10;
-      for k := 0 to Pred(lEffectiveRead) do begin
-        if b[k]<>AnsiChar(ord('0')+lCheckInitV mod 10) then begin
-          FAIL('Expected data error');
-        end;
-        inc(lCheckInitV);
-      end;
-      {$ENDIF}
-      inc(lReadPosition,lBytesToRead);
-    end;
-    // Writeln('CACHE ',TEST_SEQUENTIAL_READS,' byte sequential reads in ',GetTickCount64-lTick,' ms.');
-
-    RandSeed:=1;
-    Randomize;
-    lTick:=GetTickCount64;
-    lBytesToRead:=1;
-    lReadPosition:=0;
-    lStream.Position:=lReadPosition;
-    for j := 0 to Pred(TEST_SEQUENTIAL_READS) do begin
-
-      lEffectiveRead:=lStream.Read(b,lBytesToRead);
-
-      lCheckInitV:=lReadPosition mod 10;
-      for k := 0 to Pred(lEffectiveRead) do begin
-        if b[k]<>AnsiChar(ord('0')+lCheckInitV mod 10) then begin
-          FAIL('Expected data error');
-        end;
-        inc(lCheckInitV);
-      end;
-      inc(lReadPosition,lBytesToRead);
-    end;
-    // Writeln('FILE ',TEST_SEQUENTIAL_READS,' byte sequential reads in ',GetTickCount64-lTick,' ms.');
-
-    // Writeln('CACHE Trying read beyond limits');
-    lBufferedStream.Position:=lBufferedStream.Size-1;
-    lEffectiveRead:=lBufferedStream.Read(b,2);
-    if lEffectiveRead<>1 then begin
-      FAIL('Read beyond limits, returned bytes: '+inttostr(lEffectiveRead));
-    end else begin
-      // Writeln('CACHE OK, read beyond limits returns 0 bytes.');
-    end;
-  finally
-    lBufferedStream.Free;
-    lStream.Free;
-  end;
-end;
-
-procedure TTestBufferedFileStream.TestCacheWrite;
-const
-  EXPECTED_SIZE=10000000;
-  TEST_ROUNDS=100000;
-var
-  lBufferedStream: TBufferedFileStream;
-  lStream: TFileStream;
-  lVerifyStream1,lVerifyStream2: TFileStream;
-  b: array [0..10000-1] of AnsiChar;
-  j: integer;
-  lBytesToWrite: integer;
-  lWritePosition: int64;
-begin
-  // Writeln('Testing write cache');
-  // All test should return the same random sequence
-  RandSeed:=1;
-  Randomize;
-  for j := 0 to Pred(10000) do begin
-    b[j]:='0';
-  end;
-  lBufferedStream:=TBufferedFileStream.Create(TEST_WRITEC_FILE,fmCreate);
-  lStream:=TFileStream.Create(TEST_WRITEF_FILE,fmCreate);
-  try
-    for j := 0 to Pred(EXPECTED_SIZE div Sizeof(b)) do begin
-      lBufferedStream.Write(b,sizeof(b));
-      lStream.Write(b,sizeof(b));
-    end;
-    for j := 0 to Pred(Sizeof(b)) do begin
-      b[j]:=AnsiChar(ord('0')+j mod 10);
-    end;
-  finally
-    lBufferedStream.Free;
-    lStream.Free;
-  end;
-  lBufferedStream:=TBufferedFileStream.Create(TEST_WRITEC_FILE,fmOpenReadWrite);
-  lStream:=TFileStream.Create(TEST_WRITEF_FILE,fmOpenWrite);
-  try
-    for j := 0 to Pred(TEST_ROUNDS) do begin
-      if lStream.Size<>lBufferedStream.Size then begin
-        FAIL('Mismatched lengths');
-      end;
-      lWritePosition:=Random(EXPECTED_SIZE);
-      lBytesToWrite:=Random(sizeof(b));
-      lBufferedStream.Position:=lWritePosition;
-      lStream.Position:=lWritePosition;
-      lBufferedStream.Write(b,lBytesToWrite);
-      lStream.Write(b,lBytesToWrite);
-      // if j mod 1273 = 0 then write(j,' / ',TEST_ROUNDS,#13);
-    end;
-    // Writeln(TEST_ROUNDS,' / ',TEST_ROUNDS);
-    if lStream.Size<>lBufferedStream.Size then begin
-      FAIL('Mismatched lengths');
-    end;
-  finally
-    lBufferedStream.Free;
-    lStream.Free;
-  end;
-
-  // Verify both generated files are identical.
-  lVerifyStream1:=TFileStream.Create(TEST_WRITEC_FILE,fmOpenRead or fmShareDenyWrite);
-  lVerifyStream2:=TFileStream.Create(TEST_WRITEF_FILE,fmOpenRead or fmShareDenyWrite);
-  try
-    if not CompareStreams(lVerifyStream1,lVerifyStream2) then begin
-      FAIL('Streams are different!!');
-    end else begin
-      // Writeln('Streams are identical. OK.');
-    end;
-  finally
-    lVerifyStream1.Free;
-    lVerifyStream2.Free;
-  end;
-end;
-
-procedure TTestBufferedFileStream.TestCacheSeek;
-var
-  lBufferedStream: TBufferedFileStream;
-  lStream: TFileStream;
-  bBuffered: array [0..10000] of BYTE;
-  bStream: array [0..10000] of BYTE;
-  bread : Integer;
-
-begin
-  bBuffered[0]:=0; // Avoid initalization hint
-  bStream[0]:=0; // Avoid initalization hint
-  lBufferedStream:=TBufferedFileStream.Create(TEST_FILENAME,fmOpenRead or fmShareDenyWrite);
-  lStream:=TFileStream.Create(TEST_FILENAME,fmOpenRead or fmShareDenyWrite);
-  try
-    // Writeln('Set position=-1');
-    lStream.Position:=-1;
-    // Writeln('TFileStream position=',lStream.Position);
-    lBufferedStream.Position:=-1;
-    // Writeln('Buffered    position=',lBufferedStream.Position);
-    if lStream.Position<>lBufferedStream.Position then begin
-      FAIL('Positions are not the same.');
-    end else begin
-      // Writeln('Positions are the same.');
-    end;
-
-    // Writeln('Read data when position=-1');
-    bread:=lStream.Read(bBuffered[0],10);
-     // Writeln('TFileStream read bytes  : ',bread);
-     // Writeln('TFileStream end position: ',lStream.Position);
-    bread:=lBufferedStream.Read(bStream[0],10);
-     // Writeln('Buffered      read bytes: ',bread);
-     // Writeln('Buffered    end position: ',lBufferedStream.Position);
-    if (not CompareMem(@bBuffered[0],@bStream[0],10)) or (lStream.Position<>lBufferedStream.Position) then begin
-      FAIL('Read data or positions are not the same.');
-    end else begin
-      // Writeln('Read data at -1 is the same.');
-    end;
-
-    // Writeln('Testing Seek operations');
-    // Writeln('Seek -1 from beginning');
-    bread:=lStream.Seek(-1,soBeginning);
-    // Writeln('Stream seek result  : ',bread);
-    bread:=lBufferedStream.Seek(-1,soBeginning);
-    // Writeln('Buffered seek result: ',);
-
-    // Writeln('Read data when Seek -1');
-    bread:=lStream.Read(bBuffered[0],10);
-    // Writeln('TFileStream read bytes  : ',bread);
-    // Writeln('TFileStream end position: ',lStream.Position);
-    bread:=lBufferedStream.Read(bStream[0],10);
-    // Writeln('Buffered      read bytes: ',bread);
-    // Writeln('Buffered    end position: ',lBufferedStream.Position);
-    if (not CompareMem(@bBuffered[0],@bStream[0],10)) or (lStream.Position<>lBufferedStream.Position) then begin
-      FAIL('Read data or positions are not the same.');
-    end else begin
-      // Writeln('Read data at -1 is the same.');
-    end;
-
-    // Writeln('Seek -current*2 from current');
-    bread:=lStream.Seek(lStream.Position*-2,soCurrent);
-    // Writeln('Stream seek result  : ',bread);
-    bread:=lBufferedStream.Seek(lBufferedStream.Position*-2,soCurrent);
-    // Writeln('Buffered seek result: ',bread);
-    // Writeln('Read data when Seek from current -current*2');
-    bread:=lStream.Read(bBuffered[0],10);
-    // Writeln('TFileStream read bytes  : ',bread);
-    // Writeln('TFileStream end position: ',lStream.Position);
-    bread:=lBufferedStream.Read(bStream[0],10);
-    // Writeln('Buffered      read bytes: ',);
-    // Writeln('Buffered    end position: ',lBufferedStream.Position);
-    if (not CompareMem(@bBuffered[0],@bStream[0],10)) or (lStream.Position<>lBufferedStream.Position) then begin
-      FAIL('Read data or positions are not the same.');
-    end else begin
-      // Writeln('Read data at -current*2 is the same.');
-    end;
-  finally
-    lBufferedStream.Free;
-    lStream.Free;
-  end;
-end;
-
-procedure TTestBufferedFileStream.SetUp;
-var
-  F: TFileStream;
-  b: array [0..10000-1] of AnsiChar;
-  j: integer;
-begin
-  for j := 0 to Pred(10000) do begin
-    b[j]:=AnsiChar(ord('0')+j mod 10);
-  end;
-  F:=TFileStream.Create(TEST_FILENAME,fmCreate);
-  for j := 0 to Pred(1000) do begin
-    F.Write(b,sizeof(b));
-  end;
-  F.Free;
-end;
-
-procedure TTestBufferedFileStream.TearDown;
-begin
-  DeleteFile(TEST_FILENAME);
-  DeleteFile(TEST_WRITEC_FILE);
-  DeleteFile(TEST_WRITEF_FILE);
-end;
-
-function TTestBufferedFileStream.CompareStreams(const aStream1: TStream;
-  const aStream2: TStream): Boolean;
-const
-  BUFFER_SIZE=5213; // Odd number
-var
-  b1: array [0..BUFFER_SIZE-1] of BYTE;
-  b2: array [0..BUFFER_SIZE-1] of BYTE;
-  lReadBytes: integer;
-  lAvailable: integer;
-  lEffectiveRead1: integer;
-  lEffectiveRead2: integer;
-begin
-  b1[0]:=0; // Avoid initalization hint
-  b2[0]:=0; // Avoid initalization hint
-  Result:=false;
-  if aStream1.Size<>aStream2.Size then exit;
-  aStream1.Position:=0;
-  aStream2.Position:=0;
-  while aStream1.Position<aStream1.Size do begin
-    lAvailable:=aStream1.Size-aStream1.Position;
-    if lAvailable>=BUFFER_SIZE then begin
-      lReadBytes:=BUFFER_SIZE;
-    end else begin
-      lReadBytes:=aStream1.Size-aStream1.Position;
-    end;
-    lEffectiveRead1:=aStream1.Read(b1[0],lReadBytes);
-    lEffectiveRead2:=aStream2.Read(b2[0],lReadBytes);
-    if lEffectiveRead1<>lEffectiveRead2 then exit;
-    if not CompareMem(@b1[0],@b2[0],lEffectiveRead1) then exit;
-  end;
-  Result:=true;
-end;
-
-initialization
-  RegisterTest(TTestBufferedFileStream);
-end.
-

+ 0 - 148
packages/fcl-base/tests/tccsvdocument.pp

@@ -1,148 +0,0 @@
-unit tccsvdocument;
-
-{$mode objfpc}{$H+}
-
-interface
-
-uses
-  Classes, SysUtils, fpcunit, testregistry, csvdocument;
-
-Type
-
-  { TTestCSVDocument }
-
-  TTestCSVDocument = Class(TTestCase)
-  private
-    FDoc: TCSVDocument;
-    procedure RemoveTestFile;
-    function StripQuotes(S: String): String;
-    procedure TestTestFile;
-  Public
-    Procedure SetUp; override;
-    Procedure TearDown; override;
-    Procedure CreateTestFile;
-    Property Doc : TCSVDocument Read FDoc;
-  Published
-    Procedure TestEmpty;
-    Procedure TestRead;
-  end;
-
-
-
-
-
-implementation
-
-Const
-  TestFileName = 'test.csv';
-
-{ TTestCSVDocument }
-
-procedure TTestCSVDocument.SetUp;
-begin
-  FDoc:=TCSVDocument.Create;
-  Inherited;
-end;
-
-procedure TTestCSVDocument.TearDown;
-begin
-  RemoveTestFile;
-  FreeAndNil(FDoc);
-  Inherited;
-end;
-
-procedure TTestCSVDocument.RemoveTestFile;
-
-begin
-  If FileExists(TestFileName) then
-    AssertTrue('Deleting test file',DeleteFile(TestFileName));
-end;
-
-Const
-  ColCount = 3;
-  RowCount = 4;
-
-Type
-  TRow = Array[0..ColCount-1] of String;
-  TCells = Array[0..RowCount-1] of TRow;
-
-Const
-  Cells : TCells = (
-    ('a','b','c'),
-    ('1','"one"','1.1'),
-    ('2','"two"','2.2'),
-    ('3','"three"','3.3')
-  );
-
-procedure TTestCSVDocument.CreateTestFile;
-
-Var
-  L : TStringList;
-  R,C : Integer;
-  S : String;
-
-begin
-  L:=TStringList.Create;
-  try
-    for R:=0 to RowCount-1 do
-      begin
-      S:='';
-      for C:=0 to ColCount-1 do
-        begin
-        if S<>'' then
-          S:=S+',';
-        S:=S+Cells[R,C];
-        end;
-      L.Add(S);
-      end;
-    L.SaveToFile(TestFileName);
-  finally
-    L.Free;
-  end;
-end;
-
-procedure TTestCSVDocument.TestEmpty;
-begin
-  AssertNotNull('Have document',Doc);
-end;
-
-Function TTestCSVDocument.StripQuotes(S : String) : String;
-
-Var
-  L : integer;
-
-begin
-  Result:=S;
-  L:=Length(Result);
-  if (L>1) then
-    if (Result[1]='"') and (Result[L]='"') then
-      Result:=Copy(Result,2,L-2);
-end;
-
-procedure TTestCSVDocument.TestTestFile;
-
-Var
-  R,C : Integer;
-
-begin
-  AssertEquals('Row count',RowCount,Doc.RowCount);
-  For R:=0 to RowCount-1 do
-    For C:=0 to ColCount-1 do
-      begin
-      AssertEquals('Col['+IntToStr(R)+'] count',ColCount,Doc.ColCount[R]);
-      AssertEquals(Format('Cell[%d,%d]',[C,R]),StripQuotes(Cells[R,C]),Doc.Cells[C,R]);
-      end;
-end;
-
-procedure TTestCSVDocument.TestRead;
-
-begin
-  CreateTestFile;
-  Doc.LoadFromFile(TestFileName);
-  TestTestFile;
-end;
-
-initialization
-  RegisterTest(TTestCSVDocument);
-end.
-

+ 0 - 117
packages/fcl-base/tests/tccsvreadwrite.pp

@@ -1,117 +0,0 @@
-unit tccsvreadwrite;
-
-{$mode objfpc}{$H+}
-
-interface
-
-uses
-  Classes, SysUtils, fpcunit, testregistry, csvreadwrite;
-
-type
-
-  { TTestCSVReadWrite }
-
-  TTestCSVReadWrite= class(TTestCase)
-  private
-    FData: TStrings;
-    FParser: TCSVParser;
-    procedure AssertLine(ARow: Integer; AValues: array of String);
-    procedure HaveNext(ARow, ACol: integer; AValue: String);
-  protected
-    procedure SetUp; override;
-    procedure TearDown; override;
-    Property Parser : TCSVParser Read FParser;
-    Property Data : TStrings Read FData;
-  published
-    procedure TestEmpty;
-    Procedure TestNormalLine;
-    Procedure TestQuotedLine;
-    Procedure TestInlineQuotedLine;
-    Procedure TestQuotedNewLine;
-    Procedure Test2Lines;
-    Procedure TestEscapedQuotes;
-  end;
-
-implementation
-
-procedure TTestCSVReadWrite.TestEmpty;
-begin
-  AssertNotNull('Have parser',Parser);
-end;
-
-procedure TTestCSVReadWrite.HaveNext(ARow,ACol: integer; AValue : String);
-
-Var
-  CN : String;
-
-begin
-  CN:=Format('Cell(row: %d, col: %d)',[ARow,ACol]);
-  AssertTrue('Have '+CN,Parser.ParseNextCell);
-  AssertEquals(CN+': Row matches',ARow,Parser.CurrentRow);
-  AssertEquals(CN+': Col matched',ACol,Parser.CurrentCol);
-  AssertEquals(CN+': Value',AValue,Parser.CurrentCellText);
-end;
-
-procedure TTestCSVReadWrite.AssertLine(ARow: Integer; AValues: array of String);
-
-Var
-  I : Integer;
-
-begin
-  For I:=0 to Length(AValues)-1 do
-    HaveNext(ARow,I,AValues[i]);
-end;
-
-procedure TTestCSVReadWrite.TestNormalLine;
-begin
-  FParser.SetSource('this,is,a,normal,line');
-  AssertLine(0,['this','is','a','normal','line']);
-end;
-
-procedure TTestCSVReadWrite.TestQuotedLine;
-begin
-   FParser.SetSource('"this","is","a","quoted","line"');
-   AssertLine(0,['this','is','a','quoted','line']);
-end;
-
-procedure TTestCSVReadWrite.TestInlineQuotedLine;
-begin
-  FParser.SetSource('"this","line",has,mixed" quoting"');
-  AssertLine(0,['this','line','has','mixed quoting']);
-end;
-
-procedure TTestCSVReadWrite.TestQuotedNewLine;
-begin
-  FParser.SetSource('"this","line",has,"an embedded'+lineEnding+'newline"');
-  AssertLine(0,['this','line','has','an embedded'+lineending+'newline']);
-end;
-
-procedure TTestCSVReadWrite.Test2Lines;
-begin
-  FParser.SetSource('"this","line",has,an embedded'+lineEnding+'newline');
-  AssertLine(0,['this','line','has','an embedded']);
-  AssertLine(1,['newline']);
-end;
-
-procedure TTestCSVReadWrite.TestEscapedQuotes;
-begin
-  FParser.SetSource('"this","line",has,"an embedded "" quote"');
-  AssertLine(0,['this','line','has','an embedded " quote']);
-end;
-
-procedure TTestCSVReadWrite.SetUp;
-begin
-  FParser:=TCSVParser.Create;
-  FData:=TStringList.Create;
-end;
-
-procedure TTestCSVReadWrite.TearDown;
-begin
-  FreeAndNil(FData);
-  FreeAndNil(Fparser);
-end;
-
-initialization
-  RegisterTest(TTestCSVReadWrite);
-end.
-

+ 0 - 171
packages/fcl-base/tests/tchashlist.pp

@@ -1,171 +0,0 @@
-unit tchashlist;
-
-{$mode objfpc}{$H+}
-
-interface
-
-uses
-  Classes, SysUtils, fpcunit, testutils, testregistry, contnrs;
-
-type
-
-  { TItemObject }
-
-  TItemObject = Class(TObject)
-  private
-    FIndex: Integer;
-  Public
-    Constructor Create(AIndex : integer);
-    Property Index : Integer Read FIndex Write FIndex;
-  end;
-
-  { TTestHash }
-
-  TTestHash = class(TTestCase)
-  Protected
-    FH : TFPHashList;
-    FItems : TStringList;
-    Procedure Setup; override;
-    Procedure TearDown; override;
-    Procedure AddItem(I : Integer);
-    Procedure AssertItem(AItemIndex: Integer; AItem : Pointer);
-    Procedure AssertItem(AItemIndex,AHAshIndex : Integer);
-    Procedure AssertCount(ACount : Integer);
-    Procedure AssertCapacity(ACapacity : Integer);
-  published
-    procedure TestEmpty;
-    Procedure TestAdd;
-    Procedure TestGrow;
-    Procedure TestDelete;
-    Procedure TestFind;
-  end;
-
-implementation
-
-{ TItemObject }
-
-constructor TItemObject.Create(AIndex: integer);
-begin
-  FIndex:=AIndex;
-end;
-
-procedure TTestHash.Setup;
-
-Var
-  I : integer;
-begin
-  Inherited;
-  FH:=TFPHashList.Create;
-  FItems:=TStringList.Create;
-  For I:=0 to 1000 do
-    FItems.AddObject(IntToStr(I),TItemObject.Create(i));
-end;
-
-procedure TTestHash.TearDown;
-begin
-  FreeAndNil(FItems);
-  FreeAndNil(FH);
-  Inherited;
-end;
-
-procedure TTestHash.AddItem(I: Integer);
-begin
-  FH.Add(FItems[i],FItems.Objects[i]);
-end;
-
-procedure TTestHash.AssertItem(AItemIndex: Integer; AItem: Pointer);
-begin
-  if not (AItemindex<FItems.Count) then
-    Fail(Format('Incorrect item index : %d >= %d',[AItemIndex,FItems.Count]));
-  AssertSame(Format('Object %d',[AItemIndex]),FItems.Objects[AItemIndex],AItem);
-end;
-
-procedure TTestHash.AssertItem(AItemIndex, AHAshIndex: Integer);
-begin
-  if not (AItemindex<FItems.Count) then
-    Fail(Format('Incorrect item index : %d >= %d',[AItemIndex,FItems.Count]));
-  if not (AHashIndex<FH.Count) then
-    Fail(Format('Incorrect hash index : %d >= %d',[AItemIndex,FItems.Count]));
-  AssertSame(Format('Object %d',[AItemIndex]),FItems.Objects[AItemIndex],FH.Items[AHashIndex]);
-end;
-
-procedure TTestHash.AssertCount(ACount: Integer);
-begin
-  AssertEquals('Hash list item count',ACount,FH.Count);
-end;
-
-procedure TTestHash.AssertCapacity(ACapacity: Integer);
-begin
-  AssertEquals('Hash list capacity',ACapacity,FH.Capacity);
-end;
-
-procedure TTestHash.TestEmpty;
-begin
-  AssertCount(0);
-  AssertCapacity(0);
-end;
-
-Const
-  CS  = 2*SizeOf(ptrint);
-  CS2 = SizeOf(ptrint);
-
-procedure TTestHash.TestAdd;
-begin
-  AddItem(0);
-  AssertCount(1);
-  AssertCapacity(CS);
-  AssertItem(0,0);
-end;
-
-procedure TTestHash.TestGrow;
-
-Var
-  I : Integer;
-
-begin
-  For I:=0 to CS do
-    AddItem(i);
-  AssertCount(CS+1);
-  AssertCapacity(CS+CS+CS2);
-end;
-
-procedure TTestHash.TestDelete;
-
-Var
-  I : Integer;
-
-begin
-  For I:=0 to 9 do
-    AddItem(i);
-  FH.Delete(3);
-  AssertCount(9);
-  For I:=0 to 2 do
-    AssertItem(I,I);
-  For I:=4 to 9 do
-    AssertItem(I,I-1);
-end;
-
-procedure TTestHash.TestFind;
-
-Var
-  I : integer;
-
-begin
-  For I:=0 to FItems.Count-1 do
-    AddItem(I);
-  For I:=0 to FItems.Count-1 do
-    AssertItem(I,FH.FindIndexOf(FItems[i]));
-  For I:=0 to FItems.Count-1 do
-    AssertItem(I,FH.Find(FItems[i]));
-  AssertNull('Not existing not found',FH.Find('XYZ'));
-  FH.Delete(0);
-  AssertNull('Deleted is not found',FH.Find('0'))
-end;
-
-
-
-initialization
-
-  RegisterTest(TTestHash);
-end.
-

+ 0 - 108
packages/fcl-base/tests/tcinifile.pp

@@ -1,108 +0,0 @@
-unit tcinifile;
-
-{$mode objfpc}{$H+}
-
-interface
-
-uses
-  Classes, SysUtils, fpcunit, testutils, inifiles, testregistry;
-
-type
-
-  { TTestIniFile }
-
-  TTestIniFile= class(TTestCase)
-  private
-    Fini: TCustomIniFile;
-  protected
-    Procedure CreateIni;
-    procedure SetUp; override;
-    procedure TearDown; override;
-    Property Ini : TCustomIniFile Read Fini;
-  published
-    procedure TestWriteBoolean;
-    procedure TestReadBoolean;
-  end;
-
-implementation
-
-procedure TTestIniFile.CreateIni;
-
-begin
-  Fini:=TMemIniFIle.Create('tmp.ini');
-end;
-
-procedure TTestIniFile.TestWriteBoolean;
-
-begin
-  CreateIni;
-  Ini.WriteBool('a','b',true);
-  AssertEquals('Default true','1',Ini.ReadString('a','b',''));
-  Ini.WriteBool('a','b',False);
-  AssertEquals('Default false','0',Ini.ReadString('a','b',''));
-  Ini.Options:=Ini.Options+[ifoWriteStringBoolean];
-  Ini.WriteBool('a','b',true);
-  AssertEquals('Default string true','true',Ini.ReadString('a','b',''));
-  Ini.WriteBool('a','b',false);
-  AssertEquals('Default string false','false',Ini.ReadString('a','b',''));
-  Ini.SetBoolStringValues(true,['t','true']);
-  Ini.WriteBool('a','b',true);
-  AssertEquals('True from string array','t',Ini.ReadString('a','b',''));
-  Ini.SetBoolStringValues(false,['f','false']);
-  Ini.WriteBool('a','b',false);
-  AssertEquals('True from string array','f',Ini.ReadString('a','b',''));
-end;
-
-procedure TTestIniFile.TestReadBoolean;
-begin
-  CreateIni;
-  Ini.WriteString('a','b','1');
-  AssertEquals('Default true',true,Ini.ReadBool('a','b',False));
-  Ini.WriteString('a','b','0');
-  AssertEquals('Default false',false,Ini.ReadBool('a','b',True));
-  Ini.WriteString('a','b','');
-  AssertEquals('Empty returns Default ',true,Ini.ReadBool('a','b',true));
-  Ini.SetBoolStringValues(true,['t','true']);
-  Ini.WriteString('a','b','t');
-  AssertEquals('First string match',true,Ini.ReadBool('a','b',false));
-  Ini.WriteString('a','b','true');
-  AssertEquals('Second string match',true,Ini.ReadBool('a','b',false));
-  Ini.WriteString('a','b','d');
-  AssertEquals('No string match, default',true,Ini.ReadBool('a','b',true));
-  Ini.SetBoolStringValues(true,[]);
-  Ini.SetBoolStringValues(false,['f','false']);
-  Ini.WriteString('a','b','f');
-  AssertEquals('First string match',false,Ini.ReadBool('a','b',true));
-  Ini.WriteString('a','b','false');
-  AssertEquals('Second string match',false,Ini.ReadBool('a','b',true));
-  Ini.WriteString('a','b','d');
-  AssertEquals('No string match, default',false,Ini.ReadBool('a','b',false));
-  Ini.SetBoolStringValues(true,['t','true']);
-  AssertEquals('No string match, default',false,Ini.ReadBool('a','b',false));
-  Ini.SetBoolStringValues(true,[]);
-  Ini.SetBoolStringValues(False,[]);
-  Ini.Options:=Ini.Options+[ifoWriteStringBoolean];
-  Ini.WriteString('a','b','true');
-  AssertEquals('ifoWriteStringBoolean, true string ',True,Ini.ReadBool('a','b',false));
-  Ini.WriteString('a','b','false');
-  AssertEquals('ifoWriteStringBoolean, false string',false,Ini.ReadBool('a','b',true));
-  Ini.WriteString('a','b','soso');
-  AssertEquals('ifoWriteStringBoolean, No string match, default',True,Ini.ReadBool('a','b',true));
-
-end;
-
-procedure TTestIniFile.SetUp;
-begin
-  DeleteFile('tmp.ini');
-end;
-
-procedure TTestIniFile.TearDown;
-begin
-  DeleteFile('tmp.ini');
-end;
-
-initialization
-
-  RegisterTest(TTestIniFile);
-end.
-

+ 0 - 43
packages/fcl-base/tests/tcmaskutils.pp

@@ -1,43 +0,0 @@
-unit tcmaskutils;
-
-{$mode objfpc}{$H+}
-
-interface
-
-uses
-  Classes, SysUtils, fpcunit, testregistry, maskutils;
-
-Type
-
-  { TTestMaskUtils }
-
-  TTestMaskUtils = Class(TTestCase)
-  Published
-    Procedure Test1;
-    Procedure Test2;
-    Procedure Test3;
-  end;
-
-implementation
-
-{ TTestMaskUtils }
-
-procedure TTestMaskUtils.Test1;
-begin
-  AssertEquals('H1H357-K808K-44616-YK8720',FormatMaskText('!>cccccc\-ccccc\-ccccc\-cccccc;0;*', 'H1H357K808K44616YK8720'))
-end;
-
-procedure TTestMaskUtils.Test2;
-begin
-  AssertEquals('555.   .   .   ',FormatMaskText('999.999.999.999','555555'));
-end;
-
-procedure TTestMaskUtils.Test3;
-begin
-  AssertEquals('555.   .   .   ',FormatMaskText('999.999.999.999;1;_','555555'));
-end;
-
-initialization
-  RegisterTest(TTestMaskUtils);
-end.
-

+ 0 - 169
packages/fcl-base/tests/testbasenenc.lpr

@@ -1,169 +0,0 @@
-{
-    This file is part of the Free Pascal run time library.
-    Copyright (c) 2021 by Michael Van Canneyt,
-    member of the Free Pascal development team
-
-    Test for Base 16,32,32hex,32-crockford, 64,64url encoding/decoding, with or without padding
-
-    See the file COPYING.FPC, included in this distribution,
-    for details about the copyright.
-
-    This program is distributed in the hope that it will be useful,
-    but WITHOUT ANY WARRANTY; without even the implied warranty of
-    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
-
- **********************************************************************}
-program testbasenenc;
-
-{$mode objfpc}
-{$h+}
-
-uses sysutils, basenenc;
-
-
-Procedure AssertEquals(Const aActual,aExpected : TBytes; aMsg : String);
-
-  function ToStr(aBytes : TBytes) : String;
-
-  Var
-    I : Integer;
-
-  begin
-    Result:='';
-    For I:=0 to Length(aBytes) do
-      begin
-      if I>0 then
-        Result:=Result+',';
-      Result:=Result+IntToStr(aBytes[i]);
-      end;
-    Result:='['+Result+']';
-  end;
-
-begin
-  if (Length(aActual)<>Length(aExpected))
-     or Not CompareMem(PByte(aActual),PByte(aExpected),Length(aActual)) then
-    begin
-    Writeln(aMsg,': results differ, actual: "',ToStr(aActual),'" <> "',ToStr(aExpected),'" (expected)');
-    Halt(1);
-    end;
-end;
-
-Procedure AssertEquals(Const aActual,aExpected,aMsg : String);
-
-begin
-  if aActual<>aExpected then
-    begin
-    Writeln(aMsg,': results differ, actual: "',aActual,'" <> "',aExpected,'" (expected)');
-    Halt(1);
-    end;
-end;
-
-Procedure DoTest(B : Tbytes; aExpected : String; aURL : Boolean = False);
-
-Var
-  B2 : TBytes;
-  S : Ansistring;
-
-begin
-  if aURL then
-    S:=Base64URL.Encode(B)
-  else
-    S:=Base64.Encode(B);
-  AssertEquals(S,aExpected,'DoTest Wrong encode');
-  if aURL then
-    B2:=Base64URL.Decode(S)
-  else
-    B2:=Base64.Decode(S);
-  AssertEquals(B2,B,'DoTest Wrong decode');
-end;
-
-Procedure DoTest64(aValue, aExpected : String);
-
-begin
-  DoTest(TEncoding.UTF8.GetAnsiBytes(aValue),aExpected);
-end;
-
-Procedure DoTest32(aValue, aExpected : String);
-
-Var
-  B2 : TBytes;
-  S : Ansistring;
-
-begin
-  S:=Base32.Encode(aValue);
-  AssertEquals(S,aExpected,'base32 encode');
-  B2:=Base32.Decode(S);
-  AssertEquals(b2,TEncoding.UTF8.GetAnsiBytes(aValue),'Base32 Wrong encode for '+aValue);
-end;
-
-Procedure DoTest32Hex(aValue, aExpected : String);
-
-Var
-  B2 : TBytes;
-  S : Ansistring;
-
-begin
-  S:=Base32Hex.Encode(aValue);
-  AssertEquals(S,aExpected,'Base32-hex Wrong encode for '+aValue);
-  B2:=Base32Hex.Decode(S);
-  AssertEquals(B2,TEncoding.UTF8.GetAnsiBytes(aValue),'Base32Hex Wrong encode for '+aValue);
-end;
-
-Procedure DoTest16(aValue, aExpected : String);
-
-Var
-  B2 : TBytes;
-  S : Ansistring;
-
-begin
-  S:=Base16.Encode(aValue);
-  AssertEquals(S,aExpected,'Base16 Wrong encode for '+aValue);
-  B2:=Base16.Decode(S);
-  AssertEquals(B2,TEncoding.UTF8.GetAnsiBytes(aValue),'Base16 Wrong decode for '+aValue);
-end;
-
-
-
-begin
-  // From RFC 3548
-
-  DoTest([$14,$fb,$9c,$03,$d9,$7e],'FPucA9l+');
-  DoTest([$14,$fb,$9c,$03,$d9],'FPucA9k=');
-  DoTest([$14,$fb,$9c,$03],'FPucAw==');
-  DoTest([$14,$fb,$9c,$03,$d9,$7e],'FPucA9l-',True);
-
-  // From RFC 4648
-  DoTest64('','');
-  DoTest64('f','Zg==');
-  DoTest64('fo','Zm8=');
-  DoTest64('foo','Zm9v');
-  DoTest64('foob','Zm9vYg==');
-  DoTest64('fooba','Zm9vYmE=');
-  DoTest64('foobar','Zm9vYmFy');
-
-  DoTest32('','');
-  DoTest32('f','MY======');
-  DoTest32('fo','MZXQ====');
-  DoTest32('foo','MZXW6===');
-  DoTest32('foob','MZXW6YQ=');
-  DoTest32('fooba','MZXW6YTB');
-  DoTest32('foobar','MZXW6YTBOI======');
-
-  DoTest32HEX('','');
-  DoTest32HEX('f','CO======');
-  DoTest32HEX('fo','CPNG====');
-  DoTest32HEX('foo','CPNMU===');
-  DoTest32HEX('foob','CPNMUOG=');
-  DoTest32HEX('fooba','CPNMUOJ1');
-  DoTest32HEX('foobar','CPNMUOJ1E8======');
-
-  DoTest16('','');
-  DoTest16('f','66');
-  DoTest16('fo','666F');
-  DoTest16('foo','666F6F');
-  DoTest16('foob','666F6F62');
-  DoTest16('fooba','666F6F6261');
-  DoTest16('foobar','666F6F626172');
-  Writeln('All OK');
-end.
-

+ 0 - 7281
packages/fcl-base/tests/testexprpars.pp

@@ -1,7281 +0,0 @@
-{
-    This file is part of the Free Component Library (FCL)
-    Copyright (c) 2008 Michael Van Canneyt.
-    
-    File which provides examples and all testcases for the expression parser.
-    It needs fcl-fpcunit to work.
-    
-    See the file COPYING.FPC, included in this distribution,
-    for details about the copyright.
-
-    This program is distributed in the hope that it will be useful,
-    but WITHOUT ANY WARRANTY; without even the implied warranty of
-    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
-
- **********************************************************************}
-unit testexprpars;
-
-{$mode objfpc}{$H+}
-
-interface
-
-uses
-  Classes, SysUtils, fpcunit, testutils, testregistry, math, fpexprpars;
-
-type
-
-  { TTestExpressionScanner }
-
-  TTestExpressionScanner = class(TTestCase)
-  Private
-    FP : TFPExpressionScanner;
-    FInvalidString : String;
-    procedure DoInvalidNumber(AString: String);
-    procedure TestIdentifier(const ASource, ATokenName: String);
-    procedure TestInvalidNumber;
-  protected
-    procedure SetUp; override; 
-    procedure TearDown; override;
-    Procedure AssertEquals(Msg : String; AExpected, AActual : TTokenType); overload;
-    Procedure TestString(Const AString : String; AToken : TTokenType);
-  published
-    procedure TestCreate;
-    procedure TestSetSource;
-    Procedure TestWhiteSpace;
-    Procedure TestTokens;
-    Procedure TestNumber;
-    Procedure TestInvalidCharacter;
-    Procedure TestUnterminatedString;
-    Procedure TestQuotesInString;
-    Procedure TestIdentifiers;
-  end;
-
-  { TMyFPExpressionParser }
-
-  TMyFPExpressionParser = Class(TFPExpressionParser)
-  Public
-    Procedure BuildHashList;
-    Property ExprNode;
-    Property Scanner;
-    Property Dirty;
-  end;
-
-  { TTestBaseParser }
-
-  TTestBaseParser = class(TTestCase)
-  private
-    procedure DoCheck;
-  Protected
-    FDestroyCalled : Integer;
-    FCheckNode : TFPExprNode;
-    procedure AssertNodeType(Msg: String; AClass: TClass; ANode: TFPExprNode); overload;
-    procedure AssertEquals(Msg: String; AResultType : TResultType; ANode: TFPExprNode); overload;
-    procedure AssertEquals(Msg: String; AExpected,AActual : TResultType); overload;
-    Function CreateBoolNode(ABoolean: Boolean) : TFPExprNode;
-    Function CreateIntNode(AInteger: Integer) : TFPExprNode;
-    Function CreateFloatNode(AFloat : TExprFloat) : TFPExprNode;
-    Function CreateStringNode(Astring : String) : TFPExprNode;
-    Function CreateDateTimeNode(ADateTime : TDateTime) : TFPExprNode;
-    Procedure AssertNodeOK(FN : TFPExprNode);
-    Procedure AssertNodeNotOK(Const Msg : String; FN : TFPExprNode);
-    Procedure Setup; override;
-  end;
-
-  { TMyDestroyNode }
-
-  TMyDestroyNode = Class(TFPConstExpression)
-    FTest : TTestBaseParser;
-  Public
-    Constructor CreateTest(ATest : TTestBaseParser);
-    Destructor Destroy; override;
-  end;
-
-  { TTestDestroyNode }
-
-  TTestDestroyNode =  Class(TTestBaseParser)
-  Published
-    Procedure TestDestroy;
-  end;
-
-  { TTestConstExprNode }
-
-  TTestConstExprNode = Class(TTestBaseParser)
-  private
-    FN : TFPConstExpression;
-  Protected
-    Procedure TearDown; override;
-  Published
-    Procedure TestCreateInteger;
-    procedure TestCreateFloat;
-    procedure TestCreateBoolean;
-    procedure TestCreateDateTime;
-    procedure TestCreateString;
-  end;
-
-  { TTestNegateExprNode }
-
-  TTestNegateExprNode = Class(TTestBaseParser)
-  Private
-    FN : TFPNegateOperation;
-  Protected
-    Procedure TearDown; override;
-  Published
-    Procedure TestCreateInteger;
-    procedure TestCreateFloat;
-    procedure TestCreateOther1;
-    procedure TestCreateOther2;
-    Procedure TestDestroy;
-  end;
-
-  { TTestBinaryAndNode }
-
-  TTestBinaryAndNode = Class(TTestBaseParser)
-  Private
-    FN : TFPBinaryAndOperation;
-  Protected
-    Procedure TearDown; override;
-  Published
-    Procedure TestCreateInteger;
-    procedure TestCreateBoolean;
-    procedure TestCreateBooleanInteger;
-    procedure TestCreateString;
-    procedure TestCreateFloat;
-    procedure TestCreateDateTime;
-    Procedure TestDestroy;
-  end;
-
-  { TTestNotNode }
-
-  TTestNotNode = Class(TTestBaseParser)
-  Private
-    FN : TFPNotNode;
-  Protected
-    Procedure TearDown; override;
-  Published
-    Procedure TestCreateInteger;
-    procedure TestCreateBoolean;
-    procedure TestCreateString;
-    procedure TestCreateFloat;
-    procedure TestCreateDateTime;
-    Procedure TestDestroy;
-  end;
-
-  { TTestBinaryOrNode }
-
-  TTestBinaryOrNode = Class(TTestBaseParser)
-  Private
-    FN : TFPBinaryOrOperation;
-  Protected
-    Procedure TearDown; override;
-  Published
-    Procedure TestCreateInteger;
-    procedure TestCreateBoolean;
-    procedure TestCreateBooleanInteger;
-    procedure TestCreateString;
-    procedure TestCreateFloat;
-    procedure TestCreateDateTime;
-    Procedure TestDestroy;
-  end;
-
-  { TTestBinaryXOrNode }
-
-  TTestBinaryXOrNode = Class(TTestBaseParser)
-  Private
-    FN : TFPBinaryXOrOperation;
-  Protected
-    Procedure TearDown; override;
-  Published
-    Procedure TestCreateInteger;
-    procedure TestCreateBoolean;
-    procedure TestCreateBooleanInteger;
-    procedure TestCreateString;
-    procedure TestCreateFloat;
-    procedure TestCreateDateTime;
-    Procedure TestDestroy;
-  end;
-
-  { TTestIfOperation }
-
-  TTestIfOperation = Class(TTestBaseParser)
-  Private
-    FN : TIfOperation;
-  Protected
-    Procedure TearDown; override;
-  Published
-    Procedure TestCreateInteger;
-    procedure TestCreateBoolean;
-    procedure TestCreateBoolean2;
-    procedure TestCreateString;
-    procedure TestCreateFloat;
-    procedure TestCreateDateTime;
-    procedure TestCreateBooleanInteger;
-    procedure TestCreateBooleanInteger2;
-    procedure TestCreateBooleanString;
-    procedure TestCreateBooleanString2;
-    procedure TestCreateBooleanDateTime;
-    procedure TestCreateBooleanDateTime2;
-    Procedure TestDestroy;
-  end;
-
-  { TTestCaseOperation }
-
-  TTestCaseOperation = Class(TTestBaseParser)
-  Private
-    FN : TCaseOperation;
-  Protected
-    Function CreateArgs(Args : Array of Const) : TExprArgumentArray;
-    Procedure TearDown; override;
-  Published
-    Procedure TestCreateOne;
-    procedure TestCreateTwo;
-    procedure TestCreateThree;
-    procedure TestCreateOdd;
-    procedure TestCreateNoExpression;
-    procedure TestCreateWrongLabel;
-    procedure TestCreateWrongValue;
-    procedure TestIntegerTag;
-    procedure TestIntegerTagDefault;
-    procedure TestStringTag;
-    procedure TestStringTagDefault;
-    procedure TestFloatTag;
-    procedure TestFloatTagDefault;
-    procedure TestBooleanTag;
-    procedure TestBooleanTagDefault;
-    procedure TestDateTimeTag;
-    procedure TestDateTimeTagDefault;
-    procedure TestIntegerValue;
-    procedure TestIntegerValueDefault;
-    procedure TestStringValue;
-    procedure TestStringValueDefault;
-    procedure TestFloatValue;
-    procedure TestFloatValueDefault;
-    procedure TestBooleanValue;
-    procedure TestBooleanValueDefault;
-    procedure TestDateTimeValue;
-    procedure TestDateTimeValueDefault;
-    Procedure TestDestroy;
-  end;
-
-  { TTestBooleanNode }
-
-  TTestBooleanNode = Class(TTestBaseParser)
-  Protected
-    Procedure TestNode(B : TFPBooleanResultOperation; AResult : Boolean);
-  end;
-
-  { TTestEqualNode }
-
-  TTestEqualNode = Class(TTestBooleanNode)
-  Private
-    FN : TFPBooleanResultOperation;
-  Protected
-    Procedure TearDown; override;
-    Class Function NodeClass : TFPBooleanResultOperationClass; virtual;
-    Class Function ExpectedResult : Boolean; virtual;
-    Class Function OperatorString : String; virtual;
-  Published
-    Procedure TestCreateIntegerEqual;
-    procedure TestCreateIntegerUnEqual;
-    Procedure TestCreateFloatEqual;
-    procedure TestCreateFloatUnEqual;
-    Procedure TestCreateStringEqual;
-    procedure TestCreateStringUnEqual;
-    Procedure TestCreateBooleanEqual;
-    procedure TestCreateBooleanUnEqual;
-    Procedure TestCreateDateTimeEqual;
-    procedure TestCreateDateTimeUnEqual;
-    Procedure TestDestroy;
-    Procedure TestWrongTypes1;
-    procedure TestWrongTypes2;
-    procedure TestWrongTypes3;
-    procedure TestWrongTypes4;
-    procedure TestWrongTypes5;
-    Procedure TestAsString;
-  end;
-
-  { TTestUnEqualNode }
-
-  TTestUnEqualNode = Class(TTestEqualNode)
-  Protected
-    Class Function NodeClass : TFPBooleanResultOperationClass; override;
-    Class Function ExpectedResult : Boolean; override;
-    Class Function OperatorString : String; override;
-  end;
-
-  { TTestLessThanNode }
-
-  TTestLessThanNode = Class(TTestBooleanNode)
-  Private
-    FN : TFPBooleanResultOperation;
-  Protected
-    Class Function NodeClass : TFPBooleanResultOperationClass; virtual;
-    Class Function Larger : Boolean; virtual;
-    Class Function AllowEqual : Boolean; virtual;
-    Class Function OperatorString : String; virtual;
-    Procedure TearDown; override;
-  Published
-    Procedure TestCreateIntegerEqual;
-    procedure TestCreateIntegerSmaller;
-    procedure TestCreateIntegerLarger;
-    Procedure TestCreateFloatEqual;
-    procedure TestCreateFloatSmaller;
-    procedure TestCreateFloatLarger;
-    Procedure TestCreateDateTimeEqual;
-    procedure TestCreateDateTimeSmaller;
-    procedure TestCreateDateTimeLarger;
-    Procedure TestCreateStringEqual;
-    procedure TestCreateStringSmaller;
-    procedure TestCreateStringLarger;
-    Procedure TestWrongTypes1;
-    procedure TestWrongTypes2;
-    procedure TestWrongTypes3;
-    procedure TestWrongTypes4;
-    procedure TestWrongTypes5;
-    Procedure TestNoBoolean1;
-    Procedure TestNoBoolean2;
-    Procedure TestNoBoolean3;
-    Procedure TestAsString;
-  end;
-
-  { TTestLessThanEqualNode }
-
-  TTestLessThanEqualNode = Class(TTestLessThanNode)
-  protected
-    Class Function NodeClass : TFPBooleanResultOperationClass; override;
-    Class Function AllowEqual : Boolean; override;
-    Class Function OperatorString : String; override;
-  end;
-
-  { TTestLargerThanNode }
-
-  TTestLargerThanNode = Class(TTestLessThanNode)
-  protected
-    Class Function NodeClass : TFPBooleanResultOperationClass; override;
-    Class Function Larger : Boolean; override;
-    Class Function OperatorString : String; override;
-  end;
-  { TTestLargerThanEqualNode }
-
-  TTestLargerThanEqualNode = Class(TTestLargerThanNode)
-  protected
-    Class Function NodeClass : TFPBooleanResultOperationClass; override;
-    Class Function AllowEqual : Boolean; override;
-    Class Function OperatorString : String; override;
-  end;
-
-  { TTestAddNode }
-
-  TTestAddNode = Class(TTestBaseParser)
-  Private
-    FN : TFPAddOperation;
-  Protected
-    Procedure TearDown; override;
-  Published
-    Procedure TestCreateInteger;
-    Procedure TestCreateFloat;
-    Procedure TestCreateDateTime;
-    Procedure TestCreateString;
-    Procedure TestCreateBoolean;
-    Procedure TestDestroy;
-    Procedure TestAsString;
-  end;
-
-  { TTestSubtractNode }
-
-  TTestSubtractNode = Class(TTestBaseParser)
-  Private
-    FN : TFPSubtractOperation;
-  Protected
-    Procedure TearDown; override;
-  Published
-    Procedure TestCreateInteger;
-    Procedure TestCreateFloat;
-    Procedure TestCreateDateTime;
-    Procedure TestCreateString;
-    Procedure TestCreateBoolean;
-    Procedure TestDestroy;
-    Procedure TestAsString;
-  end;
-
-  { TTestMultiplyNode }
-
-  TTestMultiplyNode = Class(TTestBaseParser)
-  Private
-    FN : TFPMultiplyOperation;
-  Protected
-    Procedure TearDown; override;
-  Published
-    Procedure TestCreateInteger;
-    Procedure TestCreateFloat;
-    Procedure TestCreateDateTime;
-    Procedure TestCreateString;
-    Procedure TestCreateBoolean;
-    Procedure TestDestroy;
-    Procedure TestAsString;
-  end;
-
-  { TTestPowerNode }
-
-  TTestPowerNode = Class(TTestBaseParser)
-  Private
-    FN : TFPPowerOperation;
-    FE : TFPExpressionParser;
-  Protected
-    Procedure Setup; override;
-    Procedure TearDown; override;
-    procedure Calc(AExpr: String; Expected: Double = NaN);
-  Published
-    Procedure TestCreateInteger;
-    Procedure TestCreateFloat;
-    Procedure TestCreateDateTime;
-    Procedure TestCreateString;
-    Procedure TestCreateBoolean;
-    Procedure TestDestroy;
-    Procedure TestAsString;
-    Procedure TestCalc;
-  end;
-
-  { TTestDivideNode }
-
-  TTestDivideNode = Class(TTestBaseParser)
-  Private
-    FN : TFPDivideOperation;
-  Protected
-    Procedure TearDown; override;
-  Published
-    Procedure TestCreateInteger;
-    Procedure TestCreateFloat;
-    Procedure TestCreateDateTime;
-    Procedure TestCreateString;
-    Procedure TestCreateBoolean;
-    Procedure TestDestroy;
-    Procedure TestAsString;
-  end;
-
-  { TTestIntToFloatNode }
-
-  TTestIntToFloatNode = Class(TTestBaseParser)
-  Private
-    FN : TIntToFloatNode;
-  Protected
-    Procedure TearDown; override;
-  Published
-    Procedure TestCreateInteger;
-    Procedure TestCreateFloat;
-    Procedure TestDestroy;
-    Procedure TestAsString;
-  end;
-
-  { TTestIntToDateTimeNode }
-
-  TTestIntToDateTimeNode = Class(TTestBaseParser)
-  Private
-    FN : TIntToDateTimeNode;
-  Protected
-    Procedure TearDown; override;
-  Published
-    Procedure TestCreateInteger;
-    Procedure TestCreateFloat;
-    Procedure TestDestroy;
-    Procedure TestAsString;
-  end;
-
-  { TTestFloatToDateTimeNode }
-
-  TTestFloatToDateTimeNode = Class(TTestBaseParser)
-  Private
-    FN : TFloatToDateTimeNode;
-  Protected
-    Procedure TearDown; override;
-  Published
-    Procedure TestCreateInteger;
-    Procedure TestCreateFloat;
-    Procedure TestDestroy;
-    Procedure TestAsString;
-  end;
-
-  { TTestExpressionParser }
-  TTestExpressionParser = class(TTestBaseParser)
-  Private
-    FP : TMyFPExpressionParser;
-    FTestExpr : String;
-    procedure DoAddInteger(var Result: TFPExpressionResult;
-      const Args: TExprParameterArray);
-    procedure DoDeleteString(var Result: TFPExpressionResult;
-      const Args: TExprParameterArray);
-    procedure DoEchoBoolean(var Result: TFPExpressionResult; Const Args: TExprParameterArray);
-    procedure DoEchoDate(var Result: TFPExpressionResult; Const Args: TExprParameterArray);
-    procedure DoEchoFloat(var Result: TFPExpressionResult; Const Args: TExprParameterArray);
-    procedure DoEchoCurrency(var Result: TFPExpressionResult; Const Args: TExprParameterArray);
-    procedure DoEchoInteger(var Result: TFPExpressionResult; Const Args: TExprParameterArray);
-    procedure DoEchoString(var Result: TFPExpressionResult; Const Args: TExprParameterArray);
-    procedure DoGetDate(var Result: TFPExpressionResult; Const Args: TExprParameterArray);
-    procedure DoParse;
-    procedure TestParser(AExpr: String);
-  protected
-    procedure SetUp; override;
-    procedure TearDown; override;
-    Procedure AssertLeftRight(N : TFPExprNode; LeftClass,RightClass : TClass);
-    Procedure AssertOperand(N : TFPExprNode; OperandClass : TClass);
-    Procedure AssertResultType(RT : TResultType);
-    Procedure AssertResult(F : TExprFloat);
-    Procedure AssertCurrencyResult(C : Currency);
-    Procedure AssertResult(I : Int64);
-    Procedure AssertResult(S : String);
-    Procedure AssertResult(B : Boolean);
-    Procedure AssertDateTimeResult(D : TDateTime);
-  end;
-
-  { TTestParserExpressions }
-
-  TTestParserExpressions = Class(TTestExpressionParser)
-  private
-  Published
-    Procedure TestCreate;
-    Procedure TestNumberValues;
-    Procedure TestSimpleNodeFloat;
-    procedure TestSimpleNodeInteger;
-    procedure TestSimpleNodeBooleanTrue;
-    procedure TestSimpleNodeBooleanFalse;
-    procedure TestSimpleNodeString;
-    procedure TestSimpleNegativeInteger;
-    procedure TestSimpleNegativeFloat;
-    procedure TestSimpleAddInteger;
-    procedure TestSimpleAddFloat;
-    procedure TestSimpleAddIntegerFloat;
-    procedure TestSimpleAddFloatInteger;
-    procedure TestSimpleAddString;
-    procedure TestSimpleSubtractInteger;
-    procedure TestSimpleSubtractFloat;
-    procedure TestSimpleSubtractIntegerFloat;
-    procedure TestSimpleSubtractFloatInteger;
-    procedure TestSimpleMultiplyFloat;
-    procedure TestSimpleMultiplyInteger;
-    procedure TestSimpleDivideFloat;
-    procedure TestSimpleDivideInteger;
-    procedure TestSimpleBooleanAnd;
-    procedure TestSimpleIntegerAnd;
-    procedure TestSimpleBooleanOr;
-    procedure TestSimpleIntegerOr;
-    procedure TestSimpleBooleanNot;
-    procedure TestSimpleIntegerNot;
-    procedure TestSimpleAddSeries;
-    procedure TestSimpleMultiplySeries;
-    procedure TestSimpleAddMultiplySeries;
-    procedure TestSimpleAddAndSeries;
-    procedure TestSimpleAddOrSeries;
-    procedure TestSimpleOrNotSeries;
-    procedure TestSimpleAndNotSeries;
-    procedure TestDoubleAddMultiplySeries;
-    procedure TestDoubleSubtractMultiplySeries;
-    procedure TestSimpleIfInteger;
-    procedure TestSimpleIfString;
-    procedure TestSimpleIfFloat;
-    procedure TestSimpleIfBoolean;
-    procedure TestSimpleIfDateTime;
-    procedure TestSimpleIfOperation;
-    procedure TestSimpleBrackets;
-    procedure TestSimpleBrackets2;
-    procedure TestSimpleBracketsLeft;
-    procedure TestSimpleBracketsRight;
-    procedure TestSimpleBracketsDouble;
-    procedure TestExpressionAfterClear;
-  end;
-
-  TTestParserBooleanOperations = Class(TTestExpressionParser)
-  Published
-    Procedure TestEqualInteger;
-    procedure TestUnEqualInteger;
-    procedure TestEqualFloat;
-    procedure TestEqualFloat2;
-    procedure TestUnEqualFloat;
-    procedure TestEqualString;
-    procedure TestEqualString2;
-    procedure TestUnEqualString;
-    procedure TestUnEqualString2;
-    Procedure TestEqualBoolean;
-    procedure TestUnEqualBoolean;
-    procedure TestLessThanInteger;
-    procedure TestLessThanInteger2;
-    procedure TestLessThanEqualInteger;
-    procedure TestLessThanEqualInteger2;
-    procedure TestLessThanFloat;
-    procedure TestLessThanFloat2;
-    procedure TestLessThanEqualFloat;
-    procedure TestLessThanEqualFloat2;
-    procedure TestLessThanString;
-    procedure TestLessThanString2;
-    procedure TestLessThanEqualString;
-    procedure TestLessThanEqualString2;
-    procedure TestGreaterThanInteger;
-    procedure TestGreaterThanInteger2;
-    procedure TestGreaterThanEqualInteger;
-    procedure TestGreaterThanEqualInteger2;
-    procedure TestGreaterThanFloat;
-    procedure TestGreaterThanFloat2;
-    procedure TestGreaterThanEqualFloat;
-    procedure TestGreaterThanEqualFloat2;
-    procedure TestGreaterThanString;
-    procedure TestGreaterThanString2;
-    procedure TestGreaterThanEqualString;
-    procedure TestGreaterThanEqualString2;
-    procedure EqualAndSeries;
-    procedure EqualAndSeries2;
-    procedure EqualOrSeries;
-    procedure EqualOrSeries2;
-    procedure UnEqualAndSeries;
-    procedure UnEqualAndSeries2;
-    procedure UnEqualOrSeries;
-    procedure UnEqualOrSeries2;
-    procedure LessThanAndSeries;
-    procedure LessThanAndSeries2;
-    procedure LessThanOrSeries;
-    procedure LessThanOrSeries2;
-    procedure GreaterThanAndSeries;
-    procedure GreaterThanAndSeries2;
-    procedure GreaterThanOrSeries;
-    procedure GreaterThanOrSeries2;
-    procedure LessThanEqualAndSeries;
-    procedure LessThanEqualAndSeries2;
-    procedure LessThanEqualOrSeries;
-    procedure LessThanEqualOrSeries2;
-    procedure GreaterThanEqualAndSeries;
-    procedure GreaterThanEqualAndSeries2;
-    procedure GreaterThanEqualOrSeries;
-    procedure GreaterThanEqualOrSeries2;
-  end;
-
-  { TTestParserOperands }
-
-  TTestParserOperands = Class(TTestExpressionParser)
-  private
-  Published
-    Procedure MissingOperand1;
-    procedure MissingOperand2;
-    procedure MissingOperand3;
-    procedure MissingOperand4;
-    procedure MissingOperand5;
-    procedure MissingOperand6;
-    procedure MissingOperand7;
-    procedure MissingOperand8;
-    procedure MissingOperand9;
-    procedure MissingOperand10;
-    procedure MissingOperand11;
-    procedure MissingOperand12;
-    procedure MissingOperand13;
-    procedure MissingOperand14;
-    procedure MissingOperand15;
-    procedure MissingOperand16;
-    procedure MissingOperand17;
-    procedure MissingOperand18;
-    procedure MissingOperand19;
-    procedure MissingOperand20;
-    procedure MissingOperand21;
-    procedure MissingBracket1;
-    procedure MissingBracket2;
-    procedure MissingBracket3;
-    procedure MissingBracket4;
-    procedure MissingBracket5;
-    procedure MissingBracket6;
-    procedure MissingBracket7;
-    procedure MissingArgument1;
-    procedure MissingArgument2;
-    procedure MissingArgument3;
-    procedure MissingArgument4;
-    procedure MissingArgument5;
-    procedure MissingArgument6;
-    procedure MissingArgument7;
-  end;
-
-  { TTestParserTypeMatch }
-
-  TTestParserTypeMatch = Class(TTestExpressionParser)
-  Private
-    Procedure AccessString;
-    Procedure AccessInteger;
-    Procedure AccessFloat;
-    Procedure AccessDateTime;
-    Procedure AccessBoolean;
-  Published
-    Procedure TestTypeMismatch1;
-    procedure TestTypeMismatch2;
-    procedure TestTypeMismatch3;
-    procedure TestTypeMismatch4;
-    procedure TestTypeMismatch5;
-    procedure TestTypeMismatch6;
-    procedure TestTypeMismatch7;
-    procedure TestTypeMismatch8;
-    procedure TestTypeMismatch9;
-    procedure TestTypeMismatch10;
-    procedure TestTypeMismatch11;
-    procedure TestTypeMismatch12;
-    procedure TestTypeMismatch13;
-    procedure TestTypeMismatch14;
-    procedure TestTypeMismatch15;
-    procedure TestTypeMismatch16;
-    procedure TestTypeMismatch17;
-    procedure TestTypeMismatch18;
-    procedure TestTypeMismatch19;
-    procedure TestTypeMismatch20;
-    procedure TestTypeMismatch21;
-    procedure TestTypeMismatch22;
-    procedure TestTypeMismatch23;
-    procedure TestTypeMismatch24;
-  end;
-
-  { TTestParserVariables }
-
-  TTestParserVariables = Class(TTestExpressionParser)
-  private
-    FAsWrongType : TResultType;
-    FEventName: String;
-    FBoolValue : Boolean;
-    FTest33 : TFPExprIdentifierDef;
-    FIdentifiers : TStrings;
-    procedure AddIdentifier(Sender: TObject; const aIdentifier: String; var aIdent : TFPExprIdentifierDef);
-    procedure DoGetBooleanVar(var Res: TFPExpressionResult; ConstRef AName: ShortString);
-    procedure DoGetBooleanVarWrong(var Res: TFPExpressionResult; ConstRef AName: ShortString);
-    procedure TestAccess(Skip: TResultType);
-    procedure TestAccess(Skip: TResultTypes);
-  Protected
-    procedure DoTestVariable33;
-    procedure AddVariabletwice;
-    procedure UnknownVariable;
-    Procedure ReadWrongType;
-    procedure WriteWrongType;
-    Procedure DoDummy(var Result: TFPExpressionResult; Const Args: TExprParameterArray);
-  Published
-    Procedure TestVariableAssign;
-    Procedure TestVariableAssignAgain;
-    Procedure TestVariable1;
-    procedure TestVariable2;
-    procedure TestVariable3;
-    procedure TestVariable4;
-    procedure TestVariable5;
-    procedure TestVariable6;
-    procedure TestVariable7;
-    procedure TestVariable8;
-    procedure TestVariable9;
-    procedure TestVariable10;
-    procedure TestVariable11;
-    procedure TestVariable12;
-    procedure TestVariable13;
-    procedure TestVariable14;
-    procedure TestVariable15;
-    procedure TestVariable16;
-    procedure TestVariable17;
-    procedure TestVariable18;
-    procedure TestVariable19;
-    procedure TestVariable20;
-    procedure TestVariable21;
-    procedure TestVariable22;
-    procedure TestVariable23;
-    procedure TestVariable24;
-    procedure TestVariable25;
-    procedure TestVariable26;
-    procedure TestVariable27;
-    procedure TestVariable28;
-    procedure TestVariable29;
-    procedure TestVariable30;
-    procedure TestVariable31;
-    procedure TestVariable32;
-    procedure TestVariable33;
-    procedure TestVariable34;
-    procedure TestVariable35;
-    procedure TestVariable36;
-    Procedure TestGetIdentifierNames;
-    Procedure TestGetIdentifierNamesCallback;
-    Procedure TestGetIdentifierNamesDouble;
-    Procedure TestGetIdentifierNamesDoubleCallback;
-  end;
-
-  { TTestParserFunctions }
-  TTestParserFunctions = Class(TTestExpressionParser)
-  private
-    FAccessAs : TResultType;
-    procedure ExprAveOf(var Result: TFPExpressionResult; const Args: TExprParameterArray);
-    procedure ExprMaxOf(var Result: TFPExpressionResult; const Args: TExprParameterArray);
-    procedure ExprMinOf(var Result: TFPExpressionResult; const Args: TExprParameterArray);
-    procedure ExprStdDevOf(var Result: TFPExpressionResult; const Args: TExprParameterArray);
-    procedure ExprSumOf(var Result: TFPExpressionResult; const Args: TExprParameterArray);
-    Procedure TryRead;
-    procedure TryWrite;
-  Published
-    Procedure TestFunction1;
-    procedure TestFunction2;
-    procedure TestFunction3;
-    procedure TestFunction4;
-    procedure TestFunction5;
-    procedure TestFunction6;
-    procedure TestFunction7;
-    procedure TestFunction8;
-    procedure TestFunction9;
-    procedure TestFunction10;
-    procedure TestFunction11;
-    procedure TestFunction12;
-    procedure TestFunction13;
-    procedure TestFunction14;
-    procedure TestFunction15;
-    procedure TestFunction16;
-    procedure TestFunction17;
-    procedure TestFunction18;
-    procedure TestFunction19;
-    procedure TestFunction20;
-    procedure TestFunction21;
-    procedure TestFunction22;
-    procedure TestFunction23;
-    procedure TestFunction24;
-    procedure TestFunction25;
-    procedure TestFunction26;
-    procedure TestFunction27;
-    procedure TestFunction28;
-    procedure TestFunction29;
-    procedure TestFunction30;
-    procedure TestFunction31;
-    procedure TestFunction32;
-    procedure TestFunction33;
-    procedure TestVarArgs1;
-    procedure TestVarArgs2;
-    procedure TestVarArgs3;
-    procedure TestVarArgs4;
-    procedure TestVarArgs5;
-  end;
-
-
-
-
-  { TAggregateNode }
-
-  TAggregateNode = Class(TFPExprNode)
-  Public
-    InitCount : Integer;
-    UpdateCount : Integer;
-    Class Function IsAggregate: Boolean; override;
-    Function NodeType: TResultType; override;
-    Procedure InitAggregate; override;
-    Procedure UpdateAggregate; override;
-    procedure GetNodeValue(var Result: TFPExpressionResult); override;
-  end;
-
-  { TTestParserAggregate }
-
-  TTestParserAggregate = Class(TTestExpressionParser)
-  private
-    FVarValue : Integer;
-    FLeft : TAggregateNode;
-    FRight : TAggregateNode;
-    FFunction : TFPExprIdentifierDef;
-    FFunction2 : TFPExprIdentifierDef;
-  Protected
-    Procedure Setup; override;
-    Procedure TearDown; override;
-  public
-    procedure GetVar(var Result: TFPExpressionResult; ConstRef AName: ShortString);
-  Published
-    Procedure TestIsAggregate;
-    Procedure TestHasAggregate;
-    Procedure TestBinaryAggregate;
-    Procedure TestUnaryAggregate;
-    Procedure TestCountAggregate;
-    Procedure TestSumAggregate;
-    Procedure TestSumAggregate2;
-    Procedure TestSumAggregate3;
-    Procedure TestAvgAggregate;
-    Procedure TestAvgAggregate2;
-    Procedure TestAvgAggregate3;
-  end;
-  { TTestBuiltinsManager }
-
-  TTestBuiltinsManager = Class(TTestExpressionParser)
-  private
-    FM : TExprBuiltInManager;
-  Protected
-    procedure Setup; override;
-    procedure Teardown; override;
-  Published
-    procedure TestCreate;
-    procedure TestVariable1;
-    procedure TestVariable2;
-    procedure TestVariable3;
-    procedure TestVariable4;
-    procedure TestVariable5;
-    procedure TestVariable6;
-    procedure TestVariable7;
-    procedure TestFunction1;
-    procedure TestFunction2;
-    procedure TestDelete;
-    procedure TestRemove;
-  end;
-
-  TTestBuiltins = Class(TTestExpressionParser)
-  private
-    FValue : Integer;
-    FM : TExprBuiltInManager;
-    FExpr : String;
-    procedure DoAverage(Var Result : TFPExpressionResult; ConstRef AName : ShortString);
-    procedure DoSeries(var Result: TFPExpressionResult; ConstRef AName: ShortString);
-  Protected
-    procedure Setup; override;
-    procedure Teardown; override;
-    Procedure SetExpression(Const AExpression : String);
-    Procedure AssertVariable(Const ADefinition : String; AResultType : TResultType);
-    Procedure AssertFunction(Const ADefinition,AResultType,ArgumentTypes : String; ACategory : TBuiltinCategory);
-    procedure AssertExpression(Const AExpression : String; AResult : Int64);
-    procedure AssertExpression(Const AExpression : String; Const AResult : String);
-    procedure AssertExpression(Const AExpression : String; Const AResult : TExprFloat);
-    procedure AssertExpression(Const AExpression : String; Const AResult : Boolean);
-    procedure AssertDateTimeExpression(Const AExpression : String; Const AResult : TDateTime);
-    procedure AssertAggregateExpression(Const AExpression : String; AResult : Int64; AUpdateCount : integer);
-    procedure AssertAggregateExpression(Const AExpression : String; AResult : TExprFloat; AUpdateCount : integer);
-    procedure AssertAggregateCurrExpression(Const AExpression : String; AResult : Currency; AUpdateCount : integer);
-  Published
-    procedure TestRegister;
-    Procedure TestVariablepi;
-    Procedure TestFunctioncos;
-    Procedure TestFunctionsin;
-    Procedure TestFunctionarctan;
-    Procedure TestFunctionabs;
-    Procedure TestFunctionsqr;
-    Procedure TestFunctionsqrt;
-    Procedure TestFunctionexp;
-    Procedure TestFunctionln;
-    Procedure TestFunctionlog;
-    Procedure TestFunctionfrac;
-    Procedure TestFunctionint;
-    Procedure TestFunctionround;
-    Procedure TestFunctiontrunc;
-    Procedure TestFunctionlength;
-    Procedure TestFunctioncopy;
-    Procedure TestFunctiondelete;
-    Procedure TestFunctionpos;
-    Procedure TestFunctionlowercase;
-    Procedure TestFunctionuppercase;
-    Procedure TestFunctionstringreplace;
-    Procedure TestFunctioncomparetext;
-    Procedure TestFunctiondate;
-    Procedure TestFunctiontime;
-    Procedure TestFunctionnow;
-    Procedure TestFunctiondayofweek;
-    Procedure TestFunctionextractyear;
-    Procedure TestFunctionextractmonth;
-    Procedure TestFunctionextractday;
-    Procedure TestFunctionextracthour;
-    Procedure TestFunctionextractmin;
-    Procedure TestFunctionextractsec;
-    Procedure TestFunctionextractmsec;
-    Procedure TestFunctionencodedate;
-    Procedure TestFunctionencodetime;
-    Procedure TestFunctionencodedatetime;
-    Procedure TestFunctionshortdayname;
-    Procedure TestFunctionshortmonthname;
-    Procedure TestFunctionlongdayname;
-    Procedure TestFunctionlongmonthname;
-    Procedure TestFunctionformatdatetime;
-    Procedure TestFunctionshl;
-    Procedure TestFunctionshr;
-    Procedure TestFunctionIFS;
-    Procedure TestFunctionIFF;
-    Procedure TestFunctionIFD;
-    Procedure TestFunctionIFI;
-    Procedure TestFunctioninttostr;
-    Procedure TestFunctionstrtoint;
-    Procedure TestFunctionstrtointdef;
-    Procedure TestFunctionfloattostr;
-    Procedure TestFunctionstrtofloat;
-    Procedure TestFunctionstrtofloatdef;
-    Procedure TestFunctionbooltostr;
-    Procedure TestFunctionstrtobool;
-    Procedure TestFunctionstrtobooldef;
-    Procedure TestFunctiondatetostr;
-    Procedure TestFunctiontimetostr;
-    Procedure TestFunctionstrtodate;
-    Procedure TestFunctionstrtodatedef;
-    Procedure TestFunctionstrtotime;
-    Procedure TestFunctionstrtotimedef;
-    Procedure TestFunctionstrtodatetime;
-    Procedure TestFunctionstrtodatetimedef;
-    Procedure TestFunctionAggregateSum;
-    Procedure TestFunctionAggregateSumFloat;
-    Procedure TestFunctionAggregateSumCurrency;
-    Procedure TestFunctionAggregateCount;
-    Procedure TestFunctionAggregateAvg;
-    Procedure TestFunctionAggregateMin;
-    Procedure TestFunctionAggregateMax;
-  end;
-
-implementation
-
-uses typinfo;
-
-var
-  FileFormatSettings: TFormatSettings;
-
-{ TTestParserAggregate }
-
-procedure TTestParserAggregate.Setup;
-begin
-  inherited Setup;
-  FVarValue:=0;
-  FFunction:=TFPExprIdentifierDef.Create(Nil);
-  FFunction.Name:='Count';
-  FFunction2:=TFPExprIdentifierDef.Create(Nil);
-  FFunction2.Name:='MyVar';
-  FFunction2.ResultType:=rtInteger;
-  FFunction2.IdentifierType:=itVariable;
-  FFunction2.OnGetVariableValue:=@GetVar;
-  FLeft:=TAggregateNode.Create;
-  FRight:=TAggregateNode.Create;
-end;
-
-procedure TTestParserAggregate.TearDown;
-begin
-  FreeAndNil(FFunction);
-  FreeAndNil(FLeft);
-  FreeAndNil(FRight);
-  inherited TearDown;
-end;
-
-procedure TTestParserAggregate.GetVar(var Result: TFPExpressionResult; ConstRef
-  AName: ShortString);
-begin
-  Result.ResultType:=FFunction2.ResultType;
-  Case Result.ResultType of
-    rtInteger : Result.ResInteger:=FVarValue;
-    rtFloat : Result.ResFloat:=FVarValue / 2;
-    rtCurrency : Result.ResCurrency:=FVarValue / 2;
-  end;
-end;
-
-procedure TTestParserAggregate.TestIsAggregate;
-begin
-  AssertEquals('ExprNode',False,TFPExprNode.IsAggregate);
-  AssertEquals('TAggregateExpr',True,TAggregateExpr.IsAggregate);
-  AssertEquals('TAggregateExpr',False,TFPBinaryOperation.IsAggregate);
-end;
-
-procedure TTestParserAggregate.TestHasAggregate;
-
-Var
-  N :  TFPExprNode;
-
-begin
-  N:=TFPExprNode.Create;
-  try
-    AssertEquals('ExprNode',False,N.HasAggregate);
-  finally
-    N.Free;
-  end;
-  N:=TAggregateExpr.Create;
-  try
-    AssertEquals('ExprNode',True,N.HasAggregate);
-  finally
-    N.Free;
-  end;
-end;
-
-procedure TTestParserAggregate.TestBinaryAggregate;
-
-Var
-  B :  TFPBinaryOperation;
-
-begin
-  B:=TFPBinaryOperation.Create(Fleft,TFPConstExpression.CreateInteger(1));
-  try
-    FLeft:=Nil;
-    AssertEquals('Binary',True,B.HasAggregate);
-  finally
-    B.Free;
-  end;
-  B:=TFPBinaryOperation.Create(TFPConstExpression.CreateInteger(1),FRight);
-  try
-    FRight:=Nil;
-    AssertEquals('Binary',True,B.HasAggregate);
-  finally
-    B.Free;
-  end;
-end;
-
-procedure TTestParserAggregate.TestUnaryAggregate;
-Var
-  B : TFPUnaryOperator;
-
-begin
-  B:=TFPUnaryOperator.Create(Fleft);
-  try
-    FLeft:=Nil;
-    AssertEquals('Unary',True,B.HasAggregate);
-  finally
-    B.Free;
-  end;
-end;
-
-procedure TTestParserAggregate.TestCountAggregate;
-
-Var
-  C : TAggregateCount;
-  I : Integer;
-  R : TFPExpressionResult;
-
-begin
-  FFunction.ResultType:=rtInteger;
-  FFunction.ParameterTypes:='';
-  C:=TAggregateCount.CreateFunction(FFunction,Nil);
-  try
-    C.Check;
-    C.InitAggregate;
-    For I:=1 to 11 do
-      C.UpdateAggregate;
-    C.GetNodeValue(R);
-    AssertEquals('Correct type',rtInteger,R.ResultType);
-    AssertEquals('Correct value',11,R.ResInteger);
-  finally
-    C.Free;
-  end;
-end;
-
-procedure TTestParserAggregate.TestSumAggregate;
-
-Var
-  C : TAggregateSum;
-  V : TFPExprVariable;
-  I : Integer;
-  R : TFPExpressionResult;
-  A : TExprArgumentArray;
-
-begin
-  FFunction.ResultType:=rtInteger;
-  FFunction.ParameterTypes:='I';
-  FFunction.Name:='SUM';
-  FFunction2.ResultType:=rtInteger;
-  C:=Nil;
-  V:=TFPExprVariable.CreateIdentifier(FFunction2);
-  try
-    SetLength(A,1);
-    A[0]:=V;
-    C:=TAggregateSum.CreateFunction(FFunction,A);
-    C.Check;
-    C.InitAggregate;
-    For I:=1 to 10 do
-      begin
-      FVarValue:=I;
-      C.UpdateAggregate;
-      end;
-    C.GetNodeValue(R);
-    AssertEquals('Correct type',rtInteger,R.ResultType);
-    AssertEquals('Correct value',55,R.ResInteger);
-  finally
-    C.Free;
-  end;
-end;
-
-procedure TTestParserAggregate.TestSumAggregate2;
-Var
-  C : TAggregateSum;
-  V : TFPExprVariable;
-  I : Integer;
-  R : TFPExpressionResult;
-  A : TExprArgumentArray;
-
-begin
-  FFunction.ResultType:=rtFloat;
-  FFunction.ParameterTypes:='F';
-  FFunction.Name:='SUM';
-  FFunction2.ResultType:=rtFloat;
-  C:=Nil;
-  V:=TFPExprVariable.CreateIdentifier(FFunction2);
-  try
-    SetLength(A,1);
-    A[0]:=V;
-    C:=TAggregateSum.CreateFunction(FFunction,A);
-    C.Check;
-    C.InitAggregate;
-    For I:=1 to 10 do
-      begin
-      FVarValue:=I;
-      C.UpdateAggregate;
-      end;
-    C.GetNodeValue(R);
-    AssertEquals('Correct type',rtFloat,R.ResultType);
-    AssertEquals('Correct value',55/2,R.ResFloat,0.1);
-  finally
-    C.Free;
-  end;
-end;
-
-procedure TTestParserAggregate.TestSumAggregate3;
-Var
-  C : TAggregateSum;
-  V : TFPExprVariable;
-  I : Integer;
-  R : TFPExpressionResult;
-  A : TExprArgumentArray;
-
-begin
-  FFunction.ResultType:=rtCurrency;
-  FFunction.ParameterTypes:='F';
-  FFunction.Name:='SUM';
-  FFunction2.ResultType:=rtCurrency;
-  C:=Nil;
-  V:=TFPExprVariable.CreateIdentifier(FFunction2);
-  try
-    SetLength(A,1);
-    A[0]:=V;
-    C:=TAggregateSum.CreateFunction(FFunction,A);
-    C.Check;
-    C.InitAggregate;
-    For I:=1 to 10 do
-      begin
-      FVarValue:=I;
-      C.UpdateAggregate;
-      end;
-    C.GetNodeValue(R);
-    AssertEquals('Correct type',rtCurrency,R.ResultType);
-    AssertEquals('Correct value',55/2,R.ResCurrency,0.1);
-  finally
-    C.Free;
-  end;
-end;
-
-procedure TTestParserAggregate.TestAvgAggregate;
-
-Var
-  C : TAggregateAvg;
-  V : TFPExprVariable;
-  I : Integer;
-  R : TFPExpressionResult;
-  A : TExprArgumentArray;
-
-begin
-  FFunction.ResultType:=rtInteger;
-  FFunction.ParameterTypes:='F';
-  FFunction.Name:='AVG';
-  FFunction2.ResultType:=rtInteger;
-  C:=Nil;
-  V:=TFPExprVariable.CreateIdentifier(FFunction2);
-  try
-    SetLength(A,1);
-    A[0]:=V;
-    C:=TAggregateAvg.CreateFunction(FFunction,A);
-    C.Check;
-    C.InitAggregate;
-    For I:=1 to 10 do
-      begin
-      FVarValue:=I;
-      C.UpdateAggregate;
-      end;
-    C.GetNodeValue(R);
-    AssertEquals('Correct type',rtFloat,R.ResultType);
-    AssertEquals('Correct value',5.5,R.ResFloat,0.1);
-  finally
-    C.Free;
-  end;
-end;
-
-procedure TTestParserAggregate.TestAvgAggregate2;
-
-Var
-  C : TAggregateAvg;
-  V : TFPExprVariable;
-  I : Integer;
-  R : TFPExpressionResult;
-  A : TExprArgumentArray;
-
-begin
-  FFunction.ResultType:=rtInteger;
-  FFunction.ParameterTypes:='F';
-  FFunction.Name:='AVG';
-  FFunction2.ResultType:=rtFloat;
-  C:=Nil;
-  V:=TFPExprVariable.CreateIdentifier(FFunction2);
-  try
-    SetLength(A,1);
-    A[0]:=V;
-    C:=TAggregateAvg.CreateFunction(FFunction,A);
-    C.Check;
-    C.InitAggregate;
-    For I:=1 to 10 do
-      begin
-      FVarValue:=I;
-      C.UpdateAggregate;
-      end;
-    C.GetNodeValue(R);
-    AssertEquals('Correct type',rtFloat,R.ResultType);
-    AssertEquals('Correct value',5.5/2,R.ResFloat,0.1);
-  finally
-    C.Free;
-  end;
-end;
-
-procedure TTestParserAggregate.TestAvgAggregate3;
-Var
-  C : TAggregateAvg;
-  V : TFPExprVariable;
-  R : TFPExpressionResult;
-  A : TExprArgumentArray;
-
-begin
-  FFunction.ResultType:=rtInteger;
-  FFunction.ParameterTypes:='F';
-  FFunction.Name:='AVG';
-  FFunction2.ResultType:=rtFloat;
-  C:=Nil;
-  V:=TFPExprVariable.CreateIdentifier(FFunction2);
-  try
-    SetLength(A,1);
-    A[0]:=V;
-    C:=TAggregateAvg.CreateFunction(FFunction,A);
-    C.Check;
-    C.InitAggregate;
-    C.GetNodeValue(R);
-    AssertEquals('Correct type',rtFloat,R.ResultType);
-    AssertEquals('Correct value',0.0,R.ResFloat,0.1);
-  finally
-    C.Free;
-  end;
-end;
-
-{ TAggregateNode }
-
-class function TAggregateNode.IsAggregate: Boolean;
-begin
-  Result:=True
-end;
-
-function TAggregateNode.NodeType: TResultType;
-begin
-  Result:=rtInteger;
-end;
-
-procedure TAggregateNode.InitAggregate;
-begin
-  inherited InitAggregate;
-  inc(InitCount)
-end;
-
-procedure TAggregateNode.UpdateAggregate;
-begin
-  inherited UpdateAggregate;
-  inc(UpdateCount);
-end;
-
-procedure TAggregateNode.GetNodeValue(var Result: TFPExpressionResult);
-begin
-  Result.ResultType:=rtInteger;
-  Result.ResInteger:=updateCount;
-end;
-
-procedure TTestExpressionScanner.TestCreate;
-begin
-  AssertEquals('Empty source','',FP.Source);
-  AssertEquals('Pos is zero',0,FP.Pos);
-  AssertEquals('CurrentChar is zero',#0,FP.CurrentChar);
-  AssertEquals('Current token type is EOF',ttEOF,FP.TokenType);
-  AssertEquals('Current token is empty','',FP.Token);
-end;
-
-procedure TTestExpressionScanner.TestSetSource;
-begin
-  FP.Source:='Abc';
-  FP.Source:='';
-  AssertEquals('Empty source','',FP.Source);
-  AssertEquals('Pos is zero',0,FP.Pos);
-  AssertEquals('CurrentChar is zero',#0,FP.CurrentChar);
-  AssertEquals('Current token type is EOF',ttEOF,FP.TokenType);
-  AssertEquals('Current token is empty','',FP.Token);
-end;
-
-procedure TTestExpressionScanner.TestWhiteSpace;
-begin
-  TestString('  ',ttEOF);
-end;
-
-procedure TTestExpressionScanner.TestTokens;
-
-Const
-  TestStrings : Array[TTokenType] of  String
-  (*
-  TTokenType = (ttPlus, ttMinus, ttLessThan, ttLargerThan, ttEqual, ttDiv,
-                ttMod, ttMul, ttLeft, ttRight, ttLessThanEqual,
-                ttLargerThanEqual, ttunequal, ttNumber, ttString, ttIdentifier,
-                ttComma, ttAnd, ttOr, ttXor, ttTrue, ttFalse, ttNot, ttif,
-                ttCase, ttPower, ttEOF); // keep ttEOF last
-
-  *)
-    = ('+','-','<','>','=','/',
-       'mod','*','(',')','<=',
-       '>=', '<>','1','''abc''','abc',
-       ',','and', 'or','xor','true','false','not',
-       'if','case','^','');
-
-var
-  t : TTokenType;
-
-begin
-  For T:=Low(TTokenType) to High(TTokenType) do
-    TestString(TestStrings[t],t);
-end;
-
-procedure TTestExpressionScanner.TestInvalidNumber;
-
-begin
-  TestString(FInvalidString,ttNumber);
-end;
-
-procedure TTestExpressionScanner.DoInvalidNumber(AString : String);
-
-begin
-  FInvalidString:=AString;
-  AssertException('Invalid number "'+AString+'" ',EExprScanner,@TestInvalidNumber);
-end;
-
-procedure TTestExpressionScanner.TestNumber;
-begin
-  TestString('123',ttNumber);
-  TestString('$FF',ttNumber);
-  TestString('&77',ttNumber);
-  TestString('%11111111',ttNumber);
-  TestString('123.4',ttNumber);
-  TestString('123.E4',ttNumber);
-  TestString('1.E4',ttNumber);
-  TestString('1e-2',ttNumber);
-  DoInValidNumber('$GG');
-  DoInvalidNumber('&88');
-  DoInvalidNumber('%22');
-  DoInvalidNumber('1..1');
-  DoInvalidNumber('1.E--1');
-//  DoInvalidNumber('.E-1');
-end;
-
-
-procedure TTestExpressionScanner.TestInvalidCharacter;
-begin
-  DoInvalidNumber('~');
-  DoInvalidNumber('#');
-  DoInvalidNumber('$');
-end;
-
-procedure TTestExpressionScanner.TestUnterminatedString;
-begin
-  DoInvalidNumber('''abc');
-end;
-
-procedure TTestExpressionScanner.TestQuotesInString;
-begin
-  TestString('''That''''s it''',ttString);
-  TestString('''''''s it''',ttString);
-  TestString('''s it''''''',ttString);
-end;
-
-procedure TTestExpressionScanner.TestIdentifier(Const ASource,ATokenName : String);
-
-begin
-  FP.Source:=ASource;
-  AssertEquals('Token type',ttIdentifier,FP.GetToken);
-  AssertEquals('Token name',ATokenName,FP.Token);
-end;
-
-procedure TTestExpressionScanner.TestIdentifiers;
-begin
-  TestIdentifier('a','a');
-  TestIdentifier(' a','a');
-  TestIdentifier('a ','a');
-  TestIdentifier('a^b','a');
-  TestIdentifier('a-b','a');
-  TestIdentifier('a.b','a.b');
-  TestIdentifier('"a b"','a b');
-  TestIdentifier('c."a b"','c.a b');
-  TestIdentifier('c."ab"','c.ab');
-end;
-
-procedure TTestExpressionScanner.SetUp; 
-begin
-  FP:=TFPExpressionScanner.Create;
-end;
-
-procedure TTestExpressionScanner.TearDown; 
-begin
-  FreeAndNil(FP);
-end;
-
-procedure TTestExpressionScanner.AssertEquals(Msg: String; AExpected,
-  AActual: TTokenType);
-
-Var
-  S1,S2 : String;
-
-begin
-  S1:=TokenName(AExpected);
-  S2:=GetEnumName(TypeInfo(TTokenType),Ord(AActual));
-  AssertEquals(Msg,S1,S2);
-end;
-
-procedure TTestExpressionScanner.TestString(const AString: String;
-  AToken: TTokenType);
-begin
-  FP.Source:=AString;
-  AssertEquals('String "'+AString+'" results in token '+TokenName(AToken),AToken,FP.GetToken);
-  If Not (FP.TokenType in [ttString,ttEOF]) then
-    AssertEquals('String "'+AString+'" results in token string '+TokenName(AToken),AString,FP.Token)
-  else if FP.TokenType=ttString then
-    AssertEquals('String "'+AString+'" results in token string '+TokenName(AToken),
-                  StringReplace(AString,'''''','''',[rfreplaceAll]),
-                  ''''+FP.Token+'''');
-end;
-
-{ TTestBaseParser }
-
-procedure TTestBaseParser.DoCheck;
-begin
-  FCheckNode.Check;
-end;
-
-procedure TTestBaseParser.AssertNodeType(Msg: String; AClass: TClass;
-  ANode: TFPExprNode);
-begin
-  AssertNotNull(Msg+': Not null',ANode);
-  AssertEquals(Msg+': Class OK',AClass,ANode.ClassType);
-end;
-
-procedure TTestBaseParser.AssertEquals(Msg: String; AResultType: TResultType;
-  ANode: TFPExprNode);
-begin
-  AssertNotNull(Msg+': Node not null',ANode);
-  AssertEquals(Msg,AResultType,Anode.NodeType);
-end;
-
-procedure TTestBaseParser.AssertEquals(Msg: String; AExpected,
-  AActual: TResultType);
-
-begin
-  AssertEquals(Msg,ResultTypeName(AExpected),ResultTypeName(AActual));
-end;
-
-function TTestBaseParser.CreateIntNode(AInteger: Integer): TFPExprNode;
-begin
-  Result:=TFPConstExpression.CreateInteger(AInteger);
-end;
-
-function TTestBaseParser.CreateFloatNode(AFloat: TExprFloat): TFPExprNode;
-begin
-  Result:=TFPConstExpression.CreateFloat(AFloat);
-end;
-
-function TTestBaseParser.CreateStringNode(Astring: String): TFPExprNode;
-begin
-  Result:=TFPConstExpression.CreateString(AString);
-end;
-
-function TTestBaseParser.CreateDateTimeNode(ADateTime: TDateTime): TFPExprNode;
-begin
-  Result:=TFPConstExpression.CreateDateTime(ADateTime);
-end;
-
-procedure TTestBaseParser.AssertNodeOK(FN: TFPExprNode);
-
-Var
-  B : Boolean;
-  Msg : String;
-
-begin
-  AssertNotNull('Node to test OK',FN);
-  B:=False;
-  try
-    FN.Check;
-    B:=True;
-  except
-    On E : Exception do
-      Msg:=E.Message;
-  end;
-  If Not B then
-    Fail(Format('Node %s not OK: %s',[FN.ClassName,Msg]));
-end;
-
-procedure TTestBaseParser.AssertNodeNotOK(const MSg : String; FN: TFPExprNode);
-begin
-  FCheckNode:=FN;
-  AssertException(Msg,EExprParser,@DoCheck);
-end;
-
-function TTestBaseParser.CreateBoolNode(ABoolean: Boolean): TFPExprNode;
-begin
-  Result:=TFPConstExpression.CreateBoolean(ABoolean);
-end;
-
-procedure TTestBaseParser.Setup;
-begin
-  inherited Setup;
-  FDestroyCalled:=0;
-end;
-
-
-{ TTestConstExprNode }
-
-procedure TTestConstExprNode.TearDown;
-begin
-  FreeAndNil(FN);
-  inherited TearDown;
-end;
-
-procedure TTestConstExprNode.TestCreateInteger;
-begin
-  FN:=TFPConstExpression.CreateInteger(1);
-  AssertEquals('Correct type',rtInteger,FN.NodeType);
-  AssertEquals('Correct result',1,FN.ConstValue.ResInteger);
-  AssertEquals('Correct result',1,FN.NodeValue.ResInteger);
-  AssertEquals('AsString ok','1',FN.AsString);
-end;
-
-procedure TTestConstExprNode.TestCreateFloat;
-
-Var
-  F : Double;
-  C : Integer;
-
-begin
-  FN:=TFPConstExpression.CreateFloat(2.34);
-  AssertEquals('Correct type',rtFloat,FN.NodeType);
-  AssertEquals('Correct result',2.34,FN.ConstValue.ResFloat);
-  AssertEquals('Correct result',2.34,FN.NodeValue.ResFloat);
-  Val(FN.AsString,F,C);
-  AssertEquals('Correct conversion',0,C);
-  AssertEquals('AsString ok',2.34,F,0.001);
-end;
-
-procedure TTestConstExprNode.TestCreateBoolean;
-begin
-  FN:=TFPConstExpression.CreateBoolean(True);
-  AssertEquals('Correct type',rtBoolean,FN.NodeType);
-  AssertEquals('Correct result',True,FN.ConstValue.ResBoolean);
-  AssertEquals('Correct result',True,FN.NodeValue.ResBoolean);
-  AssertEquals('AsString ok','True',FN.AsString);
-  FreeAndNil(FN);
-  FN:=TFPConstExpression.CreateBoolean(False);
-  AssertEquals('AsString ok','False',FN.AsString);
-end;
-
-procedure TTestConstExprNode.TestCreateDateTime;
-
-Var
-  D : TDateTime;
-  S : String;
-
-begin
-  D:=Now;
-  FN:=TFPConstExpression.CreateDateTime(D);
-  AssertEquals('Correct type',rtDateTime,FN.NodeType);
-  AssertEquals('Correct result',D,FN.ConstValue.ResDateTime);
-  AssertEquals('Correct result',D,FN.NodeValue.ResDateTime);
-  S:=''''+FormatDateTime('cccc',D)+'''';
-  AssertEquals('AsString ok',S,FN.AsString);
-end;
-
-procedure TTestConstExprNode.TestCreateString;
-
-Var
-  S : String;
-
-begin
-  S:='Ohlala';
-  FN:=TFPConstExpression.CreateString(S);
-  AssertEquals('Correct type',rtString,FN.NodeType);
-  AssertEquals('Correct result',S,FN.ConstValue.ResString);
-  AssertEquals('Correct result',S,FN.NodeValue.ResString);
-  AssertEquals('AsString ok',''''+S+'''',FN.AsString);
-end;
-
-{ TTestNegateExprNode }
-
-procedure TTestNegateExprNode.TearDown;
-begin
-  FreeAndNil(FN);
-  inherited TearDown;
-end;
-
-procedure TTestNegateExprNode.TestCreateInteger;
-
-begin
-  FN:=TFPNegateOperation.Create(CreateIntNode(23));
-  AssertEquals('Negate has correct type',rtInteger,FN.NodeType);
-  AssertEquals('Negate has correct result',-23,FN.NodeValue.Resinteger);
-  AssertEquals('Negate has correct string','-23',FN.AsString);
-  AssertNodeOK(FN);
-end;
-
-
-procedure TTestNegateExprNode.TestCreateFloat;
-
-Var
-  S : String;
-
-begin
-  FN:=TFPNegateOperation.Create(CreateFloatNode(1.23));
-  AssertEquals('Negate has correct type',rtFloat,FN.NodeType);
-  AssertEquals('Negate has correct result',-1.23,FN.NodeValue.ResFloat);
-  Str(TExprFloat(-1.23),S);
-  AssertEquals('Negate has correct string',S,FN.AsString);
-  AssertNodeOK(FN);
-end;
-
-procedure TTestNegateExprNode.TestCreateOther1;
-
-begin
-  FN:=TFPNegateOperation.Create(TFPConstExpression.CreateString('1.23'));
-  AssertNodeNotOK('Negate does not accept string',FN);
-end;
-
-procedure TTestNegateExprNode.TestCreateOther2;
-
-begin
-  FN:=TFPNegateOperation.Create(TFPConstExpression.CreateBoolean(True));
-  AssertNodeNotOK('Negate does not accept boolean',FN)
-end;
-
-procedure TTestNegateExprNode.TestDestroy;
-begin
-  FN:=TFPNegateOperation.Create(TMyDestroyNode.CreateTest(Self));
-  FreeAndNil(FN);
-  AssertEquals('Operand Destroy called',1,self.FDestroyCalled)
-end;
-
-{ TTestDestroyNode }
-
-procedure TTestDestroyNode.TestDestroy;
-
-Var
-  FN : TMyDestroyNode;
-
-begin
-  AssertEquals('Destroy not called yet',0,self.FDestroyCalled);
-  FN:=TMyDestroyNode.CreateTest(Self);
-  FN.Free;
-  AssertEquals('Destroy called',1,self.FDestroyCalled)
-end;
-
-{ TMyDestroyNode }
-
-constructor TMyDestroyNode.CreateTest(ATest: TTestBaseParser);
-begin
-  FTest:=ATest;
-  Inherited CreateInteger(1);
-end;
-
-destructor TMyDestroyNode.Destroy;
-begin
-  Inc(FTest.FDestroyCalled);
-  inherited Destroy;
-end;
-
-{ TTestBinaryAndNode }
-
-procedure TTestBinaryAndNode.TearDown;
-begin
-  FreeAndNil(FN);
-  inherited TearDown;
-end;
-
-procedure TTestBinaryAndNode.TestCreateInteger;
-begin
-  FN:=TFPBinaryAndOperation.Create(CreateIntNode(3),CreateIntNode(2));
-  AssertNodeOK(FN);
-  AssertEquals('Correct node type',rtInteger,FN.NodeType);
-  AssertEquals('Correct result',2,FN.NodeValue.ResInteger);
-end;
-
-procedure TTestBinaryAndNode.TestCreateBoolean;
-begin
-  FN:=TFPBinaryAndOperation.Create(CreateBoolNode(True),CreateBoolNode(True));
-  AssertNodeOK(FN);
-  AssertEquals('Correct node type',rtBoolean,FN.NodeType);
-  AssertEquals('Correct result',True,FN.NodeValue.ResBoolean);
-end;
-
-procedure TTestBinaryAndNode.TestCreateBooleanInteger;
-begin
-  FN:=TFPBinaryAndOperation.Create(CreateBoolNode(True),CreateIntNode(0));
-  AssertNodeNotOK('Different node types',FN);
-end;
-
-procedure TTestBinaryAndNode.TestCreateString;
-begin
-  FN:=TFPBinaryAndOperation.Create(CreateStringNode('True'),CreateStringNode('True'));
-  AssertNodeNotOK('String node type',FN);
-end;
-
-procedure TTestBinaryAndNode.TestCreateFloat;
-begin
-  FN:=TFPBinaryAndOperation.Create(CreateFloatNode(1.23),CreateFloatNode(1.23));
-  AssertNodeNotOK('float node type',FN);
-end;
-
-procedure TTestBinaryAndNode.TestCreateDateTime;
-begin
-  FN:=TFPBinaryAndOperation.Create(CreateDateTimeNode(Now),CreateDateTimeNode(Now));
-  AssertNodeNotOK('DateTime node type',FN);
-end;
-
-procedure TTestBinaryAndNode.TestDestroy;
-begin
-  FN:=TFPBinaryAndOperation.Create(TMyDestroyNode.CreateTest(Self),TMyDestroyNode.CreateTest(Self));
-  FreeAndNil(FN);
-  AssertEquals('Destroy called for left and right nodes',2,self.FDestroyCalled)
-end;
-
-{ TTestBinaryOrNode }
-
-procedure TTestBinaryOrNode.TearDown;
-begin
-  FreeAndNil(FN);
-  inherited TearDown;
-end;
-
-procedure TTestBinaryOrNode.TestCreateInteger;
-begin
-  FN:=TFPBinaryOrOperation.Create(CreateIntNode(1),CreateIntNode(2));
-  AssertNodeOK(FN);
-  AssertEquals('Correct node type',rtInteger,FN.NodeType);
-  AssertEquals('Correct result',3,FN.NodeValue.ResInteger);
-end;
-
-procedure TTestBinaryOrNode.TestCreateBoolean;
-begin
-  FN:=TFPBinaryOrOperation.Create(CreateBoolNode(True),CreateBoolNode(False));
-  AssertNodeOK(FN);
-  AssertEquals('Correct node type',rtBoolean,FN.NodeType);
-  AssertEquals('Correct result',True,FN.NodeValue.ResBoolean);
-end;
-
-procedure TTestBinaryOrNode.TestCreateBooleanInteger;
-begin
-  FN:=TFPBinaryOrOperation.Create(CreateBoolNode(True),CreateIntNode(0));
-  AssertNodeNotOK('Different node types',FN);
-end;
-
-procedure TTestBinaryOrNode.TestCreateString;
-begin
-  FN:=TFPBinaryOrOperation.Create(CreateStringNode('True'),CreateStringNode('True'));
-  AssertNodeNotOK('String node type',FN);
-end;
-
-procedure TTestBinaryOrNode.TestCreateFloat;
-begin
-  FN:=TFPBinaryOrOperation.Create(CreateFloatNode(1.23),CreateFloatNode(1.23));
-  AssertNodeNotOK('float node type',FN);
-end;
-
-procedure TTestBinaryOrNode.TestCreateDateTime;
-begin
-  FN:=TFPBinaryOrOperation.Create(CreateDateTimeNode(Now),CreateDateTimeNode(Now));
-  AssertNodeNotOK('DateTime node type',FN);
-end;
-
-procedure TTestBinaryOrNode.TestDestroy;
-begin
-  FN:=TFPBinaryOrOperation.Create(TMyDestroyNode.CreateTest(Self),TMyDestroyNode.CreateTest(Self));
-  FreeAndNil(FN);
-  AssertEquals('Destroy called for left and right nodes',2,self.FDestroyCalled)
-end;
-
-{ TTestBinaryXorNode }
-
-procedure TTestBinaryXorNode.TearDown;
-begin
-  FreeAndNil(FN);
-  inherited TearDown;
-end;
-
-procedure TTestBinaryXorNode.TestCreateInteger;
-begin
-  FN:=TFPBinaryXorOperation.Create(CreateIntNode(1),CreateIntNode(2));
-  AssertNodeOK(FN);
-  AssertEquals('Correct node type',rtInteger,FN.NodeType);
-  AssertEquals('Correct result',3,FN.NodeValue.ResInteger);
-end;
-
-procedure TTestBinaryXorNode.TestCreateBoolean;
-begin
-  FN:=TFPBinaryXorOperation.Create(CreateBoolNode(True),CreateBoolNode(True));
-  AssertNodeOK(FN);
-  AssertEquals('Correct node type',rtBoolean,FN.NodeType);
-  AssertEquals('Correct result',False,FN.NodeValue.ResBoolean);
-end;
-
-procedure TTestBinaryXorNode.TestCreateBooleanInteger;
-begin
-  FN:=TFPBinaryXorOperation.Create(CreateBoolNode(True),CreateIntNode(0));
-  AssertNodeNotOK('Different node types',FN);
-end;
-
-procedure TTestBinaryXorNode.TestCreateString;
-begin
-  FN:=TFPBinaryXorOperation.Create(CreateStringNode('True'),CreateStringNode('True'));
-  AssertNodeNotOK('String node type',FN);
-end;
-
-procedure TTestBinaryXorNode.TestCreateFloat;
-begin
-  FN:=TFPBinaryXorOperation.Create(CreateFloatNode(1.23),CreateFloatNode(1.23));
-  AssertNodeNotOK('float node type',FN);
-end;
-
-procedure TTestBinaryXorNode.TestCreateDateTime;
-begin
-  FN:=TFPBinaryXorOperation.Create(CreateDateTimeNode(Now),CreateDateTimeNode(Now));
-  AssertNodeNotOK('DateTime node type',FN);
-end;
-
-procedure TTestBinaryXorNode.TestDestroy;
-begin
-  FN:=TFPBinaryXorOperation.Create(TMyDestroyNode.CreateTest(Self),TMyDestroyNode.CreateTest(Self));
-  FreeAndNil(FN);
-  AssertEquals('Destroy called for left and right nodes',2,self.FDestroyCalled)
-end;
-
-{ TTestBooleanNode }
-
-procedure TTestBooleanNode.TestNode(B: TFPBooleanResultOperation;
-  AResult: Boolean);
-begin
-  AssertEquals(Format('Test %s(%s,%s) result',[B.ClassName,B.Left.AsString,B.Right.AsString]),Aresult,B.NodeValue.resBoolean);
-end;
-
-{ TTestEqualNode }
-
-procedure TTestEqualNode.TearDown;
-begin
-  FreeAndNil(FN);
-  inherited TearDown;
-end;
-
-class function TTestEqualNode.NodeClass: TFPBooleanResultOperationClass;
-begin
-  Result:=TFPEqualOperation;
-end;
-
-class function TTestEqualNode.ExpectedResult: Boolean;
-begin
-  Result:=True
-end;
-
-class function TTestEqualNode.OperatorString: String;
-begin
-  Result:='=';
-end;
-
-procedure TTestEqualNode.TestCreateIntegerEqual;
-begin
-  FN:=NodeClass.Create(CreateIntNode(1),CreateIntNode(1));
-  AssertNodeOk(FN);
-  AssertEquals('Boolean result',rtBoolean,FN.NodeType);
-  TestNode(FN,ExpectedResult);
-end;
-
-procedure TTestEqualNode.TestCreateIntegerUnEqual;
-begin
-  FN:=NodeClass.Create(CreateIntNode(2),CreateIntNode(1));
-  AssertNodeOk(FN);
-  AssertEquals('Boolean result',rtBoolean,FN.NodeType);
-  TestNode(FN,Not ExpectedResult);
-end;
-
-procedure TTestEqualNode.TestCreateFloatEqual;
-begin
-  FN:=NodeClass.Create(CreateFloatNode(1.23),CreateFloatNode(1.23));
-  AssertNodeOk(FN);
-  AssertEquals('Boolean result',rtBoolean,FN.NodeType);
-  TestNode(FN,ExpectedResult);
-end;
-
-procedure TTestEqualNode.TestCreateFloatUnEqual;
-begin
-  FN:=NodeClass.Create(CreateFloatNode(1.23),CreateFloatNode(1.34));
-  AssertNodeOk(FN);
-  AssertEquals('Boolean result',rtBoolean,FN.NodeType);
-  TestNode(FN,Not ExpectedResult);
-end;
-
-procedure TTestEqualNode.TestCreateStringEqual;
-begin
-  FN:=NodeClass.Create(CreateStringNode('now'),CreateStringNode('now'));
-  AssertNodeOk(FN);
-  AssertEquals('Boolean result',rtBoolean,FN.NodeType);
-  TestNode(FN,ExpectedResult);
-end;
-
-procedure TTestEqualNode.TestCreateStringUnEqual;
-begin
-  FN:=NodeClass.Create(CreateStringNode('now'),CreateStringNode('then'));
-  AssertNodeOk(FN);
-  AssertEquals('Boolean result',rtBoolean,FN.NodeType);
-  TestNode(FN,Not ExpectedResult);
-end;
-
-procedure TTestEqualNode.TestCreateBooleanEqual;
-begin
-  FN:=NodeClass.Create(CreateBoolNode(True),CreateBoolNode(True));
-  AssertNodeOk(FN);
-  AssertEquals('Boolean result',rtBoolean,FN.NodeType);
-  TestNode(FN,ExpectedResult);
-end;
-
-procedure TTestEqualNode.TestCreateBooleanUnEqual;
-begin
-  FN:=NodeClass.Create(CreateBoolNode(False),CreateBoolNode(True));
-  AssertNodeOk(FN);
-  AssertEquals('Boolean result',rtBoolean,FN.NodeType);
-  TestNode(FN,Not ExpectedResult);
-end;
-
-procedure TTestEqualNode.TestCreateDateTimeEqual;
-
-Var
-  D : TDateTime;
-
-begin
-  D:=Now;
-  FN:=NodeClass.Create(CreateDateTimeNode(D),CreateDateTimeNode(D));
-  AssertNodeOk(FN);
-  AssertEquals('Boolean result',rtBoolean,FN.NodeType);
-  TestNode(FN,ExpectedResult);
-end;
-
-procedure TTestEqualNode.TestCreateDateTimeUnEqual;
-
-Var
-  D : TDateTime;
-
-begin
-  D:=Now;
-  FN:=NodeClass.Create(CreateDateTimeNode(D),CreateDateTimeNode(D-1));
-  AssertNodeOk(FN);
-  AssertEquals('Boolean result',rtBoolean,FN.NodeType);
-  TestNode(FN,Not ExpectedResult);
-end;
-
-
-procedure TTestEqualNode.TestDestroy;
-begin
-  FN:=NodeClass.Create(TMyDestroyNode.CreateTest(Self),TMyDestroyNode.CreateTest(Self));
-  FreeAndNil(FN);
-  AssertEquals('Destroy called for left and right nodes',2,self.FDestroyCalled)
-end;
-
-procedure TTestEqualNode.TestWrongTypes1;
-begin
-  FN:=NodeClass.Create(CreateIntNode(3),CreateStringNode('1.23'));
-  AssertNodeNotOk('Wrong Types',FN);
-end;
-
-procedure TTestEqualNode.TestWrongTypes2;
-begin
-  FN:=NodeClass.Create(CreateDateTimeNode(3),CreateStringNode('1.23'));
-  AssertNodeNotOk('Wrong Types',FN);
-end;
-
-procedure TTestEqualNode.TestWrongTypes3;
-begin
-  FN:=NodeClass.Create(CreateFloatNode(1.3),CreateStringNode('1.23'));
-  AssertNodeNotOk('Wrong Types',FN);
-end;
-
-procedure TTestEqualNode.TestWrongTypes4;
-begin
-  FN:=NodeClass.Create(CreateBoolNode(False),CreateStringNode('1.23'));
-  AssertNodeNotOk('Wrong Types',FN);
-end;
-
-procedure TTestEqualNode.TestWrongTypes5;
-begin
-  FN:=NodeClass.Create(CreateFloatNode(1),CreateIntNode(1));
-  AssertNodeNotOk('Wrong Types',FN);
-end;
-
-
-procedure TTestEqualNode.TestAsString;
-begin
-  FN:=NodeClass.Create(CreateIntNode(1),CreateIntNode(2));
-  AssertEquals('Asstring works ok','1 '+OPeratorString+' 2',FN.AsString);
-end;
-
-{ TTestUnEqualNode }
-
-class function TTestUnEqualNode.NodeClass: TFPBooleanResultOperationClass;
-begin
-  Result:=TFPUnEqualOperation;
-end;
-
-class function TTestUnEqualNode.ExpectedResult: Boolean;
-begin
-  Result:=False;
-end;
-
-class function TTestUnEqualNode.OperatorString: String;
-begin
-  Result:='<>';
-end;
-
-{ TTestLessThanNode }
-
-class function TTestLessThanNode.NodeClass: TFPBooleanResultOperationClass;
-begin
-  Result:=TFPLessThanOperation;
-end;
-
-class function TTestLessThanNode.Larger: Boolean;
-begin
-  Result:=False;
-end;
-
-class function TTestLessThanNode.AllowEqual: Boolean;
-begin
-  Result:=False;
-end;
-
-class function TTestLessThanNode.OperatorString: String;
-begin
-  Result:='<';
-end;
-
-procedure TTestLessThanNode.TearDown;
-begin
-  FreeAndNil(FN);
-  inherited TearDown;
-end;
-
-procedure TTestLessThanNode.TestCreateIntegerEqual;
-begin
-  FN:=NodeClass.Create(CreateIntNode(1),CreateIntNode(1));
-  AssertNodeOk(FN);
-  AssertEquals('Boolean result',rtBoolean,FN.NodeType);
-  TestNode(FN,AllowEqual);
-end;
-
-procedure TTestLessThanNode.TestCreateIntegerSmaller;
-begin
-  FN:=NodeClass.Create(CreateIntNode(1),CreateIntNode(2));
-  AssertNodeOk(FN);
-  AssertEquals('Boolean result',rtBoolean,FN.NodeType);
-  TestNode(FN,Not Larger);
-end;
-
-procedure TTestLessThanNode.TestCreateIntegerLarger;
-begin
-  FN:=NodeClass.Create(CreateIntNode(2),CreateIntNode(1));
-  AssertNodeOk(FN);
-  AssertEquals('Boolean result',rtBoolean,FN.NodeType);
-  TestNode(FN,Larger);
-end;
-
-procedure TTestLessThanNode.TestCreateFloatEqual;
-begin
-  FN:=NodeClass.Create(CreateFloatNode(1.23),CreateFloatNode(1.23));
-  AssertNodeOk(FN);
-  AssertEquals('Boolean result',rtBoolean,FN.NodeType);
-  TestNode(FN,AllowEqual);
-end;
-
-procedure TTestLessThanNode.TestCreateFloatSmaller;
-begin
-  FN:=NodeClass.Create(CreateFloatNode(1.23),CreateFloatNode(4.56));
-  AssertNodeOk(FN);
-  AssertEquals('Boolean result',rtBoolean,FN.NodeType);
-  TestNode(FN,Not Larger);
-end;
-
-procedure TTestLessThanNode.TestCreateFloatLarger;
-begin
-  FN:=NodeClass.Create(CreateFloatNode(4.56),CreateFloatNode(1.23));
-  AssertNodeOk(FN);
-  AssertEquals('Boolean result',rtBoolean,FN.NodeType);
-  TestNode(FN,Larger);
-end;
-
-procedure TTestLessThanNode.TestCreateDateTimeEqual;
-
-Var
-  D : TDateTime;
-
-begin
-  D:=Now;
-  FN:=NodeClass.Create(CreateDateTimeNode(D),CreateDateTimeNode(D));
-  AssertNodeOk(FN);
-  AssertEquals('Boolean result',rtBoolean,FN.NodeType);
-  TestNode(FN,AllowEqual);
-end;
-
-procedure TTestLessThanNode.TestCreateDateTimeSmaller;
-
-Var
-  D : TDateTime;
-
-begin
-  D:=Now;
-  FN:=NodeClass.Create(CreateDateTimeNode(D),CreateDateTimeNode(D+1));
-  AssertNodeOk(FN);
-  AssertEquals('Boolean result',rtBoolean,FN.NodeType);
-  TestNode(FN,Not larger);
-end;
-
-procedure TTestLessThanNode.TestCreateDateTimeLarger;
-
-Var
-  D : TDateTime;
-
-begin
-  D:=Now;
-  FN:=NodeClass.Create(CreateDateTimeNode(D),CreateDateTimeNode(D-1));
-  AssertNodeOk(FN);
-  AssertEquals('Boolean result',rtBoolean,FN.NodeType);
-  TestNode(FN,larger);
-end;
-
-procedure TTestLessThanNode.TestCreateStringEqual;
-begin
-  FN:=NodeClass.Create(CreateStringNode('now'),CreateStringNode('now'));
-  AssertNodeOk(FN);
-  AssertEquals('Boolean result',rtBoolean,FN.NodeType);
-  TestNode(FN,AllowEqual);
-end;
-
-procedure TTestLessThanNode.TestCreateStringSmaller;
-begin
-  FN:=NodeClass.Create(CreateStringNode('now'),CreateStringNode('then'));
-  AssertNodeOk(FN);
-  AssertEquals('Boolean result',rtBoolean,FN.NodeType);
-  TestNode(FN,Not Larger);
-end;
-
-procedure TTestLessThanNode.TestCreateStringLarger;
-begin
-  FN:=NodeClass.Create(CreateStringNode('then'),CreateStringNode('now'));
-  AssertNodeOk(FN);
-  AssertEquals('Boolean result',rtBoolean,FN.NodeType);
-  TestNode(FN,Larger);
-end;
-
-procedure TTestLessThanNode.TestWrongTypes1;
-begin
-  FN:=NodeClass.Create(CreateIntNode(3),CreateStringNode('1.23'));
-  AssertNodeNotOk('Wrong Types',FN);
-end;
-
-procedure TTestLessThanNode.TestWrongTypes2;
-begin
-  FN:=NodeClass.Create(CreateDateTimeNode(3),CreateStringNode('1.23'));
-  AssertNodeNotOk('Wrong Types',FN);
-end;
-
-procedure TTestLessThanNode.TestWrongTypes3;
-begin
-  FN:=NodeClass.Create(CreateFloatNode(1.3),CreateStringNode('1.23'));
-  AssertNodeNotOk('Wrong Types',FN);
-end;
-
-procedure TTestLessThanNode.TestWrongTypes4;
-begin
-  FN:=NodeClass.Create(CreateBoolNode(False),CreateStringNode('1.23'));
-  AssertNodeNotOk('Wrong Types',FN);
-end;
-
-procedure TTestLessThanNode.TestWrongTypes5;
-begin
-  FN:=NodeClass.Create(CreateFloatNode(1.23),CreateIntNode(1));
-  AssertNodeNotOk('Wrong Types',FN);
-end;
-
-procedure TTestLessThanNode.TestNoBoolean1;
-begin
-  FN:=NodeClass.Create(CreateBoolNode(False),CreateIntNode(1));
-  AssertNodeNotOk('Wrong Types',FN);
-end;
-
-procedure TTestLessThanNode.TestNoBoolean2;
-begin
-  FN:=NodeClass.Create(CreateIntNode(1),CreateBoolNode(False));
-  AssertNodeNotOk('Wrong Types',FN);
-end;
-
-procedure TTestLessThanNode.TestNoBoolean3;
-begin
-  FN:=NodeClass.Create(CreateBoolNode(False),CreateBoolNode(False));
-  AssertNodeNotOk('Wrong Types',FN);
-end;
-
-procedure TTestLessThanNode.TestAsString;
-begin
-  FN:=NodeClass.Create(CreateIntNode(1),CreateIntNode(2));
-  AssertEquals('Asstring works ok','1 '+OPeratorString+' 2',FN.AsString);
-end;
-
-{ TTestLessThanEqualNode }
-
-class function TTestLessThanEqualNode.NodeClass: TFPBooleanResultOperationClass;
-begin
-  Result:=TFPLessThanEqualOperation;
-end;
-
-class function TTestLessThanEqualNode.AllowEqual: Boolean;
-begin
-  Result:=True;
-end;
-
-class function TTestLessThanEqualNode.OperatorString: String;
-begin
-  Result:='<=';
-end;
-
-{ TTestLargerThanNode }
-
-class function TTestLargerThanNode.NodeClass: TFPBooleanResultOperationClass;
-begin
-  Result:=TFPGreaterThanOperation;
-end;
-
-class function TTestLargerThanNode.Larger: Boolean;
-begin
-  Result:=True;
-end;
-
-class function TTestLargerThanNode.OperatorString: String;
-begin
-  Result:='>';
-end;
-
-{ TTestLargerThanEqualNode }
-
-class function TTestLargerThanEqualNode.NodeClass: TFPBooleanResultOperationClass;
-begin
-  Result:=TFPGreaterThanEqualOperation;
-end;
-
-class function TTestLargerThanEqualNode.AllowEqual: Boolean;
-begin
-  Result:=True;
-end;
-
-class function TTestLargerThanEqualNode.OperatorString: String;
-begin
-  Result:='>=';
-end;
-
-{ TTestAddNode }
-
-procedure TTestAddNode.TearDown;
-begin
-  FreeAndNil(FN);
-  inherited TearDown;
-end;
-
-procedure TTestAddNode.TestCreateInteger;
-begin
-  FN:=TFPAddOperation.Create(CreateIntNode(1),CreateIntNode(2));
-  AssertEquals('Add has correct type',rtInteger,FN.NodeType);
-  AssertEquals('Add has correct result',3,FN.NodeValue.ResInteger);
-end;
-
-procedure TTestAddNode.TestCreateFloat;
-begin
-  FN:=TFPAddOperation.Create(CreateFloatNode(1.23),CreateFloatNode(4.56));
-  AssertEquals('Add has correct type',rtFloat,FN.NodeType);
-  AssertEquals('Add has correct result',5.79,FN.NodeValue.ResFloat);
-end;
-
-procedure TTestAddNode.TestCreateDateTime;
-
-Var
-  D,T : TDateTime;
-
-begin
-  D:=Date;
-  T:=Time;
-  FN:=TFPAddOperation.Create(CreateDateTimeNode(D),CreateDateTimeNode(T));
-  AssertEquals('Add has correct type',rtDateTime,FN.NodeType);
-  AssertEquals('Add has correct result',D+T,FN.NodeValue.ResDateTime);
-end;
-
-procedure TTestAddNode.TestCreateString;
-begin
-  FN:=TFPAddOperation.Create(CreateStringNode('alo'),CreateStringNode('ha'));
-  AssertEquals('Add has correct type',rtString,FN.NodeType);
-  AssertEquals('Add has correct result','aloha',FN.NodeValue.ResString);
-end;
-
-procedure TTestAddNode.TestCreateBoolean;
-begin
-  FN:=TFPAddOperation.Create(CreateBoolNode(True),CreateBoolNode(False));
-  AssertNodeNotOK('No boolean addition',FN);
-end;
-
-procedure TTestAddNode.TestDestroy;
-begin
-  FN:=TFPAddOperation.Create(TMyDestroyNode.CreateTest(Self),TMyDestroyNode.CreateTest(Self));
-  FreeAndNil(FN);
-  AssertEquals('Destroy called for left and right nodes',2,self.FDestroyCalled)
-end;
-
-procedure TTestAddNode.TestAsString;
-begin
-  FN:=TFPAddOperation.Create(CreateIntNode(1),CreateIntNode(2));
-  AssertEquals('Asstring works ok','1 + 2',FN.AsString);
-end;
-
-{ TTestSubtractNode }
-
-procedure TTestSubtractNode.TearDown;
-begin
-  FreeAndNil(FN);
-  inherited TearDown;
-end;
-
-procedure TTestSubtractNode.TestCreateInteger;
-begin
-  FN:=TFPSubtractOperation.Create(CreateIntNode(4),CreateIntNode(1));
-  AssertEquals('Subtract has correct type',rtInteger,FN.NodeType);
-  AssertEquals('Subtract has correct result',3,FN.NodeValue.ResInteger);
-end;
-
-procedure TTestSubtractNode.TestCreateFloat;
-begin
-  FN:=TFPSubtractOperation.Create(CreateFloatNode(4.56),CreateFloatNode(1.23));
-  AssertEquals('Subtract has correct type',rtFloat,FN.NodeType);
-  AssertEquals('Subtract has correct result',3.33,FN.NodeValue.ResFloat);
-end;
-
-procedure TTestSubtractNode.TestCreateDateTime;
-
-Var
-  D,T : TDateTime;
-
-begin
-  D:=Date;
-  T:=Time;
-  FN:=TFPSubtractOperation.Create(CreateDateTimeNode(D+T),CreateDateTimeNode(T));
-  AssertEquals('Subtract has correct type',rtDateTime,FN.NodeType);
-  AssertEquals('Subtract has correct result',D,FN.NodeValue.ResDateTime);
-end;
-
-procedure TTestSubtractNode.TestCreateString;
-begin
-  FN:=TFPSubtractOperation.Create(CreateStringNode('alo'),CreateStringNode('ha'));
-  AssertNodeNotOK('No string Subtract',FN);
-end;
-
-procedure TTestSubtractNode.TestCreateBoolean;
-begin
-  FN:=TFPSubtractOperation.Create(CreateBoolNode(True),CreateBoolNode(False));
-  AssertNodeNotOK('No boolean Subtract',FN);
-end;
-
-procedure TTestSubtractNode.TestDestroy;
-begin
-  FN:=TFPSubtractOperation.Create(TMyDestroyNode.CreateTest(Self),TMyDestroyNode.CreateTest(Self));
-  FreeAndNil(FN);
-  AssertEquals('Destroy called for left and right nodes',2,self.FDestroyCalled)
-end;
-
-procedure TTestSubtractNode.TestAsString;
-begin
-  FN:=TFPSubtractOperation.Create(CreateIntNode(1),CreateIntNode(2));
-  AssertEquals('Asstring works ok','1 - 2',FN.AsString);
-end;
-
-{ TTestMultiplyNode }
-
-procedure TTestMultiplyNode.TearDown;
-begin
-  FreeAndNil(FN);
-  inherited TearDown;
-end;
-
-procedure TTestMultiplyNode.TestCreateInteger;
-begin
-  FN:=TFPMultiplyOperation.Create(CreateIntNode(4),CreateIntNode(2));
-  AssertEquals('multiply has correct type',rtInteger,FN.NodeType);
-  AssertEquals('multiply has correct result',8,FN.NodeValue.ResInteger);
-end;
-
-procedure TTestMultiplyNode.TestCreateFloat;
-begin
-  FN:=TFPMultiplyOperation.Create(CreateFloatNode(2.0),CreateFloatNode(1.23));
-  AssertEquals('multiply has correct type',rtFloat,FN.NodeType);
-  AssertEquals('multiply has correct result',2.46,FN.NodeValue.ResFloat);
-end;
-
-procedure TTestMultiplyNode.TestCreateDateTime;
-
-Var
-  D,T : TDateTime;
-
-begin
-  D:=Date;
-  T:=Time;
-  FN:=TFPMultiplyOperation.Create(CreateDateTimeNode(D+T),CreateDateTimeNode(T));
-  AssertNodeNotOK('No datetime multiply',FN);
-end;
-
-procedure TTestMultiplyNode.TestCreateString;
-begin
-  FN:=TFPMultiplyOperation.Create(CreateStringNode('alo'),CreateStringNode('ha'));
-  AssertNodeNotOK('No string multiply',FN);
-end;
-
-procedure TTestMultiplyNode.TestCreateBoolean;
-begin
-  FN:=TFPMultiplyOperation.Create(CreateBoolNode(True),CreateBoolNode(False));
-  AssertNodeNotOK('No boolean multiply',FN);
-end;
-
-procedure TTestMultiplyNode.TestDestroy;
-begin
-  FN:=TFPMultiplyOperation.Create(TMyDestroyNode.CreateTest(Self),TMyDestroyNode.CreateTest(Self));
-  FreeAndNil(FN);
-  AssertEquals('Destroy called for left and right nodes',2,self.FDestroyCalled)
-end;
-
-procedure TTestMultiplyNode.TestAsString;
-begin
-  FN:=TFPMultiplyOperation.Create(CreateIntNode(1),CreateIntNode(2));
-  AssertEquals('Asstring works ok','1 * 2',FN.AsString);
-end;
-
-
-{ TTestPowerNode }
-
-procedure TTestPowerNode.TearDown;
-begin
-  FreeAndNil(FN);
-  inherited TearDown;
-end;
-
-procedure TTestPowerNode.Setup;
-begin
-  inherited ;
-  FE:=TFpExpressionParser.Create(Nil);
-  FE.Builtins := [bcMath];
-end;
-
-procedure TTestPowerNode.Calc(AExpr: String; Expected: Double =NaN);
-const
-  EPS = 1e-9;
-var
-  res: TFpExpressionResult;
-  x: Double;
-begin
-  FE.Expression := AExpr;
-  res:=FE.Evaluate;
-  x:= ArgToFloat(res);
-  if not IsNaN(Expected) then 
-    AssertEquals('Expression '+AExpr+' result',Expected,X,Eps);
-end;
-
-procedure TTestPowerNode.TestCalc;
-
-begin
-  Calc('2^2', Power(2, 2));
-  Calc('2^-2', Power(2, -2));
-  Calc('2^(-2)', Power(2, -2));
-  Calc('sqrt(3)^2', Power(sqrt(3), 2));
-  Calc('-sqrt(3)^2', -Power(sqrt(3), 2));
-  Calc('-2^2', -Power(2, 2));
-  Calc('(-2.0)^2', Power(-2.0, 2));
-  Calc('(-2.0)^-2', Power(-2.0, -2));
-  // Odd integer exponent
-  Calc('2^3', Power(2, 3));
-  Calc('-2^3', -Power(2, 3));
-  Calc('-2^-3', -Power(2, -3));
-  Calc('-2^(-3)', -Power(2, -3));
-  Calc('(-2.0)^3', Power(-2.0, 3));
-  Calc('(-2.0)^-3', Power(-2.0, -3));
-  // Fractional exponent
-  Calc('10^2.5', power(10, 2.5));
-  Calc('10^-2.5', Power(10, -2.5));
-  // Expressions
-  Calc('(1+1)^3', Power(1+1, 3));
-  Calc('1+2^3', 1 + Power(2, 3));
-  calc('2^3+1', Power(2, 3) + 1);
-  Calc('2^3*2', Power(2, 3) * 2);
-  Calc('2^3*-2', Power(2, 3) * -2);
-  Calc('2^(1+1)', Power(2, 1+1));
-  Calc('2^-(1+1)', Power(2, -(1+1)));
-  WriteLn;
-  // Special cases
-  Calc('0^0', power(0, 0));
-  calc('0^1', power(0, 1));
-  Calc('0^2.5', Power(0, 2.5));
-  calc('2.5^0', power(2.5, 0));
-  calc('2^3^4', 2417851639229258349412352);  // according to Wolfram Alpha, 2^(3^4)
-
-  // These expressions should throw expections
-
-  //Calc('(-10)^2.5', NaN);  // base must be positive in case of fractional exponent
-  //Calc('0^-2', NaN);       // is 1/0^2 = 1/0
-end;
-
-procedure TTestPowerNode.TestCreateInteger;
-begin
-  FN:=TFPPowerOperation.Create(CreateIntNode(4),CreateIntNode(2));
-  AssertEquals('Power has correct type',rtfloat,FN.NodeType);
-  AssertEquals('Power has correct result',16.0,FN.NodeValue.ResFloat);
-end;
-
-procedure TTestPowerNode.TestCreateFloat;
-begin
-  FN:=TFPPowerOperation.Create(CreateFloatNode(2.0),CreateFloatNode(3.0));
-  AssertEquals('Power has correct type',rtFloat,FN.NodeType);
-  AssertEquals('Power has correct result',8.0,FN.NodeValue.ResFloat);
-end;
-
-procedure TTestPowerNode.TestCreateDateTime;
-
-Var
-  D,T : TDateTime;
-
-begin
-  D:=Date;
-  T:=Time;
-  FN:=TFPPowerOperation.Create(CreateDateTimeNode(D+T),CreateDateTimeNode(T));
-  AssertNodeNotOK('No datetime Power',FN);
-end;
-
-procedure TTestPowerNode.TestCreateString;
-begin
-  FN:=TFPPowerOperation.Create(CreateStringNode('alo'),CreateStringNode('ha'));
-  AssertNodeNotOK('No string Power',FN);
-end;
-
-procedure TTestPowerNode.TestCreateBoolean;
-begin
-  FN:=TFPPowerOperation.Create(CreateBoolNode(True),CreateBoolNode(False));
-  AssertNodeNotOK('No boolean Power',FN);
-end;
-
-procedure TTestPowerNode.TestDestroy;
-begin
-  FN:=TFPPowerOperation.Create(TMyDestroyNode.CreateTest(Self),TMyDestroyNode.CreateTest(Self));
-  FreeAndNil(FN);
-  AssertEquals('Destroy called for left and right nodes',2,self.FDestroyCalled)
-end;
-
-procedure TTestPowerNode.TestAsString;
-begin
-  FN:=TFPPowerOperation.Create(CreateIntNode(1),CreateIntNode(2));
-  AssertEquals('Asstring works ok','1^2',FN.AsString);
-end;
-
-
-{ TTestDivideNode }
-
-procedure TTestDivideNode.TearDown;
-begin
-  FreeAndNil(FN);
-  inherited TearDown;
-end;
-
-procedure TTestDivideNode.TestCreateInteger;
-begin
-  FN:=TFPDivideOperation.Create(CreateIntNode(4),CreateIntNode(2));
-  AssertEquals('Divide has correct type',rtfloat,FN.NodeType);
-  AssertEquals('Divide has correct result',2.0,FN.NodeValue.ResFloat);
-end;
-
-procedure TTestDivideNode.TestCreateFloat;
-begin
-  FN:=TFPDivideOperation.Create(CreateFloatNode(9.0),CreateFloatNode(3.0));
-  AssertEquals('Divide has correct type',rtFloat,FN.NodeType);
-  AssertEquals('Divide has correct result',3.0,FN.NodeValue.ResFloat);
-end;
-
-procedure TTestDivideNode.TestCreateDateTime;
-
-Var
-  D,T : TDateTime;
-
-begin
-  D:=Date;
-  T:=Time;
-  FN:=TFPDivideOperation.Create(CreateDateTimeNode(D+T),CreateDateTimeNode(T));
-  AssertNodeNotOK('No datetime division',FN);
-end;
-
-procedure TTestDivideNode.TestCreateString;
-begin
-  FN:=TFPDivideOperation.Create(CreateStringNode('alo'),CreateStringNode('ha'));
-  AssertNodeNotOK('No string division',FN);
-end;
-
-procedure TTestDivideNode.TestCreateBoolean;
-begin
-  FN:=TFPDivideOperation.Create(CreateBoolNode(True),CreateBoolNode(False));
-  AssertNodeNotOK('No boolean division',FN);
-end;
-
-procedure TTestDivideNode.TestDestroy;
-begin
-  FN:=TFPDivideOperation.Create(TMyDestroyNode.CreateTest(Self),TMyDestroyNode.CreateTest(Self));
-  FreeAndNil(FN);
-  AssertEquals('Destroy called for left and right nodes',2,self.FDestroyCalled)
-end;
-
-procedure TTestDivideNode.TestAsString;
-begin
-  FN:=TFPDivideOperation.Create(CreateIntNode(1),CreateIntNode(2));
-  AssertEquals('Asstring works ok','1 / 2',FN.AsString);
-end;
-
-{ TTestIntToFloatNode }
-
-procedure TTestIntToFloatNode.TearDown;
-begin
-  FreeAndNil(Fn);
-  inherited TearDown;
-end;
-
-procedure TTestIntToFloatNode.TestCreateInteger;
-begin
-  FN:=TIntToFloatNode.Create(CreateIntNode(4));
-  AssertEquals('Convert has correct type',rtfloat,FN.NodeType);
-  AssertEquals('Convert has correct result',4.0,FN.NodeValue.ResFloat);
-end;
-
-procedure TTestIntToFloatNode.TestCreateFloat;
-begin
-  FN:=TIntToFloatNode.Create(CreateFloatNode(4.0));
-  AssertNodeNotOK('No float allowed',FN);
-end;
-
-procedure TTestIntToFloatNode.TestDestroy;
-begin
-  FN:=TIntToFloatNode.Create(TMyDestroyNode.CreateTest(Self));
-  FreeAndNil(FN);
-  AssertEquals('Destroy called for left and right nodes',1,self.FDestroyCalled)
-end;
-
-procedure TTestIntToFloatNode.TestAsString;
-begin
-  FN:=TIntToFloatNode.Create(CreateIntNode(4));
-  AssertEquals('Convert has correct asstring','4',FN.AsString);
-end;
-
-{ TTestIntToDateTimeNode }
-
-procedure TTestIntToDateTimeNode.TearDown;
-begin
-  FreeAndNil(FN);
-  inherited TearDown;
-end;
-
-procedure TTestIntToDateTimeNode.TestCreateInteger;
-begin
-  FN:=TIntToDateTimeNode.Create(CreateIntNode(Round(Date)));
-  AssertEquals('Convert has correct type',rtDateTime,FN.NodeType);
-  AssertEquals('Convert has correct result',Date,FN.NodeValue.ResDateTime);
-end;
-
-procedure TTestIntToDateTimeNode.TestCreateFloat;
-begin
-  FN:=TIntToDateTimeNode.Create(CreateFloatNode(4.0));
-  AssertNodeNotOK('No float allowed',FN);
-end;
-
-procedure TTestIntToDateTimeNode.TestDestroy;
-begin
-  FN:=TIntToDateTimeNode.Create(TMyDestroyNode.CreateTest(Self));
-  FreeAndNil(FN);
-  AssertEquals('Destroy called for left and right nodes',1,self.FDestroyCalled)
-end;
-
-procedure TTestIntToDateTimeNode.TestAsString;
-begin
-  FN:=TIntToDateTimeNode.Create(CreateIntNode(4));
-  AssertEquals('Convert has correct asstring','4',FN.AsString);
-end;
-
-{ TTestFloatToDateTimeNode }
-
-procedure TTestFloatToDateTimeNode.TearDown;
-begin
-  FreeAndNil(FN);
-  inherited TearDown;
-end;
-
-procedure TTestFloatToDateTimeNode.TestCreateInteger;
-begin
-  FN:=TFloatToDateTimeNode.Create(CreateIntNode(4));
-  AssertNodeNotOK('No int allowed',FN);
-end;
-
-procedure TTestFloatToDateTimeNode.TestCreateFloat;
-
-Var
-  T : TExprFloat;
-
-begin
-  T:=Time;
-  FN:=TFloatToDateTimeNode.Create(CreateFloatNode(T));
-  AssertEquals('Convert has correct type',rtDateTime,FN.NodeType);
-  AssertEquals('Convert has correct result',T,FN.NodeValue.ResDateTime);
-end;
-
-procedure TTestFloatToDateTimeNode.TestDestroy;
-begin
-  FN:=TFloatToDateTimeNode.Create(TMyDestroyNode.CreateTest(Self));
-  FreeAndNil(FN);
-  AssertEquals('Destroy called for left and right nodes',1,self.FDestroyCalled)
-end;
-
-procedure TTestFloatToDateTimeNode.TestAsString;
-
-Var
-  S : String;
-
-begin
-  FN:=TFloatToDateTimeNode.Create(CreateFloatNode(1.2));
-  Str(TExprFloat(1.2),S);
-  AssertEquals('Convert has correct asstring',S,FN.AsString);
-end;
-
-{ TMyFPExpressionParser }
-
-procedure TMyFPExpressionParser.BuildHashList;
-begin
-  CreateHashList;
-end;
-
-{ TTestExpressionParser }
-
-procedure TTestExpressionParser.SetUp;
-begin
-  inherited SetUp;
-  FP:=TMyFPExpressionParser.Create(Nil);
-end;
-
-procedure TTestExpressionParser.TearDown;
-begin
-  FreeAndNil(FP);
-  inherited TearDown;
-end;
-
-procedure TTestExpressionParser.DoParse;
-
-begin
-  FP.Expression:=FTestExpr;
-end;
-
-procedure TTestExpressionParser.TestParser(AExpr : String);
-
-begin
-  FTestExpr:=AExpr;
-  AssertException(Format('Wrong expression: "%s"',[AExpr]),EExprParser,@DoParse);
-end;
-
-procedure TTestExpressionParser.AssertLeftRight(N: TFPExprNode; LeftClass,
-  RightClass: TClass);
-begin
-  AssertNotNull('Binary node not null',N);
-  If Not N.InheritsFrom(TFPBinaryOperation) then
-    Fail(N.ClassName+' does not descend from TFPBinaryOperation');
-  AssertNotNull('Left node assigned',TFPBinaryOperation(N).Left);
-  AssertNotNull('Right node assigned',TFPBinaryOperation(N).Right);
-  AssertEquals('Left node correct class ',LeftClass, TFPBinaryOperation(N).Left.ClassType);
-  AssertEquals('Right node correct class ',RightClass, TFPBinaryOperation(N).Right.ClassType);
-end;
-
-procedure TTestExpressionParser.AssertOperand(N: TFPExprNode;
-  OperandClass: TClass);
-begin
-  AssertNotNull('Unary node not null',N);
-  If Not N.InheritsFrom(TFPUnaryOperator) then
-    Fail(N.ClassName+' does not descend from TFPUnaryOperator');
-  AssertNotNull('Operand assigned',TFPUnaryOperator(N).Operand);
-  AssertEquals('Operand node correct class ',OperandClass, TFPUnaryOperator(N).Operand.ClassType);
-end;
-
-procedure TTestExpressionParser.AssertResultType(RT: TResultType);
-begin
-  AssertEquals('Result type is '+ResultTypeName(rt),rt,FP.ExprNode);
-  AssertEquals('Result type is '+ResultTypeName(rt),rt,FP.ResultType);
-end;
-
-procedure TTestExpressionParser.AssertResult(F: TExprFloat);
-begin
-  AssertEquals('Correct float result',F,FP.ExprNode.NodeValue.ResFloat);
-  AssertEquals('Correct float result',F,FP.Evaluate.ResFloat);
-end;
-
-procedure TTestExpressionParser.AssertCurrencyResult(C: Currency);
-begin
-  AssertEquals('Correct currency result',C,FP.ExprNode.NodeValue.ResCurrency);
-  AssertEquals('Correct currency result',C,FP.Evaluate.ResCurrency);
-end;
-
-procedure TTestExpressionParser.AssertResult(I: Int64);
-begin
-  AssertEquals('Correct integer result',I,FP.ExprNode.NodeValue.ResInteger);
-  AssertEquals('Correct integer result',I,FP.Evaluate.ResInteger);
-end;
-
-procedure TTestExpressionParser.AssertResult(S: String);
-begin
-  AssertEquals('Correct  result',S,FP.ExprNode.NodeValue.ResString);
-  AssertEquals('Correct string result',S,FP.Evaluate.ResString);
-end;
-
-procedure TTestExpressionParser.AssertResult(B: Boolean);
-begin
-  AssertEquals('Correct boolean result',B,FP.ExprNode.NodeValue.ResBoolean);
-  AssertEquals('Correct boolean result',B,FP.Evaluate.ResBoolean);
-end;
-
-procedure TTestExpressionParser.AssertDateTimeResult(D: TDateTime);
-begin
-  AssertEquals('Correct datetime result',D,FP.ExprNode.NodeValue.ResDateTime);
-  AssertEquals('Correct boolean result',D,FP.Evaluate.ResDateTime);
-end;
-//TTestParserExpressions
-procedure TTestParserExpressions.TestCreate;
-begin
-  AssertEquals('Expression is empty','',FP.Expression);
-  AssertNotNull('Identifiers assigned',FP.Identifiers);
-  AssertEquals('No identifiers',0,FP.Identifiers.Count);
-end;
-
-procedure TTestParserExpressions.TestNumberValues;
-
-  Procedure DoTest(E : String; V : integer);
-
-  var
-    res: TFPExpressionResult;
-
-  begin
-    FP.Expression:=E;
-    res := FP.Evaluate;
-    AssertTrue('Expression '+E+': Result is a number', Res.ResultType in [rtInteger,rtFloat]);
-    AssertTrue('Expression '+E+': Correct value', ArgToFloat(res)=V);
-  end;
-
-
-begin
-  // Decimal numbers
-     DoTest('1', 1);
-     DoTest('1E2', 100);
-     DoTest('1.0/1E-2', 100);
-  // DoTest('200%', 2);
-     WriteLn;
-     // Hex numbers
-     DoTest('$0001', 1);
-     DoTest('-$01', -1);
-     DoTest('$A', 10);
-     DoTest('$FF', 255);
-     DoTest('$fe', 254);
-     DoTest('$FFFF', $FFFF);
-     DoTest('1E2', 100);
-     DoTest('$E', 14);
-     DoTest('$D+1E2', 113);
-     DoTest('$0A-$0B', -1);
-     // Hex and variables
-     FP.Identifiers.AddVariable('a', rtInteger, '1');
-     FP.Identifiers.AddVariable('b', rtInteger, '$B');
-     DoTest('a', 1);
-     DoTest('b', $B);
-     DoTest('$A+a', 11);
-     DoTest('$B-b', 0);
-     WriteLn;
-     // Octal numbers
-     DoTest('&10', 8);
-     DoTest('&10+10', 18);
-     // Mixed hex and octal expression
-     DoTest('&10-$0008', 0);
-     WriteLn;
-     // Binary numbers
-     DoTest('%1', 1);
-     DoTest('%11', 3);
-     DoTest('%1000', 8);
-
-end;
-
-
-procedure TTestParserExpressions.TestSimpleNodeFloat;
-begin
-  FP.Expression:='123.4';
-  AssertNotNull('Have result node',FP.ExprNode);
-  AssertNodeType('Constant expression',TFPConstExpression, FP.ExprNode);
-  AssertResultType(rtFloat);
-  AssertResult(123.4);
-end;
-
-procedure TTestParserExpressions.TestSimpleNodeInteger;
-begin
-  FP.Expression:='1234';
-  AssertNotNull('Have result node',FP.ExprNode);
-  AssertNodeType('Constant expression',TFPConstExpression, FP.ExprNode);
-  AssertResultType(rtInteger);
-  AssertResult(1234);
-end;
-
-procedure TTestParserExpressions.TestSimpleNodeBooleanTrue;
-begin
-  FP.Expression:='true';
-  AssertNotNull('Have result node',FP.ExprNode);
-  AssertNodeType('Constant expression',TFPConstExpression, FP.ExprNode);
-  AssertResultType(rtBoolean);
-  AssertResult(True);
-end;
-
-procedure TTestParserExpressions.TestSimpleNodeBooleanFalse;
-begin
-  FP.Expression:='False';
-  AssertNotNull('Have result node',FP.ExprNode);
-  AssertNodeType('Constant expression',TFPConstExpression, FP.ExprNode);
-  AssertResultType(rtBoolean);
-  AssertResult(False);
-end;
-
-procedure TTestParserExpressions.TestSimpleNodeString;
-begin
-  FP.Expression:='''A string''';
-  AssertNotNull('Have result node',FP.ExprNode);
-  AssertNodeType('Constant expression',TFPConstExpression, FP.ExprNode);
-  AssertResultType(rtString);
-  AssertResult('A string');
-end;
-
-procedure TTestParserExpressions.TestSimpleNegativeInteger;
-begin
-  FP.Expression:='-1234';
-  AssertNotNull('Have result node',FP.ExprNode);
-  AssertNodeType('Constant expression',TFPNegateOperation, FP.ExprNode);
-  AssertNodeType('Constant expression',TFPConstExpression, TFPNegateOperation(FP.ExprNode).Operand);
-  AssertResultType(rtInteger);
-  AssertResult(-1234);
-end;
-
-procedure TTestParserExpressions.TestSimpleNegativeFloat;
-begin
-  FP.Expression:='-1.234';
-  AssertNotNull('Have result node',FP.ExprNode);
-  AssertNodeType('Constant expression',TFPNegateOperation, FP.ExprNode);
-  AssertNodeType('Constant expression',TFPConstExpression, TFPNegateOperation(FP.ExprNode).Operand);
-  AssertResultType(rtFloat);
-  AssertResult(-1.234);
-end;
-
-procedure TTestParserExpressions.TestSimpleAddInteger;
-begin
-  FP.Expression:='4+1';
-  AssertNotNull('Have result node',FP.ExprNode);
-  AssertNodeType('Constant expression',TFPAddOperation, FP.ExprNode);
-  AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression);
-  AssertResultType(rtInteger);
-  AssertResult(5);
-end;
-
-procedure TTestParserExpressions.TestSimpleAddFloat;
-begin
-  FP.Expression:='1.2+3.4';
-  AssertNotNull('Have result node',FP.ExprNode);
-  AssertNodeType('Constant expression',TFPAddOperation, FP.ExprNode);
-  AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression);
-  AssertResultType(rtFloat);
-  AssertResult(4.6);
-end;
-
-procedure TTestParserExpressions.TestSimpleAddIntegerFloat;
-begin
-  FP.Expression:='1+3.4';
-  AssertNotNull('Have result node',FP.ExprNode);
-  AssertNodeType('Constant expression',TFPAddOperation, FP.ExprNode);
-  AssertLeftRight(FP.ExprNode,TIntToFLoatNode,TFPConstExpression);
-  AssertResultType(rtFloat);
-  AssertResult(4.4);
-end;
-
-procedure TTestParserExpressions.TestSimpleAddFloatInteger;
-begin
-  FP.Expression:='3.4 + 1';
-  AssertNotNull('Have result node',FP.ExprNode);
-  AssertNodeType('Constant expression',TFPAddOperation, FP.ExprNode);
-  AssertLeftRight(FP.ExprNode,TFPConstExpression,TIntToFLoatNode);
-  AssertResultType(rtFloat);
-  AssertResult(4.4);
-end;
-
-procedure TTestParserExpressions.TestSimpleAddString;
-begin
-  FP.Expression:='''alo''+''ha''';
-  AssertNotNull('Have result node',FP.ExprNode);
-  AssertNodeType('Constant expression',TFPAddOperation, FP.ExprNode);
-  AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression);
-  AssertResultType(rtString);
-  AssertResult('aloha');
-end;
-
-procedure TTestParserExpressions.TestSimpleSubtractInteger;
-begin
-  FP.Expression:='4-1';
-  AssertNotNull('Have result node',FP.ExprNode);
-  AssertNodeType('Constant expression',TFPSubtractOperation, FP.ExprNode);
-  AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression);
-  AssertResultType(rtInteger);
-  AssertResult(3);
-end;
-
-procedure TTestParserExpressions.TestSimpleSubtractFloat;
-begin
-  FP.Expression:='3.4-1.2';
-  AssertNotNull('Have result node',FP.ExprNode);
-  AssertNodeType('Constant expression',TFPSubtractOperation, FP.ExprNode);
-  AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression);
-  AssertResultType(rtFloat);
-  AssertResult(2.2);
-end;
-
-procedure TTestParserExpressions.TestSimpleSubtractIntegerFloat;
-begin
-  FP.Expression:='3-1.2';
-  AssertNotNull('Have result node',FP.ExprNode);
-  AssertNodeType('Constant expression',TFPSubtractOperation, FP.ExprNode);
-  AssertLeftRight(FP.ExprNode,TIntToFloatNode,TFPConstExpression);
-  AssertResultType(rtFloat);
-  AssertResult(1.8);
-end;
-
-procedure TTestParserExpressions.TestSimpleSubtractFloatInteger;
-begin
-  FP.Expression:='3.3-2';
-  AssertNotNull('Have result node',FP.ExprNode);
-  AssertNodeType('Constant expression',TFPSubtractOperation, FP.ExprNode);
-  AssertLeftRight(FP.ExprNode,TFPConstExpression,TIntToFloatNode);
-  AssertResultType(rtFloat);
-  AssertResult(1.3);
-end;
-
-procedure TTestParserExpressions.TestSimpleMultiplyInteger;
-begin
-  FP.Expression:='4*2';
-  AssertNotNull('Have result node',FP.ExprNode);
-  AssertNodeType('Constant expression',TFPMultiplyOperation, FP.ExprNode);
-  AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression);
-  AssertResultType(rtInteger);
-  AssertResult(8);
-end;
-
-procedure TTestParserExpressions.TestSimpleMultiplyFloat;
-begin
-  FP.Expression:='3.4*1.5';
-  AssertNotNull('Have result node',FP.ExprNode);
-  AssertNodeType('Constant expression',TFPMultiplyOperation, FP.ExprNode);
-  AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression);
-  AssertResultType(rtFloat);
-  AssertResult(5.1);
-end;
-
-procedure TTestParserExpressions.TestSimpleDivideInteger;
-begin
-  FP.Expression:='4/2';
-  AssertNotNull('Have result node',FP.ExprNode);
-  AssertNodeType('Constant expression',TFPDivideOperation, FP.ExprNode);
-  AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression);
-  AssertResultType(rtFloat);
-  AssertResult(2.0);
-end;
-
-procedure TTestParserExpressions.TestSimpleDivideFloat;
-begin
-  FP.Expression:='5.1/1.5';
-  AssertNotNull('Have result node',FP.ExprNode);
-  AssertNodeType('Constant expression',TFPDivideOperation, FP.ExprNode);
-  AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression);
-  AssertResultType(rtFloat);
-  AssertResult(3.4);
-end;
-
-procedure TTestParserExpressions.TestSimpleBooleanAnd;
-begin
-  FP.Expression:='true and true';
-  AssertNotNull('Have result node',FP.ExprNode);
-  AssertNodeType('Constant expression',TFPBinaryAndOperation, FP.ExprNode);
-  AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression);
-  AssertResultType(rtBoolean);
-  AssertResult(True);
-end;
-
-procedure TTestParserExpressions.TestSimpleIntegerAnd;
-begin
-  FP.Expression:='3 and 1';
-  AssertNotNull('Have result node',FP.ExprNode);
-  AssertNodeType('Constant expression',TFPBinaryAndOperation, FP.ExprNode);
-  AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression);
-  AssertResultType(rtInteger);
-  AssertResult(1);
-end;
-
-procedure TTestParserExpressions.TestSimpleBooleanOr;
-begin
-  FP.Expression:='false or true';
-  AssertNotNull('Have result node',FP.ExprNode);
-  AssertNodeType('Constant expression',TFPBinaryOrOperation, FP.ExprNode);
-  AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression);
-  AssertResultType(rtBoolean);
-  AssertResult(True);
-end;
-
-procedure TTestParserExpressions.TestSimpleIntegerOr;
-begin
-  FP.Expression:='2 or 1';
-  AssertNotNull('Have result node',FP.ExprNode);
-  AssertNodeType('Constant expression',TFPBinaryOrOperation, FP.ExprNode);
-  AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression);
-  AssertResultType(rtInteger);
-  AssertResult(3);
-end;
-
-procedure TTestParserExpressions.TestSimpleBooleanNot;
-begin
-  FP.Expression:='not false';
-  AssertNotNull('Have result node',FP.ExprNode);
-  AssertNodeType('Not node',TFPNotNode, FP.ExprNode);
-  AssertOperand(FP.ExprNode,TFPConstExpression);
-  AssertResultType(rtBoolean);
-  AssertResult(true);
-end;
-
-procedure TTestParserExpressions.TestSimpleIntegerNot;
-begin
-  FP.Expression:='Not 3';
-  AssertNotNull('Have result node',FP.ExprNode);
-  AssertNodeType('Not node',TFPNotNode, FP.ExprNode);
-  AssertOperand(FP.ExprNode,TFPConstExpression);
-  AssertResultType(rtInteger);
-  AssertResult(Not Int64(3));
-end;
-
-procedure TTestParserExpressions.TestSimpleAddSeries;
-begin
-  FP.Expression:='1 + 2 + 3';
-  AssertNotNull('Have result node',FP.ExprNode);
-  AssertNodeType('Constant expression',TFPAddOperation, FP.ExprNode);
-  AssertLeftRight(FP.ExprNode,TFPAddOperation,TFPConstExpression);
-  AssertResultType(rtInteger);
-  AssertResult(6);
-end;
-
-procedure TTestParserExpressions.TestSimpleMultiplySeries;
-begin
-  FP.Expression:='2 * 3 * 4';
-  AssertNotNull('Have result node',FP.ExprNode);
-  AssertNodeType('Constant expression',TFPMultiplyOperation, FP.ExprNode);
-  AssertLeftRight(FP.ExprNode,TFPMultiplyOperation,TFPConstExpression);
-  AssertResultType(rtInteger);
-  AssertResult(24);
-end;
-
-procedure TTestParserExpressions.TestSimpleAddMultiplySeries;
-begin
-  FP.Expression:='2 * 3 + 4';
-  AssertNotNull('Have result node',FP.ExprNode);
-  AssertNodeType('Constant expression',TFPAddOperation, FP.ExprNode);
-  AssertLeftRight(FP.ExprNode,TFPMultiplyOperation,TFPConstExpression);
-  AssertResultType(rtInteger);
-  AssertResult(10);
-end;
-
-procedure TTestParserExpressions.TestSimpleAddAndSeries;
-begin
-  // 2 and (3+4)
-  FP.Expression:='2 and 3 + 4';
-  AssertNotNull('Have result node',FP.ExprNode);
-  AssertNodeType('Constant expression',TFPBinaryAndOperation, FP.ExprNode);
-  AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPAddOperation);
-  AssertResultType(rtInteger);
-  AssertResult(2);
-end;
-
-procedure TTestParserExpressions.TestSimpleAddOrSeries;
-begin
-  // 2 or (3+4)
-  FP.Expression:='2 or 3 + 4';
-  AssertNotNull('Have result node',FP.ExprNode);
-  AssertNodeType('Constant expression',TFPBinaryOrOperation, FP.ExprNode);
-  AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPAddOperation);
-  AssertResultType(rtInteger);
-  AssertResult(7);
-end;
-
-procedure TTestParserExpressions.TestSimpleOrNotSeries;
-begin
-  FP.Expression:='Not 1 or 3';
-  AssertNotNull('Have result node',FP.ExprNode);
-  AssertNodeType('Constant expression',TFPBinaryOrOperation, FP.ExprNode);
-  AssertLeftRight(FP.ExprNode,TFPNotNode,TFPConstExpression);
-  AssertResultType(rtInteger);
-  AssertResult((Not Int64(1)) or Int64(3));
-end;
-
-procedure TTestParserExpressions.TestSimpleAndNotSeries;
-begin
-  FP.Expression:='Not False and False';
-  AssertNotNull('Have result node',FP.ExprNode);
-  AssertNodeType('Constant expression',TFPBinaryAndOperation, FP.ExprNode);
-  AssertLeftRight(FP.ExprNode,TFPNotNode,TFPConstExpression);
-  AssertResultType(rtBoolean);
-  AssertResult(False);
-end;
-
-procedure TTestParserExpressions.TestDoubleAddMultiplySeries;
-begin
-  FP.Expression:='2 * 3 + 4 * 5';
-  AssertNotNull('Have result node',FP.ExprNode);
-  AssertNodeType('Constant expression',TFPAddOperation, FP.ExprNode);
-  AssertLeftRight(FP.ExprNode,TFPMultiplyOperation,TFPMultiplyOperation);
-  AssertResultType(rtInteger);
-  AssertResult(26);
-end;
-
-procedure TTestParserExpressions.TestDoubleSubtractMultiplySeries;
-begin
-  FP.Expression:='4 * 5 - 2 * 3';
-  AssertNotNull('Have result node',FP.ExprNode);
-  AssertNodeType('Constant expression',TFPSubtractOperation, FP.ExprNode);
-  AssertLeftRight(FP.ExprNode,TFPMultiplyOperation,TFPMultiplyOperation);
-  AssertResultType(rtInteger);
-  AssertResult(14);
-end;
-
-procedure TTestParserExpressions.TestSimpleIfInteger;
-begin
-  FP.Expression:='If(True,1,2)';
-  AssertNotNull('Have result node',FP.ExprNode);
-  AssertNodeType('If operation',TIfOperation, FP.ExprNode);
-  AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression);
-  AssertResultType(rtInteger);
-  AssertResult(1);
-end;
-
-procedure TTestParserExpressions.TestSimpleIfString;
-begin
-  FP.Expression:='If(True,''a'',''b'')';
-  AssertNotNull('Have result node',FP.ExprNode);
-  AssertNodeType('If operation',TIfOperation, FP.ExprNode);
-  AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression);
-  AssertResultType(rtString);
-  AssertResult('a');
-end;
-
-procedure TTestParserExpressions.TestSimpleIfFloat;
-begin
-  FP.Expression:='If(True,1.2,3.4)';
-  AssertNotNull('Have result node',FP.ExprNode);
-  AssertNodeType('If operation',TIfOperation, FP.ExprNode);
-  AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression);
-  AssertResultType(rtFloat);
-  AssertResult(1.2);
-end;
-
-procedure TTestParserExpressions.TestSimpleIfBoolean;
-begin
-  FP.Expression:='If(True,False,True)';
-  AssertNotNull('Have result node',FP.ExprNode);
-  AssertNodeType('If operation',TIfOperation, FP.ExprNode);
-  AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression);
-  AssertResultType(rtBoolean);
-  AssertResult(False);
-end;
-
-procedure TTestParserExpressions.TestSimpleIfDateTime;
-begin
-  FP.Identifiers.AddDateTimeVariable('a',Date);
-  FP.Identifiers.AddDateTimeVariable('b',Date-1);
-  FP.Expression:='If(True,a,b)';
-  AssertNotNull('Have result node',FP.ExprNode);
-  AssertNodeType('If operation',TIfOperation, FP.ExprNode);
-  AssertLeftRight(FP.ExprNode,TFPExprVariable,TFPExprVariable);
-  AssertResultType(rtDateTime);
-  AssertResult(Date);
-end;
-
-procedure TTestParserExpressions.TestSimpleIfOperation;
-begin
-  FP.Expression:='If(True,''a'',''b'')+''c''';
-  AssertNotNull('Have result node',FP.ExprNode);
-  AssertResultType(rtString);
-  AssertResult('ac');
-end;
-
-procedure TTestParserExpressions.TestSimpleBrackets;
-begin
-  FP.Expression:='(4 + 2)';
-  AssertNotNull('Have result node',FP.ExprNode);
-  AssertNodeType('Constant expression',TFPAddOperation, FP.ExprNode);
-  AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression);
-  AssertResultType(rtInteger);
-  AssertResult(6);
-end;
-
-procedure TTestParserExpressions.TestSimpleBrackets2;
-begin
-  FP.Expression:='(4 * 2)';
-  AssertNotNull('Have result node',FP.ExprNode);
-  AssertNodeType('Constant expression',TFPMultiplyOperation, FP.ExprNode);
-  AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression);
-  AssertResultType(rtInteger);
-  AssertResult(8);
-end;
-
-procedure TTestParserExpressions.TestSimpleBracketsLeft;
-begin
-  FP.Expression:='(4 + 2) * 3';
-  AssertNotNull('Have result node',FP.ExprNode);
-  AssertNodeType('Constant expression',TFPMultiplyOperation, FP.ExprNode);
-  AssertLeftRight(FP.ExprNode,TFPAddOperation,TFPConstExpression);
-  AssertResultType(rtInteger);
-  AssertResult(18);
-end;
-
-procedure TTestParserExpressions.TestSimpleBracketsRight;
-begin
-  FP.Expression:='3 * (4 + 2)';
-  AssertNotNull('Have result node',FP.ExprNode);
-  AssertNodeType('Constant expression',TFPMultiplyOperation, FP.ExprNode);
-  AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPAddOperation);
-  AssertResultType(rtInteger);
-  AssertResult(18);
-end;
-
-procedure TTestParserExpressions.TestSimpleBracketsDouble;
-begin
-  FP.Expression:='(3 + 4) * (4 + 2)';
-  AssertNotNull('Have result node',FP.ExprNode);
-  AssertNodeType('Constant expression',TFPMultiplyOperation, FP.ExprNode);
-  AssertLeftRight(FP.ExprNode,TFPAddOperation,TFPAddOperation);
-  AssertResultType(rtInteger);
-  AssertResult(42);
-end;
-
-procedure TTestParserExpressions.TestExpressionAfterClear;
-begin
-  FP.Expression:='true';
-  AssertNotNull('Have result node',FP.ExprNode);
-  AssertNodeType('Constant expression',TFPConstExpression, FP.ExprNode);
-  AssertResultType(rtBoolean);
-  AssertResult(True);
-  FP.Clear;
-  FP.Expression:='1234';
-  AssertNotNull('Have result node',FP.ExprNode);
-  AssertNodeType('Constant expression',TFPConstExpression, FP.ExprNode);
-  AssertResultType(rtInteger);
-  AssertResult(1234);
-end;
-
-//TTestParserBooleanOperations
-
-procedure TTestParserBooleanOperations.TestEqualInteger;
-begin
-  FP.Expression:='1 = 2';
-  AssertNotNull('Have result node',FP.ExprNode);
-  AssertNodeType('Constant expression',TFPEqualOperation, FP.ExprNode);
-  AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression);
-  AssertResultType(rtBoolean);
-  AssertResult(False);
-end;
-
-procedure TTestParserBooleanOperations.TestUnEqualInteger;
-begin
-  FP.Expression:='1 <> 2';
-  AssertNotNull('Have result node',FP.ExprNode);
-  AssertNodeType('Constant expression',TFPUnEqualOperation, FP.ExprNode);
-  AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression);
-  AssertResultType(rtBoolean);
-  AssertResult(True);
-end;
-
-procedure TTestParserBooleanOperations.TestEqualFloat;
-begin
-  FP.Expression:='1.2 = 2.3';
-  AssertNotNull('Have result node',FP.ExprNode);
-  AssertNodeType('Constant expression',TFPEqualOperation, FP.ExprNode);
-  AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression);
-  AssertResultType(rtBoolean);
-  AssertResult(False);
-end;
-
-procedure TTestParserBooleanOperations.TestEqualFloat2;
-begin
-  FP.Expression:='1.2 = 1.2';
-  AssertNotNull('Have result node',FP.ExprNode);
-  AssertNodeType('Constant expression',TFPEqualOperation, FP.ExprNode);
-  AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression);
-  AssertResultType(rtBoolean);
-  AssertResult(True);
-end;
-
-procedure TTestParserBooleanOperations.TestUnEqualFloat;
-begin
-  FP.Expression:='1.2 <> 2.3';
-  AssertNotNull('Have result node',FP.ExprNode);
-  AssertNodeType('Constant expression',TFPUnEqualOperation, FP.ExprNode);
-  AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression);
-  AssertResultType(rtBoolean);
-  AssertResult(True);
-end;
-procedure TTestParserBooleanOperations.TestEqualString;
-begin
-  FP.Expression:='''1.2'' = ''2.3''';
-  AssertNotNull('Have result node',FP.ExprNode);
-  AssertNodeType('Constant expression',TFPEqualOperation, FP.ExprNode);
-  AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression);
-  AssertResultType(rtBoolean);
-  AssertResult(False);
-end;
-
-procedure TTestParserBooleanOperations.TestEqualString2;
-begin
-  FP.Expression:='''1.2'' = ''1.2''';
-  AssertNotNull('Have result node',FP.ExprNode);
-  AssertNodeType('Constant expression',TFPEqualOperation, FP.ExprNode);
-  AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression);
-  AssertResultType(rtBoolean);
-  AssertResult(True);
-end;
-
-procedure TTestParserBooleanOperations.TestUnEqualString;
-begin
-  FP.Expression:='''1.2'' <> ''2.3''';
-  AssertNotNull('Have result node',FP.ExprNode);
-  AssertNodeType('Constant expression',TFPUnEqualOperation, FP.ExprNode);
-  AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression);
-  AssertResultType(rtBoolean);
-  AssertResult(True);
-end;
-
-procedure TTestParserBooleanOperations.TestUnEqualString2;
-begin
-  FP.Expression:='''aa'' <> ''AA''';
-  AssertNotNull('Have result node',FP.ExprNode);
-  AssertNodeType('Constant expression',TFPUnEqualOperation, FP.ExprNode);
-  AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression);
-  AssertResultType(rtBoolean);
-  AssertResult(True);
-end;
-
-procedure TTestParserBooleanOperations.TestEqualBoolean;
-begin
-  FP.Expression:='False = True';
-  AssertNotNull('Have result node',FP.ExprNode);
-  AssertNodeType('Constant expression',TFPEqualOperation, FP.ExprNode);
-  AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression);
-  AssertResultType(rtBoolean);
-  AssertResult(False);
-end;
-
-procedure TTestParserBooleanOperations.TestUnEqualBoolean;
-begin
-  FP.Expression:='False <> True';
-  AssertNotNull('Have result node',FP.ExprNode);
-  AssertNodeType('Constant expression',TFPUnEqualOperation, FP.ExprNode);
-  AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression);
-  AssertResultType(rtBoolean);
-  AssertResult(True);
-end;
-
-procedure TTestParserBooleanOperations.TestLessThanInteger;
-begin
-  FP.Expression:='1 < 2';
-  AssertNotNull('Have result node',FP.ExprNode);
-  AssertNodeType('Constant expression',TFPLessThanOperation, FP.ExprNode);
-  AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression);
-  AssertResultType(rtBoolean);
-  AssertResult(True);
-end;
-
-procedure TTestParserBooleanOperations.TestLessThanInteger2;
-begin
-  FP.Expression:='2 < 2';
-  AssertNotNull('Have result node',FP.ExprNode);
-  AssertNodeType('Constant expression',TFPLessThanOperation, FP.ExprNode);
-  AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression);
-  AssertResultType(rtBoolean);
-  AssertResult(False);
-end;
-
-procedure TTestParserBooleanOperations.TestLessThanEqualInteger;
-begin
-  FP.Expression:='3 <= 2';
-  AssertNotNull('Have result node',FP.ExprNode);
-  AssertNodeType('Constant expression',TFPLessThanEqualOperation, FP.ExprNode);
-  AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression);
-  AssertResultType(rtBoolean);
-  AssertResult(False);
-end;
-
-procedure TTestParserBooleanOperations.TestLessThanEqualInteger2;
-begin
-  FP.Expression:='2 <= 2';
-  AssertNotNull('Have result node',FP.ExprNode);
-  AssertNodeType('Constant expression',TFPLessThanEqualOperation, FP.ExprNode);
-  AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression);
-  AssertResultType(rtBoolean);
-  AssertResult(True);
-end;
-
-procedure TTestParserBooleanOperations.TestLessThanFloat;
-begin
-  FP.Expression:='1.2 < 2.3';
-  AssertNotNull('Have result node',FP.ExprNode);
-  AssertNodeType('Constant expression',TFPLessThanOperation, FP.ExprNode);
-  AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression);
-  AssertResultType(rtBoolean);
-  AssertResult(True);
-end;
-
-procedure TTestParserBooleanOperations.TestLessThanFloat2;
-begin
-  FP.Expression:='2.2 < 2.2';
-  AssertNotNull('Have result node',FP.ExprNode);
-  AssertNodeType('Constant expression',TFPLessThanOperation, FP.ExprNode);
-  AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression);
-  AssertResultType(rtBoolean);
-  AssertResult(False);
-end;
-
-procedure TTestParserBooleanOperations.TestLessThanEqualFloat;
-begin
-  FP.Expression:='3.1 <= 2.1';
-  AssertNotNull('Have result node',FP.ExprNode);
-  AssertNodeType('Constant expression',TFPLessThanEqualOperation, FP.ExprNode);
-  AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression);
-  AssertResultType(rtBoolean);
-  AssertResult(False);
-end;
-
-procedure TTestParserBooleanOperations.TestLessThanEqualFloat2;
-begin
-  FP.Expression:='2.1 <= 2.1';
-  AssertNotNull('Have result node',FP.ExprNode);
-  AssertNodeType('Constant expression',TFPLessThanEqualOperation, FP.ExprNode);
-  AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression);
-  AssertResultType(rtBoolean);
-  AssertResult(True);
-end;
-
-procedure TTestParserBooleanOperations.TestLessThanString;
-begin
-  FP.Expression:='''1'' < ''2''';
-  AssertNotNull('Have result node',FP.ExprNode);
-  AssertNodeType('Constant expression',TFPLessThanOperation, FP.ExprNode);
-  AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression);
-  AssertResultType(rtBoolean);
-  AssertResult(True);
-end;
-
-procedure TTestParserBooleanOperations.TestLessThanString2;
-begin
-  FP.Expression:='''2'' < ''2''';
-  AssertNotNull('Have result node',FP.ExprNode);
-  AssertNodeType('Constant expression',TFPLessThanOperation, FP.ExprNode);
-  AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression);
-  AssertResultType(rtBoolean);
-  AssertResult(False);
-end;
-
-procedure TTestParserBooleanOperations.TestLessThanEqualString;
-begin
-  FP.Expression:='''3'' <= ''2''';
-  AssertNotNull('Have result node',FP.ExprNode);
-  AssertNodeType('Constant expression',TFPLessThanEqualOperation, FP.ExprNode);
-  AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression);
-  AssertResultType(rtBoolean);
-  AssertResult(False);
-end;
-
-procedure TTestParserBooleanOperations.TestLessThanEqualString2;
-begin
-  FP.Expression:='''2'' <= ''2''';
-  AssertNotNull('Have result node',FP.ExprNode);
-  AssertNodeType('Constant expression',TFPLessThanEqualOperation, FP.ExprNode);
-  AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression);
-  AssertResultType(rtBoolean);
-  AssertResult(True);
-end;
-
-
-procedure TTestParserBooleanOperations.TestGreaterThanInteger;
-begin
-  FP.Expression:='1 > 2';
-  AssertNotNull('Have result node',FP.ExprNode);
-  AssertNodeType('Constant expression',TFPGreaterThanOperation, FP.ExprNode);
-  AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression);
-  AssertResultType(rtBoolean);
-  AssertResult(False);
-end;
-
-procedure TTestParserBooleanOperations.TestGreaterThanInteger2;
-begin
-  FP.Expression:='2 > 2';
-  AssertNotNull('Have result node',FP.ExprNode);
-  AssertNodeType('Constant expression',TFPGreaterThanOperation, FP.ExprNode);
-  AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression);
-  AssertResultType(rtBoolean);
-  AssertResult(False);
-end;
-
-procedure TTestParserBooleanOperations.TestGreaterThanEqualInteger;
-begin
-  FP.Expression:='3 >= 2';
-  AssertNotNull('Have result node',FP.ExprNode);
-  AssertNodeType('Constant expression',TFPGreaterThanEqualOperation, FP.ExprNode);
-  AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression);
-  AssertResultType(rtBoolean);
-  AssertResult(True);
-end;
-
-procedure TTestParserBooleanOperations.TestGreaterThanEqualInteger2;
-begin
-  FP.Expression:='2 >= 2';
-  AssertNotNull('Have result node',FP.ExprNode);
-  AssertNodeType('Constant expression',TFPGreaterThanEqualOperation, FP.ExprNode);
-  AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression);
-  AssertResultType(rtBoolean);
-  AssertResult(True);
-end;
-
-procedure TTestParserBooleanOperations.TestGreaterThanFloat;
-begin
-  FP.Expression:='1.2 > 2.3';
-  AssertNotNull('Have result node',FP.ExprNode);
-  AssertNodeType('Constant expression',TFPGreaterThanOperation, FP.ExprNode);
-  AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression);
-  AssertResultType(rtBoolean);
-  AssertResult(False);
-end;
-
-procedure TTestParserBooleanOperations.TestGreaterThanFloat2;
-begin
-  FP.Expression:='2.2 > 2.2';
-  AssertNotNull('Have result node',FP.ExprNode);
-  AssertNodeType('Constant expression',TFPGreaterThanOperation, FP.ExprNode);
-  AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression);
-  AssertResultType(rtBoolean);
-  AssertResult(False);
-end;
-
-procedure TTestParserBooleanOperations.TestGreaterThanEqualFloat;
-begin
-  FP.Expression:='3.1 >= 2.1';
-  AssertNotNull('Have result node',FP.ExprNode);
-  AssertNodeType('Constant expression',TFPGreaterThanEqualOperation, FP.ExprNode);
-  AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression);
-  AssertResultType(rtBoolean);
-  AssertResult(True);
-end;
-
-procedure TTestParserBooleanOperations.TestGreaterThanEqualFloat2;
-begin
-  FP.Expression:='2.1 >= 2.1';
-  AssertNotNull('Have result node',FP.ExprNode);
-  AssertNodeType('Constant expression',TFPGreaterThanEqualOperation, FP.ExprNode);
-  AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression);
-  AssertResultType(rtBoolean);
-  AssertResult(True);
-end;
-
-procedure TTestParserBooleanOperations.TestGreaterThanString;
-begin
-  FP.Expression:='''1'' > ''2''';
-  AssertNotNull('Have result node',FP.ExprNode);
-  AssertNodeType('Constant expression',TFPGreaterThanOperation, FP.ExprNode);
-  AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression);
-  AssertResultType(rtBoolean);
-  AssertResult(False);
-end;
-
-procedure TTestParserBooleanOperations.TestGreaterThanString2;
-begin
-  FP.Expression:='''2'' > ''2''';
-  AssertNotNull('Have result node',FP.ExprNode);
-  AssertNodeType('Constant expression',TFPGreaterThanOperation, FP.ExprNode);
-  AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression);
-  AssertResultType(rtBoolean);
-  AssertResult(False);
-end;
-
-procedure TTestParserBooleanOperations.TestGreaterThanEqualString;
-begin
-  FP.Expression:='''3'' >= ''2''';
-  AssertNotNull('Have result node',FP.ExprNode);
-  AssertNodeType('Constant expression',TFPGreaterThanEqualOperation, FP.ExprNode);
-  AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression);
-  AssertResultType(rtBoolean);
-  AssertResult(True);
-end;
-
-procedure TTestParserBooleanOperations.TestGreaterThanEqualString2;
-begin
-  FP.Expression:='''2'' >= ''2''';
-  AssertNotNull('Have result node',FP.ExprNode);
-  AssertNodeType('Constant expression',TFPGreaterThanEqualOperation, FP.ExprNode);
-  AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression);
-  AssertResultType(rtBoolean);
-  AssertResult(True);
-end;
-
-procedure TTestParserBooleanOperations.EqualAndSeries;
-begin
-  // (1=2) and (3=4)
-  FP.Expression:='1 = 2 and 3 = 4';
-  AssertNotNull('Have result node',FP.ExprNode);
-  AssertNodeType('Constant expression',TFPBinaryAndOperation, FP.ExprNode);
-  AssertLeftRight(FP.ExprNode,TFPEqualOperation,TFPEqualOperation);
-  AssertResultType(rtBoolean);
-  AssertResult(False);
-end;
-
-procedure TTestParserBooleanOperations.EqualAndSeries2;
-begin
-  // (1=2) and (3=4)
-  FP.Expression:='1 = 1 and 3 = 3';
-  AssertNotNull('Have result node',FP.ExprNode);
-  AssertNodeType('Constant expression',TFPBinaryAndOperation, FP.ExprNode);
-  AssertLeftRight(FP.ExprNode,TFPEqualOperation,TFPEqualOperation);
-  AssertResultType(rtBoolean);
-  AssertResult(True);
-end;
-
-procedure TTestParserBooleanOperations.EqualOrSeries;
-begin
-  // (1=2) or (3=4)
-  FP.Expression:='1 = 2 or 3 = 4';
-  AssertNotNull('Have result node',FP.ExprNode);
-  AssertNodeType('Constant expression',TFPBinaryOrOperation, FP.ExprNode);
-  AssertLeftRight(FP.ExprNode,TFPEqualOperation,TFPEqualOperation);
-  AssertResultType(rtBoolean);
-  AssertResult(False);
-end;
-
-procedure TTestParserBooleanOperations.EqualOrSeries2;
-begin
-  // (1=1) or (3=4)
-  FP.Expression:='1 = 1 or 3 = 4';
-  AssertNotNull('Have result node',FP.ExprNode);
-  AssertNodeType('Constant expression',TFPBinaryOrOperation, FP.ExprNode);
-  AssertLeftRight(FP.ExprNode,TFPEqualOperation,TFPEqualOperation);
-  AssertResultType(rtBoolean);
-  AssertResult(True);
-end;
-
-procedure TTestParserBooleanOperations.UnEqualAndSeries;
-begin
-  // (1<>2) and (3<>4)
-  FP.Expression:='1 <> 2 and 3 <> 4';
-  AssertNotNull('Have result node',FP.ExprNode);
-  AssertNodeType('Constant expression',TFPBinaryAndOperation, FP.ExprNode);
-  AssertLeftRight(FP.ExprNode,TFPUnEqualOperation,TFPUnEqualOperation);
-  AssertResultType(rtBoolean);
-  AssertResult(True);
-end;
-
-procedure TTestParserBooleanOperations.UnEqualAndSeries2;
-begin
-  // (1<>2) and (3<>4)
-  FP.Expression:='1 <> 1 and 3 <> 3';
-  AssertNotNull('Have result node',FP.ExprNode);
-  AssertNodeType('Constant expression',TFPBinaryAndOperation, FP.ExprNode);
-  AssertLeftRight(FP.ExprNode,TFPUnEqualOperation,TFPUnEqualOperation);
-  AssertResultType(rtBoolean);
-  AssertResult(False);
-end;
-
-procedure TTestParserBooleanOperations.UnEqualOrSeries;
-begin
-  // (1<>2) or (3<>4)
-  FP.Expression:='1 <> 2 or 3 <> 4';
-  AssertNotNull('Have result node',FP.ExprNode);
-  AssertNodeType('Constant expression',TFPBinaryOrOperation, FP.ExprNode);
-  AssertLeftRight(FP.ExprNode,TFPUnEqualOperation,TFPUnEqualOperation);
-  AssertResultType(rtBoolean);
-  AssertResult(True);
-end;
-
-procedure TTestParserBooleanOperations.UnEqualOrSeries2;
-begin
-  // (1<>1) or (3<>4)
-  FP.Expression:='1 <> 1 or 3 <> 4';
-  AssertNotNull('Have result node',FP.ExprNode);
-  AssertNodeType('Constant expression',TFPBinaryOrOperation, FP.ExprNode);
-  AssertLeftRight(FP.ExprNode,TFPUnEqualOperation,TFPUnEqualOperation);
-  AssertResultType(rtBoolean);
-  AssertResult(True);
-end;
-
-procedure TTestParserBooleanOperations.LessThanAndSeries;
-begin
-  // (1<2) and (3<4)
-  FP.Expression:='1 < 2 and 3 < 4';
-  AssertNotNull('Have result node',FP.ExprNode);
-  AssertNodeType('Constant expression',TFPBinaryAndOperation, FP.ExprNode);
-  AssertLeftRight(FP.ExprNode,TFPLessThanOperation,TFPLessThanOperation);
-  AssertResultType(rtBoolean);
-  AssertResult(True);
-end;
-
-procedure TTestParserBooleanOperations.LessThanAndSeries2;
-begin
-  // (1<2) and (3<4)
-  FP.Expression:='1 < 1 and 3 < 3';
-  AssertNotNull('Have result node',FP.ExprNode);
-  AssertNodeType('Constant expression',TFPBinaryAndOperation, FP.ExprNode);
-  AssertLeftRight(FP.ExprNode,TFPLessThanOperation,TFPLessThanOperation);
-  AssertResultType(rtBoolean);
-  AssertResult(False);
-end;
-
-procedure TTestParserBooleanOperations.LessThanOrSeries;
-begin
-  // (1<2) or (3<4)
-  FP.Expression:='1 < 2 or 3 < 4';
-  AssertNotNull('Have result node',FP.ExprNode);
-  AssertNodeType('Constant expression',TFPBinaryOrOperation, FP.ExprNode);
-  AssertLeftRight(FP.ExprNode,TFPLessThanOperation,TFPLessThanOperation);
-  AssertResultType(rtBoolean);
-  AssertResult(True);
-end;
-
-procedure TTestParserBooleanOperations.LessThanOrSeries2;
-begin
-  // (1<1) or (3<4)
-  FP.Expression:='1 < 1 or 3 < 4';
-  AssertNotNull('Have result node',FP.ExprNode);
-  AssertNodeType('Constant expression',TFPBinaryOrOperation, FP.ExprNode);
-  AssertLeftRight(FP.ExprNode,TFPLessThanOperation,TFPLessThanOperation);
-  AssertResultType(rtBoolean);
-  AssertResult(True);
-end;
-
-procedure TTestParserBooleanOperations.GreaterThanAndSeries;
-begin
-  // (1>2) and (3>4)
-  FP.Expression:='1 > 2 and 3 > 4';
-  AssertNotNull('Have result node',FP.ExprNode);
-  AssertNodeType('Constant expression',TFPBinaryAndOperation, FP.ExprNode);
-  AssertLeftRight(FP.ExprNode,TFPGreaterThanOperation,TFPGreaterThanOperation);
-  AssertResultType(rtBoolean);
-  AssertResult(False);
-end;
-
-procedure TTestParserBooleanOperations.GreaterThanAndSeries2;
-begin
-  // (1>2) and (3>4)
-  FP.Expression:='1 > 1 and 3 > 3';
-  AssertNotNull('Have result node',FP.ExprNode);
-  AssertNodeType('Constant expression',TFPBinaryAndOperation, FP.ExprNode);
-  AssertLeftRight(FP.ExprNode,TFPGreaterThanOperation,TFPGreaterThanOperation);
-  AssertResultType(rtBoolean);
-  AssertResult(False);
-end;
-
-procedure TTestParserBooleanOperations.GreaterThanOrSeries;
-begin
-  // (1>2) or (3>4)
-  FP.Expression:='1 > 2 or 3 > 4';
-  AssertNotNull('Have result node',FP.ExprNode);
-  AssertNodeType('Constant expression',TFPBinaryOrOperation, FP.ExprNode);
-  AssertLeftRight(FP.ExprNode,TFPGreaterThanOperation,TFPGreaterThanOperation);
-  AssertResultType(rtBoolean);
-  AssertResult(False);
-end;
-
-procedure TTestParserBooleanOperations.GreaterThanOrSeries2;
-begin
-  // (1>1) or (3>4)
-  FP.Expression:='1 > 1 or 3 > 4';
-  AssertNotNull('Have result node',FP.ExprNode);
-  AssertNodeType('Constant expression',TFPBinaryOrOperation, FP.ExprNode);
-  AssertLeftRight(FP.ExprNode,TFPGreaterThanOperation,TFPGreaterThanOperation);
-  AssertResultType(rtBoolean);
-  AssertResult(False);
-end;
-
-procedure TTestParserBooleanOperations.LessThanEqualAndSeries;
-begin
-  // (1<=2) and (3<=4)
-  FP.Expression:='1 <= 2 and 3 <= 4';
-  AssertNotNull('Have result node',FP.ExprNode);
-  AssertNodeType('Constant expression',TFPBinaryAndOperation, FP.ExprNode);
-  AssertLeftRight(FP.ExprNode,TFPLessThanEqualOperation,TFPLessThanEqualOperation);
-  AssertResultType(rtBoolean);
-  AssertResult(True);
-end;
-
-procedure TTestParserBooleanOperations.LessThanEqualAndSeries2;
-begin
-  // (1<=2) and (3<=4)
-  FP.Expression:='1 <= 1 and 3 <= 3';
-  AssertNotNull('Have result node',FP.ExprNode);
-  AssertNodeType('Constant expression',TFPBinaryAndOperation, FP.ExprNode);
-  AssertLeftRight(FP.ExprNode,TFPLessThanEqualOperation,TFPLessThanEqualOperation);
-  AssertResultType(rtBoolean);
-  AssertResult(True);
-end;
-
-procedure TTestParserBooleanOperations.LessThanEqualOrSeries;
-begin
-  // (1<=2) or (3<=4)
-  FP.Expression:='1 <= 2 or 3 <= 4';
-  AssertNotNull('Have result node',FP.ExprNode);
-  AssertNodeType('Constant expression',TFPBinaryOrOperation, FP.ExprNode);
-  AssertLeftRight(FP.ExprNode,TFPLessThanEqualOperation,TFPLessThanEqualOperation);
-  AssertResultType(rtBoolean);
-  AssertResult(True);
-end;
-
-procedure TTestParserBooleanOperations.LessThanEqualOrSeries2;
-begin
-  // (1<=1) or (3<=4)
-  FP.Expression:='1 <= 1 or 3 <= 4';
-  AssertNotNull('Have result node',FP.ExprNode);
-  AssertNodeType('Constant expression',TFPBinaryOrOperation, FP.ExprNode);
-  AssertLeftRight(FP.ExprNode,TFPLessThanEqualOperation,TFPLessThanEqualOperation);
-  AssertResultType(rtBoolean);
-  AssertResult(True);
-end;
-
-procedure TTestParserBooleanOperations.GreaterThanEqualAndSeries;
-begin
-  // (1>=2) and (3>=4)
-  FP.Expression:='1 >= 2 and 3 >= 4';
-  AssertNotNull('Have result node',FP.ExprNode);
-  AssertNodeType('Constant expression',TFPBinaryAndOperation, FP.ExprNode);
-  AssertLeftRight(FP.ExprNode,TFPGreaterThanEqualOperation,TFPGreaterThanEqualOperation);
-  AssertResultType(rtBoolean);
-  AssertResult(False);
-end;
-
-procedure TTestParserBooleanOperations.GreaterThanEqualAndSeries2;
-begin
-  // (1>=2) and (3>=4)
-  FP.Expression:='1 >= 1 and 3 >= 3';
-  AssertNotNull('Have result node',FP.ExprNode);
-  AssertNodeType('Constant expression',TFPBinaryAndOperation, FP.ExprNode);
-  AssertLeftRight(FP.ExprNode,TFPGreaterThanEqualOperation,TFPGreaterThanEqualOperation);
-  AssertResultType(rtBoolean);
-  AssertResult(True);
-end;
-
-procedure TTestParserBooleanOperations.GreaterThanEqualOrSeries;
-begin
-  // (1>=2) or (3>=4)
-  FP.Expression:='1 >= 2 or 3 >= 4';
-  AssertNotNull('Have result node',FP.ExprNode);
-  AssertNodeType('Constant expression',TFPBinaryOrOperation, FP.ExprNode);
-  AssertLeftRight(FP.ExprNode,TFPGreaterThanEqualOperation,TFPGreaterThanEqualOperation);
-  AssertResultType(rtBoolean);
-  AssertResult(False);
-end;
-
-procedure TTestParserBooleanOperations.GreaterThanEqualOrSeries2;
-begin
-  // (1>=1) or (3>=4)
-  FP.Expression:='1 >= 1 or 3 >= 4';
-  AssertNotNull('Have result node',FP.ExprNode);
-  AssertNodeType('Constant expression',TFPBinaryOrOperation, FP.ExprNode);
-  AssertLeftRight(FP.ExprNode,TFPGreaterThanEqualOperation,TFPGreaterThanEqualOperation);
-  AssertResultType(rtBoolean);
-  AssertResult(True);
-end;
-
-//TTestParserOperands
-procedure TTestParserOperands.MissingOperand1;
-begin
-  TestParser('1+');
-end;
-
-procedure TTestParserOperands.MissingOperand2;
-begin
-  TestParser('*1');
-end;
-
-procedure TTestParserOperands.MissingOperand3;
-begin
-  TestParser('1*');
-end;
-
-procedure TTestParserOperands.MissingOperand4;
-begin
-  TestParser('1+');
-end;
-
-procedure TTestParserOperands.MissingOperand5;
-begin
-  TestParser('1 and');
-end;
-
-procedure TTestParserOperands.MissingOperand6;
-begin
-  TestParser('1 or');
-end;
-
-procedure TTestParserOperands.MissingOperand7;
-begin
-  TestParser('and 1');
-end;
-
-procedure TTestParserOperands.MissingOperand8;
-begin
-  TestParser('or 1');
-end;
-
-procedure TTestParserOperands.MissingOperand9;
-begin
-  TestParser('1-');
-end;
-
-procedure TTestParserOperands.MissingOperand10;
-begin
-  TestParser('1 = ');
-end;
-
-procedure TTestParserOperands.MissingOperand11;
-begin
-  TestParser('= 1');
-end;
-
-procedure TTestParserOperands.MissingOperand12;
-begin
-  TestParser('1 <> ');
-end;
-
-procedure TTestParserOperands.MissingOperand13;
-begin
-  TestParser('<> 1');
-end;
-
-procedure TTestParserOperands.MissingOperand14;
-begin
-  TestParser('1 >= ');
-end;
-
-procedure TTestParserOperands.MissingOperand15;
-begin
-  TestParser('>= 1');
-end;
-
-procedure TTestParserOperands.MissingOperand16;
-begin
-  TestParser('1 <= ');
-end;
-
-procedure TTestParserOperands.MissingOperand17;
-begin
-  TestParser('<= 1');
-end;
-
-procedure TTestParserOperands.MissingOperand18;
-begin
-  TestParser('1 < ');
-end;
-
-procedure TTestParserOperands.MissingOperand19;
-begin
-  TestParser('< 1');
-end;
-
-procedure TTestParserOperands.MissingOperand20;
-begin
-  TestParser('1 > ');
-end;
-
-procedure TTestParserOperands.MissingOperand21;
-begin
-  TestParser('> 1');
-end;
-
-procedure TTestParserOperands.MissingBracket1;
-begin
-  TestParser('(1+3');
-end;
-
-procedure TTestParserOperands.MissingBracket2;
-begin
-  TestParser('1+3)');
-end;
-
-procedure TTestParserOperands.MissingBracket3;
-begin
-  TestParser('(1+3))');
-end;
-
-procedure TTestParserOperands.MissingBracket4;
-begin
-  TestParser('((1+3)');
-end;
-
-procedure TTestParserOperands.MissingBracket5;
-begin
-  TestParser('((1+3) 4');
-end;
-
-procedure TTestParserOperands.MissingBracket6;
-begin
-  TestParser('IF(true,1,2');
-end;
-
-procedure TTestParserOperands.MissingBracket7;
-begin
-  TestParser('case(1,1,2,4');
-end;
-
-procedure TTestParserOperands.MissingArgument1;
-begin
-  TestParser('IF(true,1)');
-end;
-
-procedure TTestParserOperands.MissingArgument2;
-begin
-  TestParser('IF(True)');
-end;
-
-procedure TTestParserOperands.MissingArgument3;
-begin
-  TestParser('case(1)');
-end;
-
-procedure TTestParserOperands.MissingArgument4;
-begin
-  TestParser('case(1,2)');
-end;
-
-procedure TTestParserOperands.MissingArgument5;
-
-begin
-  TestParser('case(1,2,3)');
-end;
-
-procedure TTestParserOperands.MissingArgument6;
-
-begin
-  TestParser('IF(true,1,2,3)');
-end;
-
-procedure TTestParserOperands.MissingArgument7;
-
-begin
-  TestParser('case(0,1,2,3,4,5,6)');
-end;
-
-procedure TTestParserTypeMatch.AccessString;
-begin
-  FP.AsString;
-end;
-
-procedure TTestParserTypeMatch.AccessInteger;
-begin
-  FP.AsInteger;
-end;
-
-procedure TTestParserTypeMatch.AccessFloat;
-begin
-  FP.AsFloat;
-end;
-
-procedure TTestParserTypeMatch.AccessDateTime;
-begin
-  FP.AsDateTime;
-end;
-
-procedure TTestParserTypeMatch.AccessBoolean;
-begin
-  FP.AsBoolean;
-end;
-
-//TTestParserTypeMatch
-procedure TTestParserTypeMatch.TestTypeMismatch1;
-begin
-  TestParser('1+''string''');
-end;
-
-procedure TTestParserTypeMatch.TestTypeMismatch2;
-begin
-  TestParser('1+True');
-end;
-
-procedure TTestParserTypeMatch.TestTypeMismatch3;
-begin
-  TestParser('True+''string''');
-end;
-
-procedure TTestParserTypeMatch.TestTypeMismatch4;
-begin
-  TestParser('1.23+''string''');
-end;
-
-procedure TTestParserTypeMatch.TestTypeMismatch5;
-begin
-  TestParser('1.23+true');
-end;
-
-procedure TTestParserTypeMatch.TestTypeMismatch6;
-begin
-  TestParser('1.23 and true');
-end;
-
-procedure TTestParserTypeMatch.TestTypeMismatch7;
-begin
-  TestParser('1.23 or true');
-end;
-
-procedure TTestParserTypeMatch.TestTypeMismatch8;
-begin
-  TestParser('''string'' or true');
-end;
-
-procedure TTestParserTypeMatch.TestTypeMismatch9;
-begin
-  TestParser('''string'' and true');
-end;
-
-procedure TTestParserTypeMatch.TestTypeMismatch10;
-begin
-  TestParser('1.23 or 1');
-end;
-
-procedure TTestParserTypeMatch.TestTypeMismatch11;
-begin
-  TestParser('1.23 and 1');
-end;
-
-procedure TTestParserTypeMatch.TestTypeMismatch12;
-begin
-  TestParser('''astring'' = 1');
-end;
-
-procedure TTestParserTypeMatch.TestTypeMismatch13;
-begin
-  TestParser('true = 1');
-end;
-
-procedure TTestParserTypeMatch.TestTypeMismatch14;
-begin
-  TestParser('true * 1');
-end;
-
-procedure TTestParserTypeMatch.TestTypeMismatch15;
-begin
-  TestParser('''astring'' * 1');
-end;
-
-procedure TTestParserTypeMatch.TestTypeMismatch16;
-begin
-  TestParser('If(1,1,1)');
-end;
-
-procedure TTestParserTypeMatch.TestTypeMismatch17;
-begin
-  TestParser('If(True,1,''3'')');
-end;
-
-procedure TTestParserTypeMatch.TestTypeMismatch18;
-begin
-  TestParser('case(1,1,''3'',1)');
-end;
-
-procedure TTestParserTypeMatch.TestTypeMismatch19;
-begin
-  TestParser('case(1,1,1,''3'')');
-end;
-
-procedure TTestParserTypeMatch.TestTypeMismatch20;
-begin
-  FP.Expression:='1';
-  AssertException('Accessing integer as string',EExprParser,@AccessString);
-end;
-
-procedure TTestParserTypeMatch.TestTypeMismatch21;
-begin
-  FP.Expression:='''a''';
-  AssertException('Accessing string as integer',EExprParser,@AccessInteger);
-end;
-
-procedure TTestParserTypeMatch.TestTypeMismatch22;
-begin
-  FP.Expression:='''a''';
-  AssertException('Accessing string as float',EExprParser,@AccessFloat);
-end;
-
-procedure TTestParserTypeMatch.TestTypeMismatch23;
-begin
-  FP.Expression:='''a''';
-  AssertException('Accessing string as boolean',EExprParser,@AccessBoolean);
-end;
-
-procedure TTestParserTypeMatch.TestTypeMismatch24;
-begin
-  FP.Expression:='''a''';
-  AssertException('Accessing string as datetime',EExprParser,@AccessDateTime);
-end;
-
-//TTestParserVariables
-
-Procedure GetDate(Var Result : TFPExpressionResult; Const Args : TExprParameterArray);
-
-begin
-  Result.resDateTime:=Date;
-end;
-
-procedure TTestParserVariables.TestVariable1;
-
-Var
-  I : TFPExprIdentifierDef;
-
-begin
-  I:=FP.Identifiers.AddVariable('a',rtBoolean,'True');
-  AssertEquals('List is dirty',True,FP.Dirty);
-  AssertNotNull('Addvariable returns result',I);
-  AssertEquals('One variable added',1,FP.Identifiers.Count);
-  AssertSame('Result equals variable added',I,FP.Identifiers[0]);
-  AssertEquals('Variable has correct resulttype',rtBoolean,I.ResultType);
-  AssertEquals('Variable has correct value','True',I.Value);
-end;
-
-procedure TTestParserVariables.TestVariable2;
-
-Var
-  I : TFPExprIdentifierDef;
-
-begin
-  I:=FP.Identifiers.AddBooleanVariable('a',False);
-  AssertEquals('List is dirty',True,FP.Dirty);
-  AssertNotNull('Addvariable returns result',I);
-  AssertEquals('One variable added',1,FP.Identifiers.Count);
-  AssertSame('Result equals variable added',I,FP.Identifiers[0]);
-  AssertEquals('Variable has correct resulttype',rtBoolean,I.ResultType);
-  AssertEquals('Variable has correct value','False',I.Value);
-end;
-
-procedure TTestParserVariables.TestVariable3;
-
-Var
-  I : TFPExprIdentifierDef;
-
-begin
-  I:=FP.Identifiers.AddIntegerVariable('a',123);
-  AssertEquals('List is dirty',True,FP.Dirty);
-  AssertNotNull('Addvariable returns result',I);
-  AssertEquals('One variable added',1,FP.Identifiers.Count);
-  AssertSame('Result equals variable added',I,FP.Identifiers[0]);
-  AssertEquals('Variable has correct resulttype',rtInteger,I.ResultType);
-  AssertEquals('Variable has correct value','123',I.Value);
-end;
-
-procedure TTestParserVariables.TestVariable4;
-
-Var
-  I : TFPExprIdentifierDef;
-
-begin
-  I:=FP.Identifiers.AddFloatVariable('a',1.23);
-  AssertEquals('List is dirty',True,FP.Dirty);
-  AssertNotNull('Addvariable returns result',I);
-  AssertEquals('One variable added',1,FP.Identifiers.Count);
-  AssertSame('Result equals variable added',I,FP.Identifiers[0]);
-  AssertEquals('Variable has correct resulttype',rtFloat,I.ResultType);
-  AssertEquals('Variable has correct value',FloatToStr(1.23, FileFormatSettings),I.Value);
-end;
-
-procedure TTestParserVariables.TestVariable5;
-
-Var
-  I : TFPExprIdentifierDef;
-
-begin
-  I:=FP.Identifiers.AddStringVariable('a','1.23');
-  AssertEquals('List is dirty',True,FP.Dirty);
-  AssertNotNull('Addvariable returns result',I);
-  AssertEquals('One variable added',1,FP.Identifiers.Count);
-  AssertSame('Result equals variable added',I,FP.Identifiers[0]);
-  AssertEquals('Variable has correct resulttype',rtString,I.ResultType);
-  AssertEquals('Variable has correct value','1.23',I.Value);
-end;
-
-procedure TTestParserVariables.TestVariable6;
-Var
-  I : TFPExprIdentifierDef;
-  D : TDateTime;
-
-begin
-  D:=Now;
-  I:=FP.Identifiers.AddDateTimeVariable('a',D);
-  AssertEquals('List is dirty',True,FP.Dirty);
-  AssertNotNull('Addvariable returns result',I);
-  AssertEquals('One variable added',1,FP.Identifiers.Count);
-  AssertSame('Result equals variable added',I,FP.Identifiers[0]);
-  AssertEquals('Variable has correct resulttype',rtDateTime,I.ResultType);
-  AssertEquals('Variable has correct value',FormatDateTime('yyyy-mm-dd hh:nn:ss',D),I.Value);
-end;
-
-procedure TTestParserVariables.AddVariabletwice;
-
-begin
-  FP.Identifiers.AddDateTimeVariable('a',Now);
-end;
-
-procedure TTestParserVariables.UnknownVariable;
-begin
-  FP.Identifiers.IdentifierByName('unknown');
-end;
-
-procedure TTestParserVariables.ReadWrongType;
-
-Var
-  Res : TFPExpressioNResult;
-
-begin
-  AssertEquals('Only one identifier',1,FP.Identifiers.Count);
-  Case FAsWrongType of
-    rtBoolean  : res.ResBoolean:=FP.Identifiers[0].AsBoolean;
-    rtString   : res.ResString:=FP.Identifiers[0].AsString;
-    rtInteger  : Res.ResInteger:=FP.Identifiers[0].AsInteger;
-    rtFloat    : Res.ResFloat:=FP.Identifiers[0].AsFloat;
-    rtCurrency : Res.ResCurrency:=FP.Identifiers[0].AsCurrency;
-    rtDateTime : Res.ResDateTime:=FP.Identifiers[0].AsDateTime;
-  end;
-end;
-
-procedure TTestParserVariables.WriteWrongType;
-
-Var
-  Res : TFPExpressioNResult;
-
-begin
-  AssertEquals('Only one identifier',1,FP.Identifiers.Count);
-  Case FAsWrongType of
-    rtBoolean  : FP.Identifiers[0].AsBoolean:=res.ResBoolean;
-    rtString   : FP.Identifiers[0].AsString:=res.ResString;
-    rtInteger  : FP.Identifiers[0].AsInteger:=Res.ResInteger;
-    rtFloat    : FP.Identifiers[0].AsFloat:=Res.ResFloat;
-    rtCurrency : FP.Identifiers[0].AsCurrency:=Res.ResCurrency;
-    rtDateTime : FP.Identifiers[0].AsDateTime:=Res.ResDateTime;
-  end;
-end;
-
-procedure TTestParserVariables.DoDummy(var Result: TFPExpressionResult;
-  const Args: TExprParameterArray);
-begin
-  // Do nothing;
-end;
-
-procedure TTestParserVariables.TestVariableAssign;
-
-Var
-  I,J : TFPExprIdentifierDef;
-
-begin
-  I:=TFPExprIdentifierDef.Create(Nil);
-  try
-    J:=TFPExprIdentifierDef.Create(Nil);
-    try
-      I.Name:='Aname';
-      I.ParameterTypes:='ISDBF';
-      I.ResultType:=rtFloat;
-      I.Value:='1.23';
-      I.OnGetFunctionValue:=@DoDummy;
-      I.OnGetFunctionValueCallBack:=@GetDate;
-      J.Assign(I);
-      AssertEquals('Names match',I.Name,J.Name);
-      AssertEquals('Parametertypes match',I.ParameterTypes,J.ParameterTypes);
-      AssertEquals('Values match',I.Value,J.Value);
-      AssertEquals('Result types match',Ord(I.ResultType),Ord(J.ResultType));
-      AssertSame('Callbacks match',Pointer(I.OnGetFunctionValueCallBack),Pointer(J.OnGetFunctionValueCallback));
-      If (I.OnGetFunctionValue)<>(J.OnGetFunctionValue) then
-        Fail('OnGetFUnctionValue as Method does not match');
-    finally
-      J.Free;
-    end;
-  finally
-    I.Free;
-  end;
-end;
-
-procedure TTestParserVariables.TestVariableAssignAgain;
-
-Var
-  I,J : TFPBuiltinExprIdentifierDef;
-
-begin
-  I:=TFPBuiltinExprIdentifierDef.Create(Nil);
-  try
-    J:=TFPBuiltinExprIdentifierDef.Create(Nil);
-    try
-      I.Name:='Aname';
-      I.ParameterTypes:='ISDBF';
-      I.ResultType:=rtFloat;
-      I.Value:='1.23';
-      I.OnGetFunctionValue:=@DoDummy;
-      I.OnGetFunctionValueCallBack:=@GetDate;
-      I.Category:=bcUser;
-      J.Assign(I);
-      AssertEquals('Names match',I.Name,J.Name);
-      AssertEquals('Parametertypes match',I.ParameterTypes,J.ParameterTypes);
-      AssertEquals('Values match',I.Value,J.Value);
-      AssertEquals('Result types match',Ord(I.ResultType),Ord(J.ResultType));
-      AssertEquals('Categories match',Ord(I.Category),Ord(J.Category));
-      AssertSame('Callbacks match',Pointer(I.OnGetFunctionValueCallBack),Pointer(J.OnGetFunctionValueCallback));
-      If (I.OnGetFunctionValue)<>(J.OnGetFunctionValue) then
-        Fail('OnGetFUnctionValue as Method does not match');
-    finally
-      J.Free;
-    end;
-  finally
-    I.Free;
-  end;
-end;
-
-procedure TTestParserVariables.TestVariable7;
-
-Var
-  I : TFPExprIdentifierDef;
-  D : TDateTime;
-
-begin
-  D:=Now;
-  I:=FP.Identifiers.AddDateTimeVariable('a',D);
-  AssertNotNull('Addvariable returns result',I);
-  AssertException('Cannot add same name twice',EExprParser,@AddVariabletwice);
-end;
-
-procedure TTestParserVariables.TestVariable8;
-
-begin
-  FP.Identifiers.AddIntegerVariable('a',123);
-  FP.Identifiers.AddIntegerVariable('b',123);
-  AssertEquals('List is dirty',True,FP.Dirty);
-  FP.BuildHashList;
-  FP.Identifiers.Delete(0);
-  AssertEquals('List is dirty',True,FP.Dirty);
-end;
-
-procedure TTestParserVariables.TestVariable9;
-
-Var
-  I : TFPExprIdentifierDef;
-
-begin
-  I:=FP.Identifiers.AddIntegerVariable('a',123);
-  AssertNotNull('Addvariable returns result',I);
-  FP.Expression:='a';
-  AssertNotNull('Have result node',FP.ExprNode);
-  AssertNodeType('Constant expression',TFPExprVariable, FP.ExprNode);
-  AssertResultType(rtInteger);
-  AssertResult(123);
-end;
-
-procedure TTestParserVariables.TestVariable10;
-
-Var
-  I : TFPExprIdentifierDef;
-
-begin
-  I:=FP.Identifiers.AddStringVariable('a','a123');
-  AssertNotNull('Addvariable returns result',I);
-  FP.Expression:='a';
-  AssertNotNull('Have result node',FP.ExprNode);
-  AssertNodeType('Constant expression',TFPExprVariable, FP.ExprNode);
-  AssertResultType(rtString);
-  AssertResult('a123');
-end;
-
-procedure TTestParserVariables.TestVariable11;
-
-Var
-  I : TFPExprIdentifierDef;
-
-begin
-  I:=FP.Identifiers.AddFloatVariable('a',1.23);
-  AssertNotNull('Addvariable returns result',I);
-  FP.Expression:='a';
-  AssertNotNull('Have result node',FP.ExprNode);
-  AssertNodeType('Constant expression',TFPExprVariable, FP.ExprNode);
-  AssertResultType(rtFloat);
-  AssertResult(1.23);
-end;
-
-procedure TTestParserVariables.TestVariable36;
-
-Var
-  I : TFPExprIdentifierDef;
-
-begin
-  I:=FP.Identifiers.AddCurrencyVariable('a',1.23);
-  AssertNotNull('Addvariable returns result',I);
-  FP.Expression:='a';
-  AssertNotNull('Have result node',FP.ExprNode);
-  AssertNodeType('Constant expression',TFPExprVariable, FP.ExprNode);
-  AssertResultType(rtCurrency);
-  AssertCurrencyResult(1.23);
-end;
-
-procedure TTestParserVariables.TestGetIdentifierNames;
-
-Var
-  L : TStringList;
-
-begin
-  L:=TStringList.Create;
-  try
-    L.Sorted:=true;
-    FP.ExtractIdentifierNames('a+b',L);
-    AssertEquals('Element count',2,L.Count);
-    AssertEquals('First element','a',L[0]);
-    AssertEquals('second element','b',L[1]);
-  finally
-    L.Free;
-  end;
-end;
-
-procedure TTestParserVariables.TestGetIdentifierNamesCallback;
-
-begin
-  FIdentifiers:=TStringList.Create;
-  try
-    TStringList(FIdentifiers).Sorted:=true;
-    FP.ExtractIdentifierNames('a+b',@AddIdentifier);
-    AssertEquals('Element count',2,FIdentifiers.Count);
-    AssertEquals('First element','a',FIdentifiers[0]);
-    AssertEquals('second element','b',FIdentifiers[1]);
-  Finally
-    FreeAndNil(FIdentifiers);
-  end;
-end;
-
-procedure TTestParserVariables.TestGetIdentifierNamesDouble;
-Var
-  L : TStringList;
-
-begin
-  L:=TStringList.Create;
-  try
-    L.Sorted:=true;
-    FP.ExtractIdentifierNames('a+(b*a)',L);
-    AssertEquals('Element count',2,L.Count);
-    AssertEquals('First element','a',L[0]);
-    AssertEquals('second element','b',L[1]);
-  finally
-    L.Free;
-  end;
-end;
-
-procedure TTestParserVariables.TestGetIdentifierNamesDoubleCallback;
-begin
-  FIdentifiers:=TStringList.Create;
-  try
-    FP.ExtractIdentifierNames('a+(b*a)',@AddIdentifier);
-    AssertEquals('Element count',3,FIdentifiers.Count);
-    AssertEquals('First element','a',FIdentifiers[0]);
-    AssertEquals('second element','b',FIdentifiers[1]);
-    AssertEquals('third element','a',FIdentifiers[2]);
-  Finally
-    FreeAndNil(FIdentifiers);
-  end;
-end;
-
-procedure TTestParserVariables.TestVariable12;
-
-Var
-  I : TFPExprIdentifierDef;
-
-begin
-  I:=FP.Identifiers.AddBooleanVariable('a',True);
-  AssertNotNull('Addvariable returns result',I);
-  FP.Expression:='a';
-  AssertNotNull('Have result node',FP.ExprNode);
-  AssertNodeType('Constant expression',TFPExprVariable, FP.ExprNode);
-  AssertResultType(rtBoolean);
-  AssertResult(True);
-end;
-
-procedure TTestParserVariables.TestVariable13;
-
-Var
-  I : TFPExprIdentifierDef;
-  D : TDateTime;
-
-begin
-  D:=Date;
-  I:=FP.Identifiers.AddDateTimeVariable('a',D);
-  AssertNotNull('Addvariable returns result',I);
-  FP.Expression:='a';
-  AssertNotNull('Have result node',FP.ExprNode);
-  AssertNodeType('Constant expression',TFPExprVariable, FP.ExprNode);
-  AssertResultType(rtDateTime);
-  AssertDateTimeResult(D);
-end;
-
-procedure TTestParserVariables.TestVariable14;
-
-Var
-  I,S : TFPExprIdentifierDef;
-
-begin
-  I:=FP.Identifiers.AddIntegerVariable('a',1);
-  FP.BuildHashList;
-  S:=FP.IdentifierByName('a');
-  AssertSame('Identifier found',I,S);
-end;
-
-procedure TTestParserVariables.TestVariable15;
-
-Var
-  I,S : TFPExprIdentifierDef;
-
-begin
-  I:=FP.Identifiers.AddIntegerVariable('a',1);
-  AssertNotNull('Addvariable returns result',I);
-  FP.BuildHashList;
-  S:=FP.IdentifierByName('A');
-  AssertSame('Identifier found',I,S);
-end;
-
-procedure TTestParserVariables.TestVariable16;
-
-Var
-  I,S : TFPExprIdentifierDef;
-
-begin
-  I:=FP.Identifiers.AddIntegerVariable('a',1);
-  AssertNotNull('Addvariable returns result',I);
-  FP.BuildHashList;
-  S:=FP.IdentifierByName('B');
-  AssertNull('Identifier not found',S);
-end;
-
-procedure TTestParserVariables.TestVariable17;
-
-Var
-  I : TFPExprIdentifierDef;
-
-begin
-  I:=FP.Identifiers.AddIntegerVariable('a',1);
-  AssertNotNull('Addvariable returns result',I);
-  FP.BuildHashList;
-  AssertException('Identifier not found',EExprParser,@unknownvariable);
-end;
-
-procedure TTestParserVariables.TestVariable18;
-
-Var
-  I,S : TFPExprIdentifierDef;
-
-begin
-  I:=FP.Identifiers.AddIntegerVariable('a',1);
-  AssertNotNull('Addvariable returns result',I);
-  S:=FP.Identifiers.FindIdentifier('B');
-  AssertNull('Identifier not found',S);
-end;
-
-procedure TTestParserVariables.TestVariable19;
-
-Var
-  I,S : TFPExprIdentifierDef;
-
-begin
-  I:=FP.Identifiers.AddIntegerVariable('a',1);
-  S:=FP.Identifiers.FindIdentifier('a');
-  AssertSame('Identifier found',I,S);
-end;
-
-procedure TTestParserVariables.TestVariable20;
-
-Var
-  I,S : TFPExprIdentifierDef;
-
-begin
-  I:=FP.Identifiers.AddIntegerVariable('a',1);
-  S:=FP.Identifiers.FindIdentifier('A');
-  AssertSame('Identifier found',I,S);
-end;
-
-procedure TTestParserVariables.TestAccess(Skip : TResultType);
-
-begin
-  TestAccess([Skip]);
-end;
-
-procedure TTestParserVariables.TestAccess(Skip : TResultTypes);
-
-Var
-  rt : TResultType;
-
-begin
-  For rt:=Low(TResultType) to High(TResultType) do
-    if Not (rt in skip) then
-      begin
-      FasWrongType:=rt;
-      AssertException('Acces as '+ResultTypeName(rt),EExprParser,@ReadWrongtype);
-      end;
-  For rt:=Low(TResultType) to High(TResultType) do
-    if Not (rt in skip) then
-      begin
-      FasWrongType:=rt;
-      AssertException('Acces as '+ResultTypeName(rt),EExprParser,@WriteWrongtype);
-      end;
-end;
-
-procedure TTestParserVariables.TestVariable21;
-begin
-  FP.IDentifiers.AddIntegerVariable('a',1);
-  TestAccess([rtInteger]);
-end;
-
-procedure TTestParserVariables.TestVariable22;
-begin
-  FP.IDentifiers.AddFloatVariable('a',1.0);
-  TestAccess([rtFloat]);
-end;
-
-procedure TTestParserVariables.TestVariable35;
-
-begin
-  FP.IDentifiers.AddCurrencyVariable('a',1.0);
-  TestAccess([rtCurrency]);
-end;
-
-procedure TTestParserVariables.TestVariable23;
-begin
-  FP.IDentifiers.AddStringVariable('a','1.0');
-  TestAccess(rtString);
-end;
-
-procedure TTestParserVariables.TestVariable24;
-begin
-  FP.IDentifiers.AddBooleanVariable('a',True);
-  TestAccess(rtBoolean);
-end;
-
-procedure TTestParserVariables.TestVariable25;
-
-begin
-  FP.IDentifiers.AddDateTimeVariable('a',Date);
-  TestAccess(rtDateTime);
-end;
-
-procedure TTestParserVariables.TestVariable26;
-
-Var
-  I : TFPExprIdentifierDef;
-
-begin
-  I:=FP.IDentifiers.AddStringVariable('a','1.0');
-  I.AsString:='12';
-  AssertEquals('Correct value','12',I.AsString);
-end;
-
-procedure TTestParserVariables.TestVariable27;
-Var
-  I : TFPExprIdentifierDef;
-
-begin
-  I:=FP.IDentifiers.AddIntegerVariable('a',10);
-  I.Asinteger:=12;
-  AssertEquals('Correct value',12,I.AsInteger);
-end;
-
-procedure TTestParserVariables.TestVariable28;
-Var
-  I : TFPExprIdentifierDef;
-
-begin
-  I:=FP.IDentifiers.AddFloatVariable('a',1.0);
-  I.AsFloat:=1.2;
-  AssertEquals('Correct value',1.2,I.AsFloat);
-end;
-
-procedure TTestParserVariables.TestVariable29;
-
-Var
-  I : TFPExprIdentifierDef;
-
-begin
-  I:=FP.IDentifiers.AddDateTimeVariable('a',Now);
-  I.AsDateTime:=Date-1;
-  AssertEquals('Correct value',Date-1,I.AsDateTime);
-end;
-
-procedure TTestParserVariables.TestVariable30;
-
-Var
-  I : TFPExprIdentifierDef;
-
-begin
-  I:=FP.Identifiers.AddBooleanVariable('a',True);
-  I.AsBoolean:=False;
-  AssertEquals('Correct value',False,I.AsBoolean);
-end;
-
-procedure TTestParserVariables.DoGetBooleanVar(var Res: TFPExpressionResult;
-  ConstRef AName: ShortString);
-
-begin
-  FEventName:=AName;
-  Res.ResBoolean:=FBoolValue;
-end;
-
-procedure TTestParserVariables.AddIdentifier(Sender: TObject; const aIdentifier: String; var aIdent : TFPExprIdentifierDef);
-begin
-  aIdent:=Nil;
-  AssertNotNull('Have identifier list',FIdentifiers);
-  FIdentifiers.Add(aIdentifier);
-end;
-
-procedure TTestParserVariables.TestVariable31;
-
-Var
-  I : TFPExprIdentifierDef;
-
-begin
-  I:=FP.Identifiers.AddVariable('a',rtBoolean,@DoGetBooleanVar);
-  AssertEquals('Correct name','a',i.Name);
-  AssertEquals('Correct type',Ord(rtBoolean),Ord(i.ResultType));
-  AssertSame(TMethod(I.OnGetVariableValue).Code,TMethod(@DoGetBooleanVar).Code);
-  FBoolValue:=True;
-  FEventName:='';
-  AssertEquals('Correct value 1',True,I.AsBoolean);
-  AssertEquals('Correct name passed','a',FEventName);
-  FBoolValue:=False;
-  FEventName:='';
-  AssertEquals('Correct value 2',False,I.AsBoolean);
-  AssertEquals('Correct name passed','a',FEventName);
-end;
-
-Var
-  FVarCallBackName: string;
-  FVarBoolValue : Boolean;
-
-procedure DoGetBooleanVar2(var Res: TFPExpressionResult; ConstRef AName: ShortString);
-
-begin
-  FVarCallBackName:=AName;
-  Res.ResBoolean:=FVarBoolValue;
-end;
-
-procedure TTestParserVariables.DoGetBooleanVarWrong(var Res: TFPExpressionResult; ConstRef AName: ShortString);
-
-begin
-  FEventName:=AName;
-  Res.ResultType:=rtInteger;
-  Res.ResInteger:=33;
-end;
-
-procedure TTestParserVariables.TestVariable32;
-Var
-  I : TFPExprIdentifierDef;
-
-begin
-  I:=FP.Identifiers.AddVariable('a',rtBoolean,@DoGetBooleanVar2);
-  AssertEquals('Correct name','a',i.Name);
-  AssertEquals('Correct type',Ord(rtBoolean),Ord(i.ResultType));
-  AssertSame(I.OnGetVariableValueCallBack,@DoGetBooleanVar2);
-  FVarBoolValue:=True;
-  FVarCallBackName:='';
-  AssertEquals('Correct value 1',True,I.AsBoolean);
-  AssertEquals('Correct name passed','a',FVarCallBackName);
-  FVarBoolValue:=False;
-  FVarCallBackName:='';
-  AssertEquals('Correct value 2',False,I.AsBoolean);
-  AssertEquals('Correct name passed','a',FVarCallBackName);
-end;
-
-procedure TTestParserVariables.DoTestVariable33;
-
-Var
-  B : Boolean;
-
-begin
-  B:=FTest33.AsBoolean;
-  AssertTrue(B in [true,False])
-end;
-
-procedure TTestParserVariables.TestVariable33;
-
-Var
-  I : TFPExprIdentifierDef;
-
-begin
-  I:=FP.Identifiers.AddVariable('a',rtBoolean,@DoGetBooleanVarWrong);
-  FTest33:=I;
-  AssertException('Changing type results in exception',EExprParser,@DoTestVariable33);
-  AssertEquals('Type is unchanged',Ord(rtBoolean),Ord(i.ResultType));
-end;
-
-
-procedure DoGetBooleanVar2Wrong(var Res: TFPExpressionResult; ConstRef AName: ShortString);
-
-begin
-  FVarCallBackName:=AName;
-  Res.ResultType:=rtInteger;
-  Res.ResInteger:=34;
-end;
-
-procedure TTestParserVariables.TestVariable34;
-
-Var
-  I : TFPExprIdentifierDef;
-
-begin
-  I:=FP.Identifiers.AddVariable('a',rtBoolean,@DoGetBooleanVar2Wrong);
-  FTest33:=I;
-  AssertException('Changing type results in exception',EExprParser,@DoTestVariable33);
-  AssertEquals('Type is unchanged',Ord(rtBoolean),Ord(i.ResultType));
-end;
-
-
-
-Procedure EchoDate(Var Result : TFPExpressionResult; Const Args : TExprParameterArray);
-
-begin
-  Result.resDateTime:=Args[0].resDateTime;
-end;
-
-Procedure EchoInteger(Var Result : TFPExpressionResult; Const Args : TExprParameterArray);
-
-begin
-  Result.resInteger:=Args[0].resInteger;
-end;
-
-Procedure EchoBoolean(Var Result : TFPExpressionResult; Const Args : TExprParameterArray);
-
-begin
-  Result.resBoolean:=Args[0].resBoolean;
-end;
-
-Procedure EchoFloat(Var Result : TFPExpressionResult; Const Args : TExprParameterArray);
-
-begin
-  Result.resFloat:=Args[0].resFloat;
-end;
-
-Procedure EchoCurrency(Var Result : TFPExpressionResult; Const Args : TExprParameterArray);
-
-begin
-  Result.resCurrency:=Args[0].resCurrency;
-end;
-
-Procedure EchoString(Var Result : TFPExpressionResult; Const Args : TExprParameterArray);
-
-begin
-  Result.resString:=Args[0].resString;
-end;
-
-Procedure TTestExpressionParser.DoEchoDate(Var Result : TFPExpressionResult; Const Args : TExprParameterArray);
-
-begin
-  Result.resDateTime:=Args[0].resDateTime;
-end;
-
-Procedure TTestExpressionParser.DoEchoInteger(Var Result : TFPExpressionResult; Const Args : TExprParameterArray);
-
-begin
-  Result.resInteger:=Args[0].resInteger;
-end;
-
-Procedure TTestExpressionParser.DoEchoBoolean(Var Result : TFPExpressionResult; Const Args : TExprParameterArray);
-
-begin
-  Result.resBoolean:=Args[0].resBoolean;
-end;
-
-Procedure TTestExpressionParser.DoEchoFloat(Var Result : TFPExpressionResult; Const Args : TExprParameterArray);
-
-begin
-  Result.resFloat:=Args[0].resFloat;
-end;
-
-Procedure TTestExpressionParser.DoEchoCurrency(Var Result : TFPExpressionResult; Const Args : TExprParameterArray);
-
-begin
-  Result.resCurrency:=Args[0].resCurrency;
-end;
-
-Procedure TTestExpressionParser.DoEchoString(Var Result : TFPExpressionResult; Const Args : TExprParameterArray);
-
-begin
-  Result.resString:=Args[0].resString;
-end;
-
-procedure TTestExpressionParser.DoGetDate(var Result: TFPExpressionResult; Const Args: TExprParameterArray);
-begin
-  Result.ResDatetime:=Date;
-end;
-
-procedure TTestExpressionParser.DoAddInteger(var Result: TFPExpressionResult; Const Args: TExprParameterArray);
-begin
-  Result.Resinteger:=Args[0].ResInteger+Args[1].ResInteger;
-end;
-
-procedure TTestExpressionParser.DoDeleteString(var Result: TFPExpressionResult; Const Args: TExprParameterArray);
-begin
-  Result.ResString:=Args[0].ResString;
-  Delete(Result.ResString,Args[1].ResInteger,Args[2].ResInteger);
-end;
-
-procedure TTestParserFunctions.TryRead;
-
-Var
-  Res : TFPExpressioNResult;
-
-begin
-  AssertEquals('Only one identifier',1,FP.Identifiers.Count);
-  Case FAccessAs of
-    rtBoolean  : res.ResBoolean:=FP.Identifiers[0].AsBoolean;
-    rtString   : res.ResString:=FP.Identifiers[0].AsString;
-    rtInteger  : Res.ResInteger:=FP.Identifiers[0].AsInteger;
-    rtFloat    : Res.ResFloat:=FP.Identifiers[0].AsFloat;
-    rtCurrency : Res.ResCurrency:=FP.Identifiers[0].AsCurrency;
-    rtDateTime : Res.ResDateTime:=FP.Identifiers[0].AsDateTime;
-  end;
-end;
-
-procedure TTestParserFunctions.TryWrite;
-
-Var
-  Res : TFPExpressioNResult;
-
-begin
-  Res:=Default(TFPExpressioNResult);
-  AssertEquals('Only one identifier',1,FP.Identifiers.Count);
-  Case FAccessAs of
-    rtBoolean  : FP.Identifiers[0].AsBoolean:=res.ResBoolean;
-    rtString   : FP.Identifiers[0].AsString:=res.ResString;
-    rtInteger  : FP.Identifiers[0].AsInteger:=Res.ResInteger;
-    rtFloat    : FP.Identifiers[0].AsFloat:=Res.ResFloat;
-    rtCurrency : FP.Identifiers[0].AsCurrency:=Res.ResCurrency;
-    rtDateTime : FP.Identifiers[0].AsDateTime:=Res.ResDateTime;
-  end;
-end;
-
-// TTestParserFunctions
-procedure TTestParserFunctions.TestFunction1;
-
-Var
-  I : TFPExprIdentifierDef;
-
-begin
-  I:=FP.Identifiers.AddFunction('Date','D','',@GetDate);
-  AssertEquals('List is dirty',True,FP.Dirty);
-  AssertNotNull('Addvariable returns result',I);
-  AssertEquals('One variable added',1,FP.Identifiers.Count);
-  AssertSame('Result equals variable added',I,FP.Identifiers[0]);
-  AssertEquals('Function has correct resulttype',rtDateTime,I.ResultType);
-  AssertSame('Function has correct address',Pointer(@GetDate),Pointer(I.OnGetFunctionValueCallBack));
-  FaccessAs:=rtDateTime;
-  AssertException('No read access',EExprParser,@TryRead);
-  AssertException('No write access',EExprParser,@TryWrite);
-end;
-
-procedure TTestParserFunctions.TestFunction2;
-
-Var
-  I : TFPExprIdentifierDef;
-
-begin
-  I:=FP.Identifiers.AddFunction('EchoDate','D','D',@EchoDate);
-  AssertEquals('List is dirty',True,FP.Dirty);
-  AssertNotNull('Addvariable returns result',I);
-  AssertEquals('One variable added',1,FP.Identifiers.Count);
-  AssertSame('Result equals variable added',I,FP.Identifiers[0]);
-  AssertEquals('Function has correct resulttype',rtDateTime,I.ResultType);
-  AssertSame('Function has correct address',Pointer(@EchoDate),Pointer(I.OnGetFunctionValueCallBack));
-end;
-
-procedure TTestParserFunctions.TestFunction3;
-
-Var
-  I : TFPExprIdentifierDef;
-
-begin
-  I:=FP.Identifiers.AddFunction('EchoInteger','I','I',@EchoInteger);
-  AssertEquals('List is dirty',True,FP.Dirty);
-  AssertNotNull('Addvariable returns result',I);
-  AssertEquals('One variable added',1,FP.Identifiers.Count);
-  AssertSame('Result equals variable added',I,FP.Identifiers[0]);
-  AssertEquals('Function has correct resulttype',rtInteger,I.ResultType);
-  AssertSame('Function has correct address',Pointer(@EchoInteger),Pointer(I.OnGetFunctionValueCallBack));
-  FaccessAs:=rtInteger;
-  AssertException('No read access',EExprParser,@TryRead);
-  AssertException('No write access',EExprParser,@TryWrite);
-end;
-
-procedure TTestParserFunctions.TestFunction4;
-
-Var
-  I : TFPExprIdentifierDef;
-
-begin
-  I:=FP.Identifiers.AddFunction('EchoBoolean','B','B',@EchoBoolean);
-  AssertEquals('List is dirty',True,FP.Dirty);
-  AssertNotNull('Addvariable returns result',I);
-  AssertEquals('One variable added',1,FP.Identifiers.Count);
-  AssertSame('Result equals variable added',I,FP.Identifiers[0]);
-  AssertEquals('Function has correct resulttype',rtBoolean,I.ResultType);
-  AssertSame('Function has correct address',Pointer(@EchoBoolean),Pointer(I.OnGetFunctionValueCallBack));
-  FaccessAs:=rtBoolean;
-  AssertException('No read access',EExprParser,@TryRead);
-  AssertException('No write access',EExprParser,@TryWrite);
-end;
-
-procedure TTestParserFunctions.TestFunction5;
-
-Var
-  I : TFPExprIdentifierDef;
-
-begin
-  I:=FP.Identifiers.AddFunction('EchoFloat','F','F',@EchoFloat);
-  AssertEquals('List is dirty',True,FP.Dirty);
-  AssertNotNull('Addvariable returns result',I);
-  AssertEquals('One variable added',1,FP.Identifiers.Count);
-  AssertSame('Result equals variable added',I,FP.Identifiers[0]);
-  AssertEquals('Function has correct resulttype',rtFloat,I.ResultType);
-  AssertSame('Function has correct address',Pointer(@EchoFloat),Pointer(I.OnGetFunctionValueCallBack));
-  FaccessAs:=rtfloat;
-  AssertException('No read access',EExprParser,@TryRead);
-  AssertException('No write access',EExprParser,@TryWrite);
-end;
-
-procedure TTestParserFunctions.TestFunction30;
-
-Var
-  I : TFPExprIdentifierDef;
-
-begin
-  I:=FP.Identifiers.AddFunction('EchoCurrency','C','C',@EchoCurrency);
-  AssertEquals('List is dirty',True,FP.Dirty);
-  AssertNotNull('Addvariable returns result',I);
-  AssertEquals('One variable added',1,FP.Identifiers.Count);
-  AssertSame('Result equals variable added',I,FP.Identifiers[0]);
-  AssertEquals('Function has correct resulttype',rtCurrency,I.ResultType);
-  AssertSame('Function has correct address',Pointer(@EchoCurrency),Pointer(I.OnGetFunctionValueCallBack));
-  FaccessAs:=rtCurrency;
-  AssertException('No read access',EExprParser,@TryRead);
-  AssertException('No write access',EExprParser,@TryWrite);
-end;
-
-procedure TTestParserFunctions.TestFunction6;
-
-Var
-  I : TFPExprIdentifierDef;
-
-begin
-  I:=FP.Identifiers.AddFunction('EchoString','S','S',@EchoString);
-  AssertEquals('List is dirty',True,FP.Dirty);
-  AssertNotNull('Addvariable returns result',I);
-  AssertEquals('One variable added',1,FP.Identifiers.Count);
-  AssertSame('Result equals variable added',I,FP.Identifiers[0]);
-  AssertEquals('Function has correct resulttype',rtString,I.ResultType);
-  AssertSame('Function has correct address',Pointer(@EchoString),Pointer(I.OnGetFunctionValueCallBack));
-  FaccessAs:=rtString;
-  AssertException('No read access',EExprParser,@TryRead);
-  AssertException('No write access',EExprParser,@TryWrite);
-end;
-
-procedure TTestParserFunctions.TestFunction7;
-
-Var
-  I : TFPExprIdentifierDef;
-
-begin
-  I:=FP.Identifiers.AddFunction('EchoDate','D','D',@DoEchoDate);
-  AssertEquals('List is dirty',True,FP.Dirty);
-  AssertNotNull('Addvariable returns result',I);
-  AssertEquals('One variable added',1,FP.Identifiers.Count);
-  AssertSame('Result equals variable added',I,FP.Identifiers[0]);
-  AssertEquals('Function has correct resulttype',rtDateTime,I.ResultType);
-//  AssertSame('Function has correct address',TMethod(@Self.DoEchoDate),TMethod(I.OnGetFunctionValue));
-end;
-
-procedure TTestParserFunctions.TestFunction8;
-
-Var
-  I : TFPExprIdentifierDef;
-
-begin
-  I:=FP.Identifiers.AddFunction('EchoInteger','I','I',@DOEchoInteger);
-  AssertEquals('List is dirty',True,FP.Dirty);
-  AssertNotNull('Addvariable returns result',I);
-  AssertEquals('One variable added',1,FP.Identifiers.Count);
-  AssertSame('Result equals variable added',I,FP.Identifiers[0]);
-  AssertEquals('Function has correct resulttype',rtInteger,I.ResultType);
-//  AssertSame('Function has correct address',Pointer(@EchoInteger),Pointer(I.OnGetFunctionValueCallBack));
-end;
-
-procedure TTestParserFunctions.TestFunction9;
-
-Var
-  I : TFPExprIdentifierDef;
-
-begin
-  I:=FP.Identifiers.AddFunction('EchoBoolean','B','B',@DoEchoBoolean);
-  AssertEquals('List is dirty',True,FP.Dirty);
-  AssertNotNull('Addvariable returns result',I);
-  AssertEquals('One variable added',1,FP.Identifiers.Count);
-  AssertSame('Result equals variable added',I,FP.Identifiers[0]);
-  AssertEquals('Function has correct resulttype',rtBoolean,I.ResultType);
-//  AssertSame('Function has correct address',Pointer(@EchoBoolean),Pointer(I.OnGetFunctionValueCallBack));
-end;
-
-procedure TTestParserFunctions.TestFunction10;
-
-Var
-  I : TFPExprIdentifierDef;
-
-begin
-  I:=FP.Identifiers.AddFunction('EchoFloat','F','F',@DoEchoFloat);
-  AssertEquals('List is dirty',True,FP.Dirty);
-  AssertNotNull('Addvariable returns result',I);
-  AssertEquals('One variable added',1,FP.Identifiers.Count);
-  AssertSame('Result equals variable added',I,FP.Identifiers[0]);
-  AssertEquals('Function has correct resulttype',rtFloat,I.ResultType);
-//  AssertSame('Function has correct address',Pointer(@EchoFloat),Pointer(I.OnGetFunctionValueCallBack));
-end;
-
-procedure TTestParserFunctions.TestFunction31;
-
-Var
-  I : TFPExprIdentifierDef;
-
-begin
-  I:=FP.Identifiers.AddFunction('EchoCurrency','C','C',@DoEchoCurrency);
-  AssertEquals('List is dirty',True,FP.Dirty);
-  AssertNotNull('Addvariable returns result',I);
-  AssertEquals('One variable added',1,FP.Identifiers.Count);
-  AssertSame('Result equals variable added',I,FP.Identifiers[0]);
-  AssertEquals('Function has correct resulttype',rtCurrency,I.ResultType);
-//  AssertSame('Function has correct address',Pointer(@EchoFloat),Pointer(I.OnGetFunctionValueCallBack));
-end;
-
-procedure TTestParserFunctions.TestFunction11;
-
-Var
-  I : TFPExprIdentifierDef;
-
-begin
-  I:=FP.Identifiers.AddFunction('EchoString','S','S',@DoEchoString);
-  AssertEquals('List is dirty',True,FP.Dirty);
-  AssertNotNull('Addvariable returns result',I);
-  AssertEquals('One variable added',1,FP.Identifiers.Count);
-  AssertSame('Result equals variable added',I,FP.Identifiers[0]);
-  AssertEquals('Function has correct resulttype',rtString,I.ResultType);
-//  AssertSame('Function has correct address',Pointer(@EchoString),Pointer(I.OnGetFunctionValueCallBack));
-end;
-
-procedure TTestParserFunctions.TestFunction12;
-
-Var
-  I : TFPExprIdentifierDef;
-  D : TDateTime;
-
-begin
-  D:=Date;
-  I:=FP.Identifiers.AddFunction('Date','D','',@GetDate);
-  AssertNotNull('Addvariable returns result',I);
-  FP.Expression:='Date';
-  AssertNotNull('Have result node',FP.ExprNode);
-  AssertNodeType('Constant expression',TFPFunctionCallBack, FP.ExprNode);
-  AssertResultType(rtDateTime);
-  AssertDateTimeResult(D);
-end;
-
-procedure TTestParserFunctions.TestFunction13;
-
-Var
-  I : TFPExprIdentifierDef;
-  D : TDateTime;
-
-begin
-  D:=Date;
-  I:=FP.Identifiers.AddDateTimeVariable('a',D);
-  AssertNotNull('Addvariable returns result',I);
-  I:=FP.Identifiers.AddFunction('EchoDate','D','D',@EchoDate);
-  AssertNotNull('Addvariable returns result',I);
-  FP.Expression:='EchoDate(a)';
-  AssertNotNull('Have result node',FP.ExprNode);
-  AssertNodeType('Constant expression',TFPFunctionCallBack, FP.ExprNode);
-  AssertResultType(rtDateTime);
-  AssertDateTimeResult(D);
-end;
-
-procedure TTestParserFunctions.TestFunction14;
-Var
-  I : TFPExprIdentifierDef;
-
-begin
-  I:=FP.Identifiers.AddFunction('EchoInteger','I','I',@EchoInteger);
-  AssertNotNull('Addvariable returns result',I);
-  FP.Expression:='EchoInteger(13)';
-  AssertNotNull('Have result node',FP.ExprNode);
-  AssertNodeType('Constant expression',TFPFunctionCallBack, FP.ExprNode);
-  AssertResultType(rtInteger);
-  AssertResult(13);
-end;
-
-procedure TTestParserFunctions.TestFunction15;
-Var
-  I : TFPExprIdentifierDef;
-
-begin
-  I:=FP.Identifiers.AddFunction('EchoBoolean','B','B',@EchoBoolean);
-  AssertNotNull('Addvariable returns result',I);
-  FP.Expression:='EchoBoolean(True)';
-  AssertNotNull('Have result node',FP.ExprNode);
-  AssertNodeType('Constant expression',TFPFunctionCallBack, FP.ExprNode);
-  AssertResultType(rtBoolean);
-  AssertResult(True);
-end;
-
-procedure TTestParserFunctions.TestFunction16;
-Var
-  I : TFPExprIdentifierDef;
-
-begin
-  I:=FP.Identifiers.AddFunction('EchoFloat','F','F',@EchoFloat);
-  AssertNotNull('Have identifier',I);
-  FP.Expression:='EchoFloat(1.234)';
-  AssertNotNull('Have result node',FP.ExprNode);
-  AssertNodeType('Constant expression',TFPFunctionCallBack, FP.ExprNode);
-  AssertResultType(rtFloat);
-  AssertResult(1.234);
-end;
-
-procedure TTestParserFunctions.TestFunction32;
-
-Var
-  I : TFPExprIdentifierDef;
-
-begin
-  // Note there will be an implicit conversion float-> currency as the const will be a float
-  I:=FP.Identifiers.AddFunction('EchoCurrency','C','C',@EchoCurrency);
-  AssertNotNull('Have identifier',I);
-  FP.Expression:='EchoCurrency(1.234)';
-  AssertNotNull('Have result node',FP.ExprNode);
-  AssertNodeType('Constant expression',TFPFunctionCallBack, FP.ExprNode);
-  AssertResultType(rtCurrency);
-  AssertCurrencyResult(1.234);
-end;
-
-procedure TTestParserFunctions.TestFunction33;
-Var
-  I : TFPExprIdentifierDef;
-
-begin
-  // Note there will be no conversion
-  I:=FP.Identifiers.AddCurrencyVariable('a',1.234);
-  AssertNotNull('Have identifier',I);
-  I:=FP.Identifiers.AddFunction('EchoCurrency','C','C',@EchoCurrency);
-  AssertNotNull('Have identifier',I);
-  FP.Expression:='EchoCurrency(a)';
-  AssertNotNull('Have result node',FP.ExprNode);
-  AssertNodeType('Constant expression',TFPFunctionCallBack, FP.ExprNode);
-  AssertResultType(rtCurrency);
-  AssertCurrencyResult(1.234);
-end;
-
-procedure TTestParserFunctions.ExprMaxOf(var Result: TFPExpressionResult; Const Args: TExprParameterArray);
-var
-  mx: Double;
-  arg: TFPExpressionResult;
-begin
-  mx := -MaxDouble;
-  for arg in Args do
-    mx := math.Max(mx, ArgToFloat(arg));
-  result.ResFloat:= mx;
-end;
-
-procedure TTestParserFunctions.ExprMinOf(var Result: TFPExpressionResult; Const Args: TExprParameterArray);
-var
-  mn: Double;
-  arg: TFPExpressionResult;
-begin
-  mn := MaxDouble;
-  for arg in Args do
-    mn := math.Min(mn, ArgToFloat(arg));
-  result.ResFloat:= mn;
-end;
-
-procedure TTestParserFunctions.ExprSumOf(var Result: TFPExpressionResult; Const Args: TExprParameterArray);
-var
-  sum: Double;
-  arg: TFPExpressionResult;
-begin
-  sum := 0;
-  for arg in Args do
-    sum := sum + ArgToFloat(arg);
-  Result.ResFloat := sum;
-end;
-
-procedure TTestParserFunctions.ExprAveOf(var Result: TFPExpressionResult; const Args: TExprParameterArray);
-var
-  sum: Double;
-  arg: TFPExpressionResult;
-begin
-  if Length(Args) = 0 then
-    raise EExprParser.Create('At least 1 value needed for calculation of average');
-  sum := 0;
-  for arg in Args do
-    sum := sum + ArgToFloat(arg);
-  Result.ResFloat := sum / Length(Args);
-end;
-
-procedure TTestParserFunctions.ExprStdDevOf(var Result: TFPExpressionResult; const Args: TExprParameterArray);
-var
-  sum, ave: Double;
-  arg: TFPExpressionResult;
-begin
-  if Length(Args) < 2 then
-    raise EExprParser.Create('At least 2 values needed for calculation of standard deviation');
-  sum := 0;
-  for arg in Args do
-    sum := sum + ArgToFloat(arg);
-  ave := sum / Length(Args);
-  sum := 0;
-  for arg in Args do
-    sum := sum + sqr(ArgToFloat(arg) - ave);
-  Result.ResFloat := sqrt(sum / (Length(Args) - 1));
-end;
-
-procedure TTestParserFunctions.TestVarArgs1;
-begin
- // FP.BuiltIns := [bcMath];
-  FP.Identifiers.AddFunction('MaxOf', 'F', 'F+', @ExprMaxOf);
-  FP.Expression := 'MaxOf(-1,2,3,4.1)';
-  AssertEquals('Result',4.1,FP.Evaluate.ResFloat,0.1);
-end;
-
-procedure TTestParserFunctions.TestVarArgs2;
-begin
-  FP.Identifiers.AddFunction('MinOf', 'F', 'F+', @ExprMinOf);
-  FP.Expression := 'MinOf(-1,2,3,4.1)';
-  AssertEquals('Result',-1,FP.Evaluate.ResFloat,0.1);
-end;
-
-procedure TTestParserFunctions.TestVarArgs3;
-begin
-  FP.Identifiers.AddFunction('SumOf', 'F', 'F+', @ExprSumOf);
-  FP.Expression := 'SumOf(-1,2,3,4.1)';
-  AssertEquals('Result',8.1,FP.Evaluate.ResFloat,0.1);
-end;
-
-procedure TTestParserFunctions.TestVarArgs4;
-begin
-  FP.Identifiers.AddFunction('AveOf', 'F', 'F+', @ExprAveOf);
-  FP.Expression := 'AveOf(-1,2,3,4.1)';
-  AssertEquals('Result',2.025,FP.Evaluate.ResFloat,0.001);
-end;
-
-procedure TTestParserFunctions.TestVarArgs5;
-begin
-  FP.Identifiers.AddFunction('StdDevOf', 'F', 'F+', @ExprStdDevOf);
-  FP.Expression := 'StdDevOf(-1,2,3,4.1)';
-  AssertEquals('Result',2.191,FP.Evaluate.ResFloat,0.001);
-end;
-
-procedure TTestParserFunctions.TestFunction17;
-
-Var
-  I : TFPExprIdentifierDef;
-
-begin
-  I:=FP.Identifiers.AddFunction('EchoString','S','S',@EchoString);
-  AssertNotNull('Have identifier',I);
-  FP.Expression:='EchoString(''Aloha'')';
-  AssertNotNull('Have result node',FP.ExprNode);
-  AssertNodeType('Constant expression',TFPFunctionCallBack, FP.ExprNode);
-  AssertResultType(rtString);
-  AssertResult('Aloha');
-end;
-
-
-procedure TTestParserFunctions.TestFunction18;
-
-Var
-  I : TFPExprIdentifierDef;
-  D : TDateTime;
-
-begin
-  D:=Date;
-  I:=FP.Identifiers.AddDateTimeVariable('a',D);
-  AssertNotNull('Have identifier',I);
-  I:=FP.Identifiers.AddFunction('EchoDate','D','D',@DoEchoDate);
-  AssertNotNull('Have identifier',I);
-  FP.Expression:='EchoDate(a)';
-  AssertNotNull('Have result node',FP.ExprNode);
-  AssertNodeType('Constant expression',TFPFunctionEventHandler, FP.ExprNode);
-  AssertResultType(rtDateTime);
-  AssertDateTimeResult(D);
-end;
-
-procedure TTestParserFunctions.TestFunction19;
-Var
-  I : TFPExprIdentifierDef;
-
-begin
-  I:=FP.Identifiers.AddFunction('EchoInteger','I','I',@DoEchoInteger);
-  AssertNotNull('Have identifier',I);
-  FP.Expression:='EchoInteger(13)';
-  AssertNotNull('Have result node',FP.ExprNode);
-  AssertNodeType('Constant expression',TFPFunctionEventHandler, FP.ExprNode);
-  AssertResultType(rtInteger);
-  AssertResult(13);
-end;
-
-procedure TTestParserFunctions.TestFunction20;
-Var
-  I : TFPExprIdentifierDef;
-
-begin
-  I:=FP.Identifiers.AddFunction('EchoBoolean','B','B',@DoEchoBoolean);
-  AssertNotNull('Have identifier',I);
-  FP.Expression:='EchoBoolean(True)';
-  AssertNotNull('Have result node',FP.ExprNode);
-  AssertNodeType('Constant expression',TFPFunctionEventHandler, FP.ExprNode);
-  AssertResultType(rtBoolean);
-  AssertResult(True);
-end;
-
-procedure TTestParserFunctions.TestFunction21;
-Var
-  I : TFPExprIdentifierDef;
-
-begin
-  I:=FP.Identifiers.AddFunction('EchoFloat','F','F',@DoEchoFloat);
-  AssertNotNull('Have identifier',I);
-  FP.Expression:='EchoFloat(1.234)';
-  AssertNotNull('Have result node',FP.ExprNode);
-  AssertNodeType('Constant expression',TFPFunctionEventHandler, FP.ExprNode);
-  AssertResultType(rtFloat);
-  AssertResult(1.234);
-end;
-
-procedure TTestParserFunctions.TestFunction22;
-Var
-  I : TFPExprIdentifierDef;
-
-begin
-  I:=FP.Identifiers.AddFunction('EchoString','S','S',@DoEchoString);
-  AssertNotNull('Have identifier',I);
-  FP.Expression:='EchoString(''Aloha'')';
-  AssertNotNull('Have result node',FP.ExprNode);
-  AssertNodeType('Constant expression',TFPFunctionEventHandler, FP.ExprNode);
-  AssertResultType(rtString);
-  AssertResult('Aloha');
-end;
-
-procedure TTestParserFunctions.TestFunction23;
-
-Var
-  I : TFPExprIdentifierDef;
-  D : TDateTime;
-
-begin
-  D:=Date;
-  I:=FP.Identifiers.AddFunction('Date','D','',@DoGetDate);
-  AssertNotNull('Have identifier',I);
-  AssertEquals('List is dirty',True,FP.Dirty);
-  AssertNotNull('Addvariable returns result',I);
-  AssertEquals('One variable added',1,FP.Identifiers.Count);
-  AssertSame('Result equals variable added',I,FP.Identifiers[0]);
-  AssertEquals('Function has correct resulttype',rtDateTime,I.ResultType);
-  FP.Expression:='Date';
-  AssertNotNull('Have result node',FP.ExprNode);
-  AssertNodeType('Constant expression',TFPFunctionEventHandler, FP.ExprNode);
-  AssertResultType(rtDateTime);
-  AssertDateTimeResult(D);
-end;
-
-procedure TTestParserFunctions.TestFunction24;
-
-Var
-  I : TFPExprIdentifierDef;
-
-begin
-  I:=FP.Identifiers.AddFunction('AddInteger','I','II',@DoAddInteger);
-  AssertNotNull('Have identifier',I);
-  AssertEquals('List is dirty',True,FP.Dirty);
-  AssertEquals('One variable added',1,FP.Identifiers.Count);
-  AssertSame('Result equals variable added',I,FP.Identifiers[0]);
-  AssertEquals('Function has correct resulttype',rtInteger,I.ResultType);
-  FP.Expression:='AddInteger(1,2)';
-  AssertNotNull('Have result node',FP.ExprNode);
-  AssertNodeType('Constant expression',TFPFunctionEventHandler, FP.ExprNode);
-  AssertResultType(rtInteger);
-  AssertResult(3);
-end;
-
-procedure TTestParserFunctions.TestFunction25;
-
-Var
-  I : TFPExprIdentifierDef;
-
-begin
-  I:=FP.Identifiers.AddFunction('Delete','S','SII',@DoDeleteString);
-  AssertEquals('List is dirty',True,FP.Dirty);
-  AssertNotNull('Have identifier',I);
-  AssertEquals('One variable added',1,FP.Identifiers.Count);
-  AssertSame('Result equals variable added',I,FP.Identifiers[0]);
-  AssertEquals('Function has correct resulttype',rtString,I.ResultType);
-  FP.Expression:='Delete(''ABCDEFGHIJ'',3,2)';
-  AssertNotNull('Have result node',FP.ExprNode);
-  AssertNodeType('Constant expression',TFPFunctionEventHandler, FP.ExprNode);
-  AssertResultType(rtString);
-  AssertResult('ABEFGHIJ');
-end;
-
-procedure TTestParserFunctions.TestFunction26;
-
-Var
-  I : TFPExprIdentifierDef;
-
-begin
-  I:=FP.Identifiers.AddFunction('AddInteger','I','II',@DoAddInteger);
-  AssertEquals('List is dirty',True,FP.Dirty);
-  AssertNotNull('Addvariable returns result',I);
-  AssertEquals('One variable added',1,FP.Identifiers.Count);
-  AssertSame('Result equals variable added',I,FP.Identifiers[0]);
-  AssertEquals('Function has correct resulttype',rtInteger,I.ResultType);
-  FP.Expression:='AddInteger(1,2+3)';
-  AssertNotNull('Have result node',FP.ExprNode);
-  AssertNodeType('Constant expression',TFPFunctionEventHandler, FP.ExprNode);
-  AssertResultType(rtInteger);
-  AssertResult(6);
-end;
-
-procedure TTestParserFunctions.TestFunction27;
-
-Var
-  I : TFPExprIdentifierDef;
-
-begin
-  I:=FP.Identifiers.AddFunction('AddInteger','I','II',@DoAddInteger);
-  AssertEquals('List is dirty',True,FP.Dirty);
-  AssertNotNull('Addvariable returns result',I);
-  AssertEquals('One variable added',1,FP.Identifiers.Count);
-  AssertSame('Result equals variable added',I,FP.Identifiers[0]);
-  AssertEquals('Function has correct resulttype',rtInteger,I.ResultType);
-  FP.Expression:='AddInteger(1+2,3*4)';
-  AssertNotNull('Have result node',FP.ExprNode);
-  AssertNodeType('Constant expression',TFPFunctionEventHandler, FP.ExprNode);
-  AssertResultType(rtInteger);
-  AssertResult(15);
-end;
-
-procedure TTestParserFunctions.TestFunction28;
-
-Var
-  I : TFPExprIdentifierDef;
-
-begin
-  I:=FP.Identifiers.AddFunction('AddInteger','I','II',@DoAddInteger);
-  AssertEquals('List is dirty',True,FP.Dirty);
-  AssertNotNull('Addvariable returns result',I);
-  AssertEquals('One variable added',1,FP.Identifiers.Count);
-  AssertSame('Result equals variable added',I,FP.Identifiers[0]);
-  AssertEquals('Function has correct resulttype',rtInteger,I.ResultType);
-  FP.Expression:='AddInteger(3 and 2,3*4)';
-  AssertNotNull('Have result node',FP.ExprNode);
-  AssertNodeType('Constant expression',TFPFunctionEventHandler, FP.ExprNode);
-  AssertResultType(rtInteger);
-  AssertResult(14);
-end;
-
-procedure TTestParserFunctions.TestFunction29;
-
-Var
-  I : TFPExprIdentifierDef;
-
-begin
-  // Test type mismatch
-  I:=FP.Identifiers.AddFunction('AddInteger','I','II',@DoAddInteger);
-  AssertNotNull('Addvariable returns result',I);
-  TestParser('AddInteger(3 and 2,''s'')');
-end;
-
-{ TTestBuiltinsManager }
-
-procedure TTestBuiltinsManager.Setup;
-begin
-  inherited Setup;
-  FM:=TExprBuiltInManager.Create(Nil);
-end;
-
-procedure TTestBuiltinsManager.Teardown;
-begin
-  FreeAndNil(FM);
-  inherited Teardown;
-end;
-
-procedure TTestBuiltinsManager.TestCreate;
-begin
-  AssertEquals('Have no builtin expressions',0,FM.IdentifierCount);
-end;
-
-procedure TTestBuiltinsManager.TestVariable1;
-
-Var
-  I : TFPBuiltinExprIdentifierDef;
-
-begin
-  I:=FM.AddVariable(bcuser,'a',rtBoolean,'True');
-  AssertNotNull('Addvariable returns result',I);
-  AssertEquals('One variable added',1,FM.IdentifierCount);
-  AssertSame('Result equals variable added',I,FM.Identifiers[0]);
-  AssertEquals('Variable has correct category',ord(bcUser),Ord(I.Category));
-  AssertEquals('Variable has correct resulttype',rtBoolean,I.ResultType);
-  AssertEquals('Variable has correct value','True',I.Value);
-end;
-
-procedure TTestBuiltinsManager.TestVariable2;
-
-Var
-  I : TFPBuiltinExprIdentifierDef;
-
-begin
-  I:=FM.AddBooleanVariable(bcUser,'a',False);
-  AssertNotNull('Addvariable returns result',I);
-  AssertEquals('One variable added',1,FM.IdentifierCount);
-  AssertSame('Result equals variable added',I,FM.Identifiers[0]);
-  AssertEquals('Variable has correct category',ord(bcUser),Ord(I.Category));
-  AssertEquals('Variable has correct resulttype',rtBoolean,I.ResultType);
-  AssertEquals('Variable has correct value','False',I.Value);
-end;
-
-procedure TTestBuiltinsManager.TestVariable3;
-
-Var
-  I : TFPBuiltinExprIdentifierDef;
-
-begin
-  I:=FM.AddIntegerVariable(bcUser,'a',123);
-  AssertNotNull('Addvariable returns result',I);
-  AssertEquals('One variable added',1,FM.IdentifierCount);
-  AssertSame('Result equals variable added',I,FM.Identifiers[0]);
-  AssertEquals('Variable has correct category',ord(bcUser),Ord(I.Category));
-  AssertEquals('Variable has correct resulttype',rtInteger,I.ResultType);
-  AssertEquals('Variable has correct value','123',I.Value);
-end;
-
-procedure TTestBuiltinsManager.TestVariable4;
-
-Var
-  I : TFPBuiltinExprIdentifierDef;
-
-begin
-  I:=FM.AddFloatVariable(bcUser,'a',1.23);
-  AssertNotNull('Addvariable returns result',I);
-  AssertEquals('One variable added',1,FM.IdentifierCount);
-  AssertSame('Result equals variable added',I,FM.Identifiers[0]);
-  AssertEquals('Variable has correct category',ord(bcUser),Ord(I.Category));
-  AssertEquals('Variable has correct resulttype',rtFloat,I.ResultType);
-  AssertEquals('Variable has correct value',FloatToStr(1.23, FileFormatSettings),I.Value);
-end;
-
-procedure TTestBuiltinsManager.TestVariable7;
-
-Var
-  I : TFPBuiltinExprIdentifierDef;
-
-begin
-  I:=FM.AddCurrencyVariable(bcUser,'a',1.23);
-  AssertNotNull('Addvariable returns result',I);
-  AssertEquals('One variable added',1,FM.IdentifierCount);
-  AssertSame('Result equals variable added',I,FM.Identifiers[0]);
-  AssertEquals('Variable has correct category',ord(bcUser),Ord(I.Category));
-  AssertEquals('Variable has correct resulttype',rtCurrency,I.ResultType);
-  AssertEquals('Variable has correct value',CurrToStr(1.23, FileFormatSettings),I.Value);
-end;
-
-procedure TTestBuiltinsManager.TestVariable5;
-
-Var
-  I : TFPBuiltinExprIdentifierDef;
-
-begin
-  I:=FM.AddStringVariable(bcUser,'a','1.23');
-  AssertNotNull('Addvariable returns result',I);
-  AssertEquals('One variable added',1,FM.IdentifierCount);
-  AssertSame('Result equals variable added',I,FM.Identifiers[0]);
-  AssertEquals('Variable has correct category',ord(bcUser),Ord(I.Category));
-  AssertEquals('Variable has correct resulttype',rtString,I.ResultType);
-  AssertEquals('Variable has correct value','1.23',I.Value);
-end;
-
-procedure TTestBuiltinsManager.TestVariable6;
-Var
-  I : TFPBuiltinExprIdentifierDef;
-  D : TDateTime;
-
-begin
-  D:=Now;
-  I:=FM.AddDateTimeVariable(bcUser,'a',D);
-  AssertNotNull('Addvariable returns result',I);
-  AssertEquals('One variable added',1,FM.IdentifierCount);
-  AssertSame('Result equals variable added',I,FM.Identifiers[0]);
-  AssertEquals('Variable has correct category',ord(bcUser),Ord(I.Category));
-  AssertEquals('Variable has correct resulttype',rtDateTime,I.ResultType);
-  AssertEquals('Variable has correct value',FormatDateTime('yyyy-mm-dd hh:nn:ss',D),I.Value);
-end;
-
-procedure TTestBuiltinsManager.TestFunction1;
-
-Var
-  I : TFPBuiltinExprIdentifierDef;
-
-begin
-  I:=FM.AddFunction(bcUser,'Date','D','',@GetDate);
-  AssertNotNull('Addvariable returns result',I);
-  AssertEquals('One variable added',1,FM.IdentifierCount);
-  AssertSame('Result equals variable added',I,FM.Identifiers[0]);
-  AssertEquals('Variable has correct category',ord(bcUser),Ord(I.Category));
-  AssertEquals('Function has correct resulttype',rtDateTime,I.ResultType);
-  AssertSame('Function has correct address',Pointer(@GetDate),Pointer(I.OnGetFunctionValueCallBack));
-end;
-
-procedure TTestBuiltinsManager.TestFunction2;
-
-Var
-  I,I2 : TFPBuiltinExprIdentifierDef;
-  ind : Integer;
-
-begin
-  FM.AddFunction(bcUser,'EchoDate','D','D',@EchoDate);
-  I:=FM.AddFunction(bcUser,'Echo','D','D',@EchoDate);
-  FM.AddFunction(bcUser,'DoEcho','D','D',@EchoDate);
-  ind:=FM.IndexOfIdentifier('Echo');
-  AssertEquals('Found identifier',1,ind);
-  I2:=FM.FindIdentifier('Echo');
-  AssertNotNull('FindIdentifier returns result',I2);
-  AssertSame('Findidentifier returns correct result',I,I2);
-  ind:=FM.IndexOfIdentifier('NoNoNo');
-  AssertEquals('Found no such identifier',-1,ind);
-  I2:=FM.FindIdentifier('NoNoNo');
-  AssertNull('FindIdentifier returns no result',I2);
-end;
-
-procedure TTestBuiltinsManager.TestDelete;
-
-begin
-  FM.AddFunction(bcUser,'EchoDate','D','D',@EchoDate);
-  FM.AddFunction(bcUser,'EchoDate2','D','D',@EchoDate);
-  FM.AddFunction(bcUser,'EchoDate3','D','D',@EchoDate);
-  AssertEquals('Count before',3,FM.IdentifierCount);
-  FM.Delete(2);
-  AssertEquals('Count after',2,FM.IdentifierCount);
-  AssertEquals('No more',-1,FM.IndexOfIdentifier('EchoDate3'));
-  AssertEquals('Left 1',0,FM.IndexOfIdentifier('EchoDate'));
-  AssertEquals('Left 2',1,FM.IndexOfIdentifier('EchoDate2'));
-end;
-
-procedure TTestBuiltinsManager.TestRemove;
-begin
-  FM.AddFunction(bcUser,'EchoDate','D','D',@EchoDate);
-  FM.AddFunction(bcUser,'EchoDate2','D','D',@EchoDate);
-  FM.AddFunction(bcUser,'EchoDate3','D','D',@EchoDate);
-  AssertEquals('Count before',3,FM.IdentifierCount);
-  AssertEquals('Result ',1,FM.Remove('EchoDate2'));
-  AssertEquals('Count after',2,FM.IdentifierCount);
-  AssertEquals('No more',-1,FM.IndexOfIdentifier('EchoDate2'));
-  AssertEquals('Left 1',0,FM.IndexOfIdentifier('EchoDate'));
-  AssertEquals('Left 2',1,FM.IndexOfIdentifier('EchoDate3'));
-  AssertEquals('Result ',-1,FM.Remove('Nono'));
-end;
-
-{ TTestBuiltins }
-
-procedure TTestBuiltins.Setup;
-begin
-  inherited Setup;
-  FM:=TExprBuiltInManager.Create(Nil);
-  FValue:=0;
-end;
-
-procedure TTestBuiltins.Teardown;
-begin
-  FreeAndNil(FM);
-  inherited Teardown;
-end;
-
-procedure TTestBuiltins.SetExpression(const AExpression: String);
-
-Var
-  Msg : String;
-
-begin
-  Msg:='';
-  try
-    FP.Expression:=AExpression;
-  except
-    On E : Exception do
-      Msg:=E.message;
-  end;
-  If (Msg<>'') then
-    Fail('Parsing of expression "'+AExpression+'" failed :'+Msg);
-end;
-
-procedure TTestBuiltins.AssertVariable(const ADefinition: String;
-  AResultType: TResultType);
-
-Var
-  I : TFPBuiltinExprIdentifierDef;
-
-begin
-  I:=FM.FindIdentifier(ADefinition);
-  AssertNotNull('Definition '+ADefinition+' is present.',I);
-  AssertEquals('Correct result type',AResultType,I.ResultType);
-end;
-
-procedure TTestBuiltins.AssertFunction(const ADefinition, AResultType,
-  ArgumentTypes: String; ACategory : TBuiltinCategory);
-
-Var
-  I : TFPBuiltinExprIdentifierDef;
-
-begin
-  I:=FM.FindIdentifier(ADefinition);
-  AssertEquals('Correct result type for test',1,Length(AResultType));
-  AssertNotNull('Definition '+ADefinition+' is present.',I);
-  AssertEquals(ADefinition+' has correct parameter types',ArgumentTypes,I.ParameterTypes);
-  AssertEquals(ADefinition+' has correct result type',CharToResultType(AResultType[1]),I.ResultType);
-  AssertEquals(ADefinition+' has correct category',Ord(ACategory),Ord(I.Category));
-end;
-
-procedure TTestBuiltins.AssertExpression(const AExpression: String;
-  AResult: Int64);
-
-begin
-  FP.BuiltIns:=AllBuiltIns;
-  SetExpression(AExpression);
-  AssertResult(AResult);
-end;
-
-procedure TTestBuiltins.AssertExpression(const AExpression: String;
-  const AResult: String);
-begin
-  FP.BuiltIns:=AllBuiltIns;
-  SetExpression(AExpression);
-  AssertResult(AResult);
-end;
-
-procedure TTestBuiltins.AssertExpression(const AExpression: String;
-  const AResult: TExprFloat);
-begin
-  FP.BuiltIns:=AllBuiltIns;
-  SetExpression(AExpression);
-  AssertResult(AResult);
-end;
-
-procedure TTestBuiltins.AssertExpression(const AExpression: String;
-  const AResult: Boolean);
-begin
-  FP.BuiltIns:=AllBuiltIns;
-  SetExpression(AExpression);
-  AssertResult(AResult);
-end;
-
-procedure TTestBuiltins.AssertDateTimeExpression(const AExpression: String;
-  const AResult: TDateTime);
-begin
-  FP.BuiltIns:=AllBuiltIns;
-  SetExpression(AExpression);
-  AssertDatetimeResult(AResult);
-end;
-
-procedure TTestBuiltins.AssertAggregateExpression(const AExpression: String;
-  AResult: Int64; AUpdateCount: integer);
-begin
-  FP.BuiltIns:=AllBuiltIns;
-  SetExpression(AExpression);
-  AssertEquals('Has aggregate',True,FP.ExprNode.HasAggregate);
-  FP.InitAggregate;
-  While AUpdateCount>0 do
-    begin
-    FP.UpdateAggregate;
-    Dec(AUpdateCount);
-    end;
-  AssertResult(AResult);
-end;
-
-procedure TTestBuiltins.AssertAggregateExpression(const AExpression: String;
-  AResult: TExprFloat; AUpdateCount: integer);
-begin
-  FP.BuiltIns:=AllBuiltIns;
-  SetExpression(AExpression);
-  AssertEquals('Has aggregate',True,FP.ExprNode.HasAggregate);
-  FP.InitAggregate;
-  While AUpdateCount>0 do
-    begin
-    FP.UpdateAggregate;
-    Dec(AUpdateCount);
-    end;
-  AssertResult(AResult);
-end;
-
-procedure TTestBuiltins.AssertAggregateCurrExpression(Const AExpression : String; AResult : Currency; AUpdateCount : integer);
-
-begin
-  FP.BuiltIns:=AllBuiltIns;
-  SetExpression(AExpression);
-  AssertEquals('Has aggregate',True,FP.ExprNode.HasAggregate);
-  FP.InitAggregate;
-  While AUpdateCount>0 do
-    begin
-    FP.UpdateAggregate;
-    Dec(AUpdateCount);
-    end;
-  AssertCurrencyResult(AResult);
-end;
-
-procedure TTestBuiltins.TestRegister;
-
-begin
-  RegisterStdBuiltins(FM);
-  Assertvariable('pi',rtFloat);
-  AssertFunction('cos','F','F',bcMath);
-  AssertFunction('sin','F','F',bcMath);
-  AssertFunction('arctan','F','F',bcMath);
-  AssertFunction('abs','F','F',bcMath);
-  AssertFunction('sqr','F','F',bcMath);
-  AssertFunction('sqrt','F','F',bcMath);
-  AssertFunction('exp','F','F',bcMath);
-  AssertFunction('ln','F','F',bcMath);
-  AssertFunction('log','F','F',bcMath);
-  AssertFunction('frac','F','F',bcMath);
-  AssertFunction('int','F','F',bcMath);
-  AssertFunction('round','I','F',bcMath);
-  AssertFunction('trunc','I','F',bcMath);
-  AssertFunction('length','I','S',bcStrings);
-  AssertFunction('copy','S','SII',bcStrings);
-  AssertFunction('delete','S','SII',bcStrings);
-  AssertFunction('pos','I','SS',bcStrings);
-  AssertFunction('lowercase','S','S',bcStrings);
-  AssertFunction('uppercase','S','S',bcStrings);
-  AssertFunction('stringreplace','S','SSSBB',bcStrings);
-  AssertFunction('comparetext','I','SS',bcStrings);
-  AssertFunction('date','D','',bcDateTime);
-  AssertFunction('time','D','',bcDateTime);
-  AssertFunction('now','D','',bcDateTime);
-  AssertFunction('dayofweek','I','D',bcDateTime);
-  AssertFunction('extractyear','I','D',bcDateTime);
-  AssertFunction('extractmonth','I','D',bcDateTime);
-  AssertFunction('extractday','I','D',bcDateTime);
-  AssertFunction('extracthour','I','D',bcDateTime);
-  AssertFunction('extractmin','I','D',bcDateTime);
-  AssertFunction('extractsec','I','D',bcDateTime);
-  AssertFunction('extractmsec','I','D',bcDateTime);
-  AssertFunction('encodedate','D','III',bcDateTime);
-  AssertFunction('encodetime','D','IIII',bcDateTime);
-  AssertFunction('encodedatetime','D','IIIIIII',bcDateTime);
-  AssertFunction('shortdayname','S','I',bcDateTime);
-  AssertFunction('shortmonthname','S','I',bcDateTime);
-  AssertFunction('longdayname','S','I',bcDateTime);
-  AssertFunction('longmonthname','S','I',bcDateTime);
-  AssertFunction('shl','I','II',bcBoolean);
-  AssertFunction('shr','I','II',bcBoolean);
-  AssertFunction('IFS','S','BSS',bcBoolean);
-  AssertFunction('IFF','F','BFF',bcBoolean);
-  AssertFunction('IFD','D','BDD',bcBoolean);
-  AssertFunction('IFI','I','BII',bcBoolean);
-  AssertFunction('inttostr','S','I',bcConversion);
-  AssertFunction('strtoint','I','S',bcConversion);
-  AssertFunction('strtointdef','I','SI',bcConversion);
-  AssertFunction('floattostr','S','F',bcConversion);
-  AssertFunction('strtofloat','F','S',bcConversion);
-  AssertFunction('strtofloatdef','F','SF',bcConversion);
-  AssertFunction('booltostr','S','B',bcConversion);
-  AssertFunction('strtobool','B','S',bcConversion);
-  AssertFunction('strtobooldef','B','SB',bcConversion);
-  AssertFunction('datetostr','S','D',bcConversion);
-  AssertFunction('timetostr','S','D',bcConversion);
-  AssertFunction('strtodate','D','S',bcConversion);
-  AssertFunction('strtodatedef','D','SD',bcConversion);
-  AssertFunction('strtotime','D','S',bcConversion);
-  AssertFunction('strtotimedef','D','SD',bcConversion);
-  AssertFunction('strtodatetime','D','S',bcConversion);
-  AssertFunction('strtodatetimedef','D','SD',bcConversion);
-  AssertFunction('formatfloat','S','SF',bcConversion);
-  AssertFunction('formatdatetime','S','SD',bcConversion);
-  AssertFunction('sum','F','F',bcAggregate);
-  AssertFunction('count','I','',bcAggregate);
-  AssertFunction('avg','F','F',bcAggregate);
-  AssertFunction('min','F','F',bcAggregate);
-  AssertFunction('max','F','F',bcAggregate);
-  AssertEquals('Correct number of identifiers',70,FM.IdentifierCount);
-end;
-
-procedure TTestBuiltins.TestVariablepi;
-begin
-  AssertExpression('pi',Pi);
-end;
-
-procedure TTestBuiltins.TestFunctioncos;
-begin
-  AssertExpression('cos(0.5)',Cos(0.5));
-  AssertExpression('cos(0.75)',Cos(0.75));
-end;
-
-procedure TTestBuiltins.TestFunctionsin;
-begin
-  AssertExpression('sin(0.5)',sin(0.5));
-  AssertExpression('sin(0.75)',sin(0.75));
-end;
-
-procedure TTestBuiltins.TestFunctionarctan;
-begin
-  AssertExpression('arctan(0.5)',arctan(0.5));
-  AssertExpression('arctan(0.75)',arctan(0.75));
-end;
-
-procedure TTestBuiltins.TestFunctionabs;
-begin
-  AssertExpression('abs(0.5)',0.5);
-  AssertExpression('abs(-0.75)',0.75);
-end;
-
-procedure TTestBuiltins.TestFunctionsqr;
-begin
-  AssertExpression('sqr(0.5)',sqr(0.5));
-  AssertExpression('sqr(-0.75)',sqr(0.75));
-end;
-
-procedure TTestBuiltins.TestFunctionsqrt;
-begin
-  AssertExpression('sqrt(0.5)',sqrt(0.5));
-  AssertExpression('sqrt(0.75)',sqrt(0.75));
-end;
-
-procedure TTestBuiltins.TestFunctionexp;
-begin
-  AssertExpression('exp(1.0)',exp(1));
-  AssertExpression('exp(0.0)',1.0);
-end;
-
-procedure TTestBuiltins.TestFunctionln;
-begin
-  AssertExpression('ln(0.5)',ln(0.5));
-  AssertExpression('ln(1.5)',ln(1.5));
-end;
-
-procedure TTestBuiltins.TestFunctionlog;
-begin
-  AssertExpression('log(0.5)',ln(0.5)/ln(10.0));
-  AssertExpression('log(1.5)',ln(1.5)/ln(10.0));
-  AssertExpression('log(10.0)',1.0);
-end;
-
-procedure TTestBuiltins.TestFunctionfrac;
-begin
-  AssertExpression('frac(0.5)',frac(0.5));
-  AssertExpression('frac(1.5)',frac(1.5));
-end;
-
-procedure TTestBuiltins.TestFunctionint;
-begin
-  AssertExpression('int(0.5)',int(0.5));
-  AssertExpression('int(1.5)',int(1.5));
-end;
-
-procedure TTestBuiltins.TestFunctionround;
-begin
-  AssertExpression('round(0.5)',round(0.5));
-  AssertExpression('round(1.55)',round(1.55));
-end;
-
-procedure TTestBuiltins.TestFunctiontrunc;
-begin
-  AssertExpression('trunc(0.5)',trunc(0.5));
-  AssertExpression('trunc(1.55)',trunc(1.55));
-end;
-
-procedure TTestBuiltins.TestFunctionlength;
-begin
-  AssertExpression('length(''123'')',3);
-end;
-
-procedure TTestBuiltins.TestFunctioncopy;
-begin
-  AssertExpression('copy(''123456'',2,4)','2345');
-end;
-
-procedure TTestBuiltins.TestFunctiondelete;
-begin
-  AssertExpression('delete(''123456'',2,4)','16');
-end;
-
-procedure TTestBuiltins.TestFunctionpos;
-begin
-  AssertExpression('pos(''234'',''123456'')',2);
-end;
-
-procedure TTestBuiltins.TestFunctionlowercase;
-begin
-  AssertExpression('lowercase(''AbCdEf'')','abcdef');
-end;
-
-procedure TTestBuiltins.TestFunctionuppercase;
-begin
-  AssertExpression('uppercase(''AbCdEf'')','ABCDEF');
-end;
-
-procedure TTestBuiltins.TestFunctionstringreplace;
-begin
-  // last options are replaceall, ignorecase
-  AssertExpression('stringreplace(''AbCdEf'',''C'',''Z'',false,false)','AbZdEf');
-  AssertExpression('stringreplace(''AbCdEf'',''c'',''Z'',false,false)','AbCdEf');
-  AssertExpression('stringreplace(''AbCdEf'',''c'',''Z'',false,true)','AbZdEf');
-  AssertExpression('stringreplace(''AbCdEfC'',''C'',''Z'',false,false)','AbZdEfC');
-  AssertExpression('stringreplace(''AbCdEfC'',''C'',''Z'',True,false)','AbZdEfZ');
-end;
-
-procedure TTestBuiltins.TestFunctioncomparetext;
-begin
-  AssertExpression('comparetext(''AbCdEf'',''AbCdEf'')',0);
-  AssertExpression('comparetext(''AbCdEf'',''ABCDEF'')',0);
-  AssertExpression('comparetext(''AbCdEf'',''FEDCBA'')',comparetext('AbCdEf','FEDCBA'));
-end;
-
-procedure TTestBuiltins.TestFunctiondate;
-begin
-  AssertExpression('date',date);
-end;
-
-procedure TTestBuiltins.TestFunctiontime;
-begin
-  AssertExpression('time',time);
-end;
-
-procedure TTestBuiltins.TestFunctionnow;
-begin
-  AssertExpression('now',now);
-end;
-
-procedure TTestBuiltins.TestFunctiondayofweek;
-begin
-  FP.Identifiers.AddDateTimeVariable('D',Date);
-  AssertExpression('dayofweek(d)',DayOfWeek(date));
-end;
-
-procedure TTestBuiltins.TestFunctionextractyear;
-
-Var
-  Y,M,D : Word;
-
-begin
-  DecodeDate(Date,Y,M,D);
-  FP.Identifiers.AddDateTimeVariable('D',Date);
-  AssertExpression('extractyear(d)',Y);
-end;
-
-procedure TTestBuiltins.TestFunctionextractmonth;
-
-Var
-  Y,M,D : Word;
-
-begin
-  FP.Identifiers.AddDateTimeVariable('D',Date);
-  DecodeDate(Date,Y,M,D);
-  AssertExpression('extractmonth(d)',M);
-end;
-
-procedure TTestBuiltins.TestFunctionextractday;
-
-Var
-  Y,M,D : Word;
-
-begin
-  DecodeDate(Date,Y,M,D);
-  FP.Identifiers.AddDateTimeVariable('D',Date);
-  AssertExpression('extractday(d)',D);
-end;
-
-procedure TTestBuiltins.TestFunctionextracthour;
-
-Var
-  T : TDateTime;
-  H,m,s,ms : Word;
-
-begin
-  T:=Time;
-  DecodeTime(T,h,m,s,ms);
-  FP.Identifiers.AddDateTimeVariable('T',T);
-  AssertExpression('extracthour(t)',h);
-end;
-
-procedure TTestBuiltins.TestFunctionextractmin;
-Var
-  T : TDateTime;
-  H,m,s,ms : Word;
-
-begin
-  T:=Time;
-  DecodeTime(T,h,m,s,ms);
-  FP.Identifiers.AddDateTimeVariable('T',T);
-  AssertExpression('extractmin(t)',m);
-end;
-
-procedure TTestBuiltins.TestFunctionextractsec;
-Var
-  T : TDateTime;
-  H,m,s,ms : Word;
-
-begin
-  T:=Time;
-  DecodeTime(T,h,m,s,ms);
-  FP.Identifiers.AddDateTimeVariable('T',T);
-  AssertExpression('extractsec(t)',s);
-end;
-
-procedure TTestBuiltins.TestFunctionextractmsec;
-Var
-  T : TDateTime;
-  H,m,s,ms : Word;
-
-begin
-  T:=Time;
-  DecodeTime(T,h,m,s,ms);
-  FP.Identifiers.AddDateTimeVariable('T',T);
-  AssertExpression('extractmsec(t)',ms);
-end;
-
-procedure TTestBuiltins.TestFunctionencodedate;
-begin
-  AssertExpression('encodedate(2008,10,11)',EncodeDate(2008,10,11));
-end;
-
-procedure TTestBuiltins.TestFunctionencodetime;
-begin
-  AssertExpression('encodetime(14,10,11,0)',EncodeTime(14,10,11,0));
-end;
-
-procedure TTestBuiltins.TestFunctionencodedatetime;
-begin
-  AssertExpression('encodedatetime(2008,12,13,14,10,11,0)',EncodeDate(2008,12,13)+EncodeTime(14,10,11,0));
-end;
-
-procedure TTestBuiltins.TestFunctionshortdayname;
-begin
-  AssertExpression('shortdayname(1)',ShortDayNames[1]);
-  AssertExpression('shortdayname(7)',ShortDayNames[7]);
-end;
-
-procedure TTestBuiltins.TestFunctionshortmonthname;
-begin
-  AssertExpression('shortmonthname(1)',ShortMonthNames[1]);
-  AssertExpression('shortmonthname(12)',ShortMonthNames[12]);
-end;
-
-procedure TTestBuiltins.TestFunctionlongdayname;
-begin
-  AssertExpression('longdayname(1)',longDayNames[1]);
-  AssertExpression('longdayname(7)',longDayNames[7]);
-end;
-
-procedure TTestBuiltins.TestFunctionlongmonthname;
-begin
-  AssertExpression('longmonthname(1)',longMonthNames[1]);
-  AssertExpression('longmonthname(12)',longMonthNames[12]);
-end;
-
-procedure TTestBuiltins.TestFunctionformatdatetime;
-begin
-  AssertExpression('FormatDateTime(''cccc'',Date)',FormatDateTime('cccc',Date));
-end;
-
-procedure TTestBuiltins.TestFunctionshl;
-
-Var
-  I : Int64;
-
-begin
-  AssertExpression('shl(12,3)',12 shl 3);
-  I:=12 shl 30;
-  AssertExpression('shl(12,30)',I);
-end;
-
-procedure TTestBuiltins.TestFunctionshr;
-begin
-  AssertExpression('shr(12,2)',12 shr 2);
-end;
-
-procedure TTestBuiltins.TestFunctionIFS;
-begin
-  AssertExpression('ifs(true,''string1'',''string2'')','string1');
-  AssertExpression('ifs(false,''string1'',''string2'')','string2');
-end;
-
-procedure TTestBuiltins.TestFunctionIFF;
-begin
-  AssertExpression('iff(true,1.0,2.0)',1.0);
-  AssertExpression('iff(false,1.0,2.0)',2.0);
-end;
-
-procedure TTestBuiltins.TestFunctionIFD;
-begin
-  FP.Identifiers.AddDateTimeVariable('A',Date);
-  FP.Identifiers.AddDateTimeVariable('B',Date-1);
-  AssertExpression('ifd(true,A,B)',Date);
-  AssertExpression('ifd(false,A,B)',Date-1);
-end;
-
-procedure TTestBuiltins.TestFunctionIFI;
-begin
-  AssertExpression('ifi(true,1,2)',1);
-  AssertExpression('ifi(false,1,2)',2);
-end;
-
-procedure TTestBuiltins.TestFunctioninttostr;
-begin
-  AssertExpression('inttostr(2)','2');
-end;
-
-procedure TTestBuiltins.TestFunctionstrtoint;
-begin
-  AssertExpression('strtoint(''2'')',2);
-end;
-
-procedure TTestBuiltins.TestFunctionstrtointdef;
-begin
-  AssertExpression('strtointdef(''abc'',2)',2);
-end;
-
-procedure TTestBuiltins.TestFunctionfloattostr;
-begin
-  AssertExpression('floattostr(1.23)',Floattostr(1.23));
-end;
-
-procedure TTestBuiltins.TestFunctionstrtofloat;
-
-Var
-  S : String;
-
-begin
-  S:='1.23';
-  S[2]:=DecimalSeparator;
-  AssertExpression('strtofloat('''+S+''')',1.23);
-end;
-
-procedure TTestBuiltins.TestFunctionstrtofloatdef;
-
-begin
-  AssertExpression('strtofloatdef(''abc'',1.23)',1.23);
-end;
-
-procedure TTestBuiltins.TestFunctionbooltostr;
-begin
-  AssertExpression('strtofloatdef(''abc'',1.23)',1.23);
-end;
-
-procedure TTestBuiltins.TestFunctionstrtobool;
-begin
-  AssertExpression('strtobool(''0'')',false);
-end;
-
-procedure TTestBuiltins.TestFunctionstrtobooldef;
-begin
-  AssertExpression('strtobooldef(''XYZ'',True)',True);
-end;
-
-procedure TTestBuiltins.TestFunctiondatetostr;
-begin
-  FP.Identifiers.AddDateTimeVariable('A',Date);
-  AssertExpression('DateToStr(A)',DateToStr(Date));
-end;
-
-procedure TTestBuiltins.TestFunctiontimetostr;
-
-Var
-  T : TDateTime;
-
-begin
-  T:=Time;
-  FP.Identifiers.AddDateTimeVariable('A',T);
-  AssertExpression('TimeToStr(A)',TimeToStr(T));
-end;
-
-procedure TTestBuiltins.TestFunctionstrtodate;
-
-begin
-  FP.Identifiers.AddStringVariable('S',DateToStr(Date));
-  AssertExpression('StrToDate(S)',Date);
-end;
-
-procedure TTestBuiltins.TestFunctionstrtodatedef;
-begin
-  FP.Identifiers.AddDateTimeVariable('A',Date);
-  AssertExpression('StrToDateDef(''S'',A)',Date);
-end;
-
-procedure TTestBuiltins.TestFunctionstrtotime;
-
-Var
-  T : TDateTime;
-
-begin
-  T:=Time;
-  FP.Identifiers.AddStringVariable('S',TimeToStr(T));
-  AssertExpression('StrToTime(S)',T);
-end;
-
-procedure TTestBuiltins.TestFunctionstrtotimedef;
-Var
-  T : TDateTime;
-
-begin
-  T:=Time;
-  FP.Identifiers.AddDateTimeVariable('S',T);
-  AssertExpression('StrToTimeDef(''q'',S)',T);
-end;
-
-procedure TTestBuiltins.TestFunctionstrtodatetime;
-
-Var
-  T : TDateTime;
-  S : String;
-
-begin
-  T:=Now;
-  S:=DateTimetostr(T);
-  AssertExpression('StrToDateTime('''+S+''')',T);
-end;
-
-procedure TTestBuiltins.TestFunctionstrtodatetimedef;
-
-Var
-  T : TDateTime;
-  S : String;
-
-begin
-  T:=Now;
-  S:=DateTimetostr(T);
-  FP.Identifiers.AddDateTimeVariable('S',T);
-  AssertExpression('StrToDateTimeDef('''+S+''',S)',T);
-end;
-
-procedure TTestBuiltins.TestFunctionAggregateSum;
-begin
-  FP.Identifiers.AddIntegerVariable('S',2);
-  AssertAggregateExpression('sum(S)',10,5);
-end;
-
-procedure TTestBuiltins.TestFunctionAggregateSumFloat;
-begin
-  FP.Identifiers.AddFloatVariable('S',2.0);
-  AssertAggregateExpression('sum(S)',10.0,5);
-end;
-
-procedure TTestBuiltins.TestFunctionAggregateSumCurrency;
-begin
-  FP.Identifiers.AddCurrencyVariable('S',2.0);
-  AssertAggregateCurrExpression('sum(S)',Currency(10.0),5);
-end;
-
-procedure TTestBuiltins.TestFunctionAggregateCount;
-begin
-  AssertAggregateExpression('count',5,5);
-end;
-
-
-procedure TTestBuiltins.DoAverage(var Result: TFPExpressionResult; ConstRef
-  AName: ShortString);
-
-begin
-  Inc(FValue);
-  Result.ResInteger:=FValue;
-  Result.ResultType:=rtInteger;
-end;
-
-procedure TTestBuiltins.DoSeries(var Result: TFPExpressionResult; ConstRef
-  AName: ShortString);
-
-Const
-  Values : Array[1..10] of double =
-  (1.3,1.8,1.1,9.9,1.4,2.4,5.8,6.5,7.8,8.1);
-
-
-begin
-  Inc(FValue);
-  Result.ResFloat:=Values[FValue];
-  Result.ResultType:=rtFloat;
-end;
-
-procedure TTestBuiltins.TestFunctionAggregateAvg;
-begin
-  FP.Identifiers.AddVariable('S',rtInteger,@DoAverage);
-  AssertAggregateExpression('avg(S)',5.5,10);
-end;
-
-procedure TTestBuiltins.TestFunctionAggregateMin;
-begin
-  FP.Identifiers.AddVariable('S',rtFloat,@DoSeries);
-  AssertAggregateExpression('Min(S)',1.1,10);
-end;
-
-procedure TTestBuiltins.TestFunctionAggregateMax;
-begin
-  FP.Identifiers.AddVariable('S',rtFloat,@DoSeries);
-  AssertAggregateExpression('Max(S)',9.9,10);
-end;
-
-{ TTestNotNode }
-
-procedure TTestNotNode.TearDown;
-begin
-  FreeAndNil(FN);
-  inherited TearDown;
-end;
-
-procedure TTestNotNode.TestCreateInteger;
-begin
-  FN:=TFPNotNode.Create(CreateIntNode(3));
-  AssertNodeOK(FN);
-  AssertEquals('Correct node type',rtInteger,FN.NodeType);
-  AssertEquals('Correct result',Not(Int64(3)),FN.NodeValue.ResInteger);
-end;
-
-procedure TTestNotNode.TestCreateBoolean;
-begin
-  FN:=TFPNotNode.Create(CreateBoolNode(True));
-  AssertNodeOK(FN);
-  AssertEquals('Correct node type',rtBoolean,FN.NodeType);
-  AssertEquals('Correct result',False,FN.NodeValue.ResBoolean);
-end;
-
-procedure TTestNotNode.TestCreateString;
-begin
-  FN:=TFPNotNode.Create(CreateStringNode('True'));
-  AssertNodeNotOK('String node type',FN);
-end;
-
-procedure TTestNotNode.TestCreateFloat;
-begin
-  FN:=TFPNotNode.Create(CreateFloatNode(1.23));
-  AssertNodeNotOK('String node type',FN);
-end;
-
-procedure TTestNotNode.TestCreateDateTime;
-begin
-  FN:=TFPNotNode.Create(CreateDateTimeNode(Now));
-  AssertNodeNotOK('String node type',FN);
-end;
-
-procedure TTestNotNode.TestDestroy;
-begin
-  FN:=TFPNotNode.Create(TMyDestroyNode.CreateTest(Self));
-  FreeAndNil(FN);
-  AssertEquals('Destroy called for operand',1,self.FDestroyCalled)
-end;
-
-{ TTestIfOperation }
-
-procedure TTestIfOperation.TearDown;
-begin
-  FreeAndNil(FN);
-  inherited TearDown;
-end;
-
-procedure TTestIfOperation.TestCreateInteger;
-begin
-  FN:=TIfOperation.Create(CreateIntNode(1),CreateIntNode(2),CreateIntNode(3));
-  AssertNodeNotOK('First argument wrong',FN);
-end;
-
-procedure TTestIfOperation.TestCreateBoolean;
-begin
-  FN:=TIfOperation.Create(CreateBoolNode(True),CreateIntNode(2),CreateIntNode(3));
-  AssertNodeOK(FN);
-  AssertEquals('Correct node type',rtInteger,FN.NodeType);
-  AssertEquals('Correct result',2,FN.NodeValue.ResInteger);
-end;
-
-procedure TTestIfOperation.TestCreateBoolean2;
-begin
-  FN:=TIfOperation.Create(CreateBoolNode(False),CreateIntNode(2),CreateIntNode(3));
-  AssertNodeOK(FN);
-  AssertEquals('Correct node type',rtInteger,FN.NodeType);
-  AssertEquals('Correct result',3,FN.NodeValue.ResInteger);
-end;
-
-procedure TTestIfOperation.TestCreateBooleanInteger;
-begin
-  FN:=TIfOperation.Create(CreateBoolNode(False),CreateIntNode(2),CreateBoolNode(False));
-  AssertNodeNotOK('Arguments differ in type',FN);
-end;
-
-procedure TTestIfOperation.TestCreateBooleanInteger2;
-begin
-  FN:=TIfOperation.Create(CreateBoolNode(True),CreateIntNode(2),CreateIntNode(3));
-  AssertNodeOK(FN);
-  AssertEquals('Correct node type',rtInteger,FN.NodeType);
-  AssertEquals('Correct result',2,FN.NodeValue.ResInteger);
-end;
-
-procedure TTestIfOperation.TestCreateBooleanString;
-begin
-  FN:=TIfOperation.Create(CreateBoolNode(True),CreateStringNode('2'),CreateStringNode('3'));
-  AssertNodeOK(FN);
-  AssertEquals('Correct node type',rtString,FN.NodeType);
-  AssertEquals('Correct result','2',FN.NodeValue.ResString);
-end;
-
-procedure TTestIfOperation.TestCreateBooleanString2;
-begin
-  FN:=TIfOperation.Create(CreateBoolNode(False),CreateStringNode('2'),CreateStringNode('3'));
-  AssertNodeOK(FN);
-  AssertEquals('Correct node type',rtString,FN.NodeType);
-  AssertEquals('Correct result','3',FN.NodeValue.ResString);
-end;
-
-procedure TTestIfOperation.TestCreateBooleanDateTime;
-begin
-  FN:=TIfOperation.Create(CreateBoolNode(True),CreateDateTimeNode(Date),CreateDateTimeNode(Date-1));
-  AssertNodeOK(FN);
-  AssertEquals('Correct node type',rtDateTime,FN.NodeType);
-  AssertEquals('Correct result',Date,FN.NodeValue.ResDateTime);
-end;
-
-procedure TTestIfOperation.TestCreateBooleanDateTime2;
-begin
-  FN:=TIfOperation.Create(CreateBoolNode(False),CreateDateTimeNode(Date),CreateDateTimeNode(Date-1));
-  AssertNodeOK(FN);
-  AssertEquals('Correct node type',rtDateTime,FN.NodeType);
-  AssertEquals('Correct result',Date-1,FN.NodeValue.ResDateTime);
-end;
-
-procedure TTestIfOperation.TestCreateString;
-begin
-  FN:=TIfOperation.Create(CreateStringNode('1'),CreateIntNode(2),CreateIntNode(3));
-  AssertNodeNotOK('First argument wrong',FN);
-end;
-
-procedure TTestIfOperation.TestCreateFloat;
-begin
-  FN:=TIfOperation.Create(CreateFloatNode(2.0),CreateIntNode(2),CreateIntNode(3));
-  AssertNodeNotOK('First argument wrong',FN);
-end;
-
-procedure TTestIfOperation.TestCreateDateTime;
-begin
-  FN:=TIfOperation.Create(CreateDateTimeNode(Date),CreateIntNode(2),CreateIntNode(3));
-  AssertNodeNotOK('First argument wrong',FN);
-end;
-
-procedure TTestIfOperation.TestDestroy;
-begin
-  FN:=TIfOperation.Create(TMyDestroyNode.CreateTest(Self),TMyDestroyNode.CreateTest(Self),TMyDestroyNode.CreateTest(Self));
-  FreeAndNil(FN);
-  AssertEquals('Destroy called for operand',3,self.FDestroyCalled)
-end;
-
-{ TTestCaseOperation }
-
-function TTestCaseOperation.CreateArgs(
-  Args: array of const): TExprArgumentArray;
-
-Var
-  I : Integer;
-
-begin
-  Result:=Default(TExprArgumentArray);
-  SetLength(Result,High(Args)-Low(Args)+1);
-  For I:=Low(Args) to High(Args) do
-    Result[I]:=Args[i].VObject as TFPExprNode;
-end;
-
-procedure TTestCaseOperation.TearDown;
-begin
-  FreeAndNil(FN);
-  inherited TearDown;
-end;
-
-procedure TTestCaseOperation.TestCreateOne;
-begin
-  FN:=TCaseOperation.Create(CreateArgs([CreateBoolNode(False)]));
-  AssertNodeNotOK('Too little arguments',FN);
-end;
-
-procedure TTestCaseOperation.TestCreateTwo;
-begin
-  FN:=TCaseOperation.Create(CreateArgs([CreateBoolNode(False),CreateBoolNode(False)]));
-  AssertNodeNotOK('Too little arguments',FN);
-end;
-
-procedure TTestCaseOperation.TestCreateThree;
-begin
-  FN:=TCaseOperation.Create(CreateArgs([CreateBoolNode(False),CreateBoolNode(False),CreateBoolNode(False)]));
-  AssertNodeNotOK('Too little arguments',FN);
-end;
-
-procedure TTestCaseOperation.TestCreateOdd;
-begin
-  FN:=TCaseOperation.Create(CreateArgs([CreateBoolNode(False),CreateBoolNode(False),
-                                        CreateBoolNode(False),CreateBoolNode(False),
-                                        CreateBoolNode(False)]));
-  AssertNodeNotOK('Odd number of arguments',FN);
-end;
-
-procedure TTestCaseOperation.TestCreateNoExpression;
-begin
-  FN:=TCaseOperation.Create(CreateArgs([CreateBoolNode(False),
-                                        CreateBoolNode(False),
-                                        TFPBinaryOrOperation.Create(CreateBoolNode(False),CreateBoolNode(False)),
-                                        CreateBoolNode(False)]));
-  AssertNodeNotOK('Label is not a constant expression',FN);
-end;
-
-procedure TTestCaseOperation.TestCreateWrongLabel;
-begin
-  FN:=TCaseOperation.Create(CreateArgs([CreateIntNode(1),CreateBoolNode(False),
-                                        CreateIntNode(1),CreateBoolNode(False),
-                                        CreateBoolNode(True),CreateBoolNode(False)]));
-  AssertNodeNotOK('Wrong label',FN);
-end;
-
-procedure TTestCaseOperation.TestCreateWrongValue;
-begin
-  FN:=TCaseOperation.Create(CreateArgs([CreateIntNode(1),CreateBoolNode(False),
-                                        CreateIntNode(1),CreateBoolNode(False),
-                                        CreateIntNode(2),CreateIntNode(1)]));
-  AssertNodeNotOK('Wrong value',FN);
-end;
-
-procedure TTestCaseOperation.TestIntegerTag;
-begin
-  FN:=TCaseOperation.Create(CreateArgs([CreateIntNode(1),CreateStringNode('many'),
-                                        CreateIntNode(1),CreateStringNode('one'),
-                                        CreateIntNode(2),CreateStringNode('two')]));
-  AssertNodeOK(FN);
-  AssertEquals('Correct node type',rtString,FN.NodeType);
-  AssertEquals('Correct result','one',FN.NodeValue.ResString);
-end;
-
-procedure TTestCaseOperation.TestIntegerTagDefault;
-begin
-  FN:=TCaseOperation.Create(CreateArgs([CreateIntNode(3),CreateStringNode('many'),
-                                        CreateIntNode(1),CreateStringNode('one'),
-                                        CreateIntNode(2),CreateStringNode('two')]));
-  AssertNodeOK(FN);
-  AssertEquals('Correct node type',rtString,FN.NodeType);
-  AssertEquals('Correct result','many',FN.NodeValue.ResString);
-end;
-
-procedure TTestCaseOperation.TestStringTag;
-begin
-  FN:=TCaseOperation.Create(CreateArgs([CreateStringNode('one'),CreateIntNode(3),
-                                        CreateStringNode('one'),CreateIntNode(1),
-                                        CreateStringNode('two'),CreateIntNode(2)]));
-  AssertNodeOK(FN);
-  AssertEquals('Correct node type',rtInteger,FN.NodeType);
-  AssertEquals('Correct result',1,FN.NodeValue.ResInteger);
-end;
-
-procedure TTestCaseOperation.TestStringTagDefault;
-begin
-  FN:=TCaseOperation.Create(CreateArgs([CreateStringNode('many'),CreateIntNode(3),
-                                        CreateStringNode('one'),CreateIntNode(1),
-                                        CreateStringNode('two'),CreateIntNode(2)]));
-  AssertNodeOK(FN);
-  AssertEquals('Correct node type',rtInteger,FN.NodeType);
-  AssertEquals('Correct result',3,FN.NodeValue.ResInteger);
-end;
-
-procedure TTestCaseOperation.TestFloatTag;
-begin
-  FN:=TCaseOperation.Create(CreateArgs([CreateFloatNode(1.0),CreateStringNode('many'),
-                                        CreateFloatNode(1.0),CreateStringNode('one'),
-                                        CreateFloatNode(2.0),CreateStringNode('two')]));
-  AssertNodeOK(FN);
-  AssertEquals('Correct node type',rtString,FN.NodeType);
-  AssertEquals('Correct result','one',FN.NodeValue.ResString);
-end;
-
-procedure TTestCaseOperation.TestFloatTagDefault;
-begin
-  FN:=TCaseOperation.Create(CreateArgs([CreateFloatNode(3.0),CreateStringNode('many'),
-                                        CreateFloatNode(1.0),CreateStringNode('one'),
-                                        CreateFloatNode(2.0),CreateStringNode('two')]));
-  AssertNodeOK(FN);
-  AssertEquals('Correct node type',rtString,FN.NodeType);
-  AssertEquals('Correct result','many',FN.NodeValue.ResString);
-end;
-
-procedure TTestCaseOperation.TestBooleanTag;
-begin
-  FN:=TCaseOperation.Create(CreateArgs([CreateBoolNode(True),CreateStringNode('unknown'),
-                                        CreateBoolNode(True),CreateStringNode('one'),
-                                        CreateBoolNode(False),CreateStringNode('two')]));
-  AssertNodeOK(FN);
-  AssertEquals('Correct node type',rtString,FN.NodeType);
-  AssertEquals('Correct result','one',FN.NodeValue.ResString);
-end;
-
-procedure TTestCaseOperation.TestBooleanTagDefault;
-begin
-  FN:=TCaseOperation.Create(CreateArgs([CreateBoolNode(True),CreateStringNode('unknown'),
-                                        CreateBoolNode(False),CreateStringNode('two')]));
-  AssertNodeOK(FN);
-  AssertEquals('Correct node type',rtString,FN.NodeType);
-  AssertEquals('Correct result','unknown',FN.NodeValue.ResString);
-end;
-
-procedure TTestCaseOperation.TestDateTimeTag;
-begin
-  FN:=TCaseOperation.Create(CreateArgs([CreateDateTimeNode(Date),CreateStringNode('later'),
-                                        CreateDateTimeNode(Date),CreateStringNode('today'),
-                                        CreateDateTimeNode(Date+1),CreateStringNode('tomorrow')]));
-  AssertNodeOK(FN);
-  AssertEquals('Correct node type',rtString,FN.NodeType);
-  AssertEquals('Correct result','today',FN.NodeValue.ResString);
-end;
-
-procedure TTestCaseOperation.TestDateTimeTagDefault;
-begin
-  FN:=TCaseOperation.Create(CreateArgs([CreateDateTimeNode(Date+2),CreateStringNode('later'),
-                                        CreateDateTimeNode(Date),CreateStringNode('today'),
-                                        CreateDateTimeNode(Date+1),CreateStringNode('tomorrow')]));
-  AssertNodeOK(FN);
-  AssertEquals('Correct node type',rtString,FN.NodeType);
-  AssertEquals('Correct result','later',FN.NodeValue.ResString);
-end;
-
-procedure TTestCaseOperation.TestIntegerValue;
-begin
-  FN:=TCaseOperation.Create(CreateArgs([CreateIntNode(1),CreateIntNode(0),
-                                        CreateIntNode(1),CreateIntNode(-1),
-                                        CreateIntNode(2),CreateIntNode(-2)]));
-  AssertNodeOK(FN);
-  AssertEquals('Correct node type',rtInteger,FN.NodeType);
-  AssertEquals('Correct result',-1,FN.NodeValue.ResInteger);
-end;
-
-procedure TTestCaseOperation.TestIntegerValueDefault;
-begin
-  FN:=TCaseOperation.Create(CreateArgs([CreateIntNode(3),CreateIntNode(0),
-                                        CreateIntNode(1),CreateIntNode(-1),
-                                        CreateIntNode(2),CreateIntNode(-2)]));
-  AssertNodeOK(FN);
-  AssertEquals('Correct node type',rtInteger,FN.NodeType);
-  AssertEquals('Correct result',0,FN.NodeValue.ResInteger);
-end;
-
-procedure TTestCaseOperation.TestStringValue;
-begin
-  FN:=TCaseOperation.Create(CreateArgs([CreateIntNode(1),CreateStringNode('many'),
-                                        CreateIntNode(1),CreateStringNode('one'),
-                                        CreateIntNode(2),CreateStringNode('two')]));
-  AssertNodeOK(FN);
-  AssertEquals('Correct node type',rtString,FN.NodeType);
-  AssertEquals('Correct result','one',FN.NodeValue.ResString);
-end;
-
-procedure TTestCaseOperation.TestStringValueDefault;
-begin
-  FN:=TCaseOperation.Create(CreateArgs([CreateIntNode(3),CreateStringNode('many'),
-                                        CreateIntNode(1),CreateStringNode('one'),
-                                        CreateIntNode(2),CreateStringNode('two')]));
-  AssertNodeOK(FN);
-  AssertEquals('Correct node type',rtString,FN.NodeType);
-  AssertEquals('Correct result','many',FN.NodeValue.ResString);
-end;
-
-procedure TTestCaseOperation.TestFloatValue;
-begin
-  FN:=TCaseOperation.Create(CreateArgs([CreateIntNode(1),CreateFloatNode(0.0),
-                                        CreateIntNode(1),CreateFloatNode(2.0),
-                                        CreateIntNode(2),CreateFloatNode(1.0)]));
-  AssertNodeOK(FN);
-  AssertEquals('Correct node type',rtFloat,FN.NodeType);
-  AssertEquals('Correct result',2.0,FN.NodeValue.ResFloat);
-end;
-
-procedure TTestCaseOperation.TestFloatValueDefault;
-begin
-  FN:=TCaseOperation.Create(CreateArgs([CreateIntNode(3),CreateFloatNode(0.0),
-                                        CreateIntNode(1),CreateFloatNode(2.0),
-                                        CreateIntNode(2),CreateFloatNode(1.0)]));
-  AssertNodeOK(FN);
-  AssertEquals('Correct node type',rtFloat,FN.NodeType);
-  AssertEquals('Correct result',0.0,FN.NodeValue.ResFloat);
-end;
-
-procedure TTestCaseOperation.TestBooleanValue;
-begin
-  FN:=TCaseOperation.Create(CreateArgs([CreateIntNode(1),CreateBoolNode(False),
-                                        CreateIntNode(1),CreateBoolNode(True),
-                                        CreateIntNode(2),CreateBoolNode(False)]));
-  AssertNodeOK(FN);
-  AssertEquals('Correct node type',rtBoolean,FN.NodeType);
-  AssertEquals('Correct result',True,FN.NodeValue.ResBoolean);
-end;
-
-procedure TTestCaseOperation.TestBooleanValueDefault;
-begin
-  FN:=TCaseOperation.Create(CreateArgs([CreateIntNode(3),CreateBoolNode(False),
-                                        CreateIntNode(1),CreateBoolNode(True),
-                                        CreateIntNode(2),CreateBoolNode(False)]));
-  AssertNodeOK(FN);
-  AssertEquals('Correct node type',rtBoolean,FN.NodeType);
-  AssertEquals('Correct result',False,FN.NodeValue.ResBoolean);
-end;
-
-procedure TTestCaseOperation.TestDateTimeValue;
-begin
-  FN:=TCaseOperation.Create(CreateArgs([CreateIntNode(1),CreateDateTimeNode(Date+1),
-                                        CreateIntNode(1),CreateDateTimeNode(Date),
-                                        CreateIntNode(2),CreateDateTimeNode(Date-1)]));
-  AssertNodeOK(FN);
-  AssertEquals('Correct node type',rtDateTime,FN.NodeType);
-  AssertEquals('Correct result',Date,FN.NodeValue.ResDateTime);
-end;
-
-procedure TTestCaseOperation.TestDateTimeValueDefault;
-begin
-  FN:=TCaseOperation.Create(CreateArgs([CreateIntNode(3),CreateDateTimeNode(Date+1),
-                                        CreateIntNode(1),CreateDateTimeNode(Date),
-                                        CreateIntNode(2),CreateDateTimeNode(Date-1)]));
-  AssertNodeOK(FN);
-  AssertEquals('Correct node type',rtDateTime,FN.NodeType);
-  AssertEquals('Correct result',Date+1,FN.NodeValue.ResDateTime);
-end;
-
-procedure TTestCaseOperation.TestDestroy;
-begin
-  FN:=TCaseOperation.Create(CreateArgs([TMyDestroyNode.CreateTest(Self),
-                                        TMyDestroyNode.CreateTest(Self),
-                                        TMyDestroyNode.CreateTest(Self),
-                                        TMyDestroyNode.CreateTest(Self)]));
-  FreeAndNil(FN);
-  AssertEquals('Destroy called for operand',4,self.FDestroyCalled)
-end;
-
-// copy same format settings used by fpexprpars
-procedure InitFileFormatSettings;
-begin
-  FileFormatSettings := DefaultFormatSettings;
-  FileFormatSettings.DecimalSeparator := '.';
-  FileFormatSettings.DateSeparator := '-';
-  FileFormatSettings.TimeSeparator := ':';
-  FileFormatsettings.ShortDateFormat := 'yyyy-mm-dd';
-  FileFormatSettings.LongTimeFormat := 'hh:nn:ss';
-end;
-
-initialization
-  InitFileFormatSettings;
-  RegisterTests('ExprPars',[TTestExpressionScanner, TTestDestroyNode,
-                 TTestConstExprNode,TTestNegateExprNode,
-                 TTestBinaryAndNode,TTestBinaryOrNode,TTestBinaryXOrNode,
-                 TTestNotNode,TTestEqualNode,TTestUnEqualNode,
-                 TTestIfOperation,TTestCaseOperation,
-                 TTestLessThanNode,TTestLessThanEqualNode,
-                 TTestLargerThanNode,TTestLargerThanEqualNode,
-                 TTestAddNode,TTestSubtractNode,
-                 TTestMultiplyNode,TTestDivideNode,TTestPowerNode,
-                 TTestIntToFloatNode,TTestIntToDateTimeNode,
-                 TTestFloatToDateTimeNode,
-                 TTestParserExpressions, TTestParserBooleanOperations,
-                 TTestParserOperands, TTestParserTypeMatch,
-                 TTestParserVariables,TTestParserFunctions,
-                 TTestParserAggregate,
-                 TTestBuiltinsManager,TTestBuiltins]);
-end.
-

+ 178 - 0
packages/fcl-base/tests/testfclbase.lpi

@@ -0,0 +1,178 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<CONFIG>
+  <ProjectOptions>
+    <Version Value="12"/>
+    <General>
+      <Flags>
+        <MainUnitHasCreateFormStatements Value="False"/>
+        <MainUnitHasTitleStatement Value="False"/>
+        <MainUnitHasScaledStatement Value="False"/>
+      </Flags>
+      <SessionStorage Value="InProjectDir"/>
+      <Title Value="testfclbase"/>
+      <UseAppBundle Value="False"/>
+      <ResourceType Value="res"/>
+    </General>
+    <BuildModes>
+      <Item Name="Default" Default="True"/>
+    </BuildModes>
+    <PublishOptions>
+      <Version Value="2"/>
+      <UseFileFilters Value="True"/>
+    </PublishOptions>
+    <RunParams>
+      <FormatVersion Value="2"/>
+    </RunParams>
+    <Units>
+      <Unit>
+        <Filename Value="testfclbase.pp"/>
+        <IsPartOfProject Value="True"/>
+      </Unit>
+      <Unit>
+        <Filename Value="utcfphashobjectlist.pp"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="utcFPHashObjectList"/>
+      </Unit>
+      <Unit>
+        <Filename Value="utccsvreadwrite.pp"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="utcCSVReadWrite"/>
+      </Unit>
+      <Unit>
+        <Filename Value="utcinifile.pp"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="utcIniFile"/>
+      </Unit>
+      <Unit>
+        <Filename Value="utcexprparsscanner.pp"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="utcExprParsScanner"/>
+      </Unit>
+      <Unit>
+        <Filename Value="utcexprparsparser.pp"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="utcExprParsParser"/>
+      </Unit>
+      <Unit>
+        <Filename Value="utcbasenenc.pp"/>
+        <IsPartOfProject Value="True"/>
+      </Unit>
+      <Unit>
+        <Filename Value="utclzw.pas"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="utcLZW"/>
+      </Unit>
+      <Unit>
+        <Filename Value="utcexprparsops.pp"/>
+        <IsPartOfProject Value="True"/>
+      </Unit>
+      <Unit>
+        <Filename Value="utcfptemplate.pp"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="utcFPTemplate"/>
+      </Unit>
+      <Unit>
+        <Filename Value="utcexprparsaggr.pp"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="utcExprParsAggr"/>
+      </Unit>
+      <Unit>
+        <Filename Value="utcobjectlist.pp"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="utcObjectList"/>
+      </Unit>
+      <Unit>
+        <Filename Value="utcexprbuiltin.pp"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="utcExprBuiltin"/>
+      </Unit>
+      <Unit>
+        <Filename Value="utcfpobjecthashtable.pp"/>
+        <IsPartOfProject Value="True"/>
+      </Unit>
+      <Unit>
+        <Filename Value="utcfpobjectlist.pp"/>
+        <IsPartOfProject Value="True"/>
+      </Unit>
+      <Unit>
+        <Filename Value="utcfpstringhashtable.pp"/>
+        <IsPartOfProject Value="True"/>
+      </Unit>
+      <Unit>
+        <Filename Value="utcmaskutils.pp"/>
+        <IsPartOfProject Value="True"/>
+      </Unit>
+      <Unit>
+        <Filename Value="utcobjectqueue.pp"/>
+        <IsPartOfProject Value="True"/>
+      </Unit>
+      <Unit>
+        <Filename Value="utcobjectstack.pp"/>
+        <IsPartOfProject Value="True"/>
+      </Unit>
+      <Unit>
+        <Filename Value="utcorderedlist.pp"/>
+        <IsPartOfProject Value="True"/>
+      </Unit>
+      <Unit>
+        <Filename Value="utcqueue.pp"/>
+        <IsPartOfProject Value="True"/>
+      </Unit>
+      <Unit>
+        <Filename Value="utcstack.pp"/>
+        <IsPartOfProject Value="True"/>
+      </Unit>
+      <Unit>
+        <Filename Value="utcbufferedfilestream.pp"/>
+        <IsPartOfProject Value="True"/>
+      </Unit>
+      <Unit>
+        <Filename Value="utcclasslist.pp"/>
+        <IsPartOfProject Value="True"/>
+      </Unit>
+      <Unit>
+        <Filename Value="utccomponentlist.pp"/>
+        <IsPartOfProject Value="True"/>
+      </Unit>
+      <Unit>
+        <Filename Value="utccsvdocument.pp"/>
+        <IsPartOfProject Value="True"/>
+      </Unit>
+      <Unit>
+        <Filename Value="utcinterlocked.pp"/>
+        <IsPartOfProject Value="True"/>
+      </Unit>
+      <Unit>
+        <Filename Value="utcdirwatch.pp"/>
+        <IsPartOfProject Value="True"/>
+      </Unit>
+    </Units>
+  </ProjectOptions>
+  <CompilerOptions>
+    <Version Value="11"/>
+    <Target>
+      <Filename Value="testfclbase"/>
+    </Target>
+    <SearchPaths>
+      <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
+    </SearchPaths>
+    <Linking>
+      <Debugging>
+        <DebugInfoType Value="dsDwarf3"/>
+      </Debugging>
+    </Linking>
+  </CompilerOptions>
+  <Debugging>
+    <Exceptions>
+      <Item>
+        <Name Value="EAbort"/>
+      </Item>
+      <Item>
+        <Name Value="ECodetoolError"/>
+      </Item>
+      <Item>
+        <Name Value="EFOpenError"/>
+      </Item>
+    </Exceptions>
+  </Debugging>
+</CONFIG>

+ 74 - 0
packages/fcl-base/tests/testfclbase.pp

@@ -0,0 +1,74 @@
+program testfclbase;
+
+{$mode objfpc}{$H+}
+
+uses
+  {$ifdef unix}
+  cthreads,
+  {$ENDIf}
+  punit,
+  utcbasenenc,
+  utcExprParsOps,
+  utcExprParsAggr,
+  utcExprBuiltin,
+  utcExprParsParser,
+  utcExprParsScanner,
+  utcFPHashObjectList,
+  utcFPTemplate,
+  utcIniFile,
+  utclzw,
+  utcObjectList,
+  utcMaskUtils,
+  utcObjectStack,
+  utcQueue,
+  utcOrderedList,
+  utcObjectQueue,
+  utcStack,
+  utcCSVDocument,
+  utcCSVReadWrite,
+  utcBufferedFileStream,
+  utcClassList,
+  utcComponentList,
+  utcFPObjectList,
+  utcFPStringHashTable,
+  utcFPObjectHashTable,
+  utcExprParsNodes,
+  utcInterlocked,
+  utcDirwatch
+  ;
+
+var
+  lSuite : PSuite;
+
+begin
+  utcFPObjectList.RegisterTests;
+  utcObjectList.RegisterTests;
+  utcComponentList.RegisterTests;
+  utcClassList.RegisterTests;
+  utcOrderedList.RegisterTests;
+  utcStack.RegisterTests;
+  utcObjectStack.RegisterTests;
+  utcQueue.RegisterTests;
+  utcObjectQueue.RegisterTests;
+  utcFPHashObjectList.RegisterTests;
+  utcFPStringHashTable.RegisterTests;
+  utcFPObjectHashTable.RegisterTests;
+  utcBufferedFileStream.RegisterTests;
+  utcIniFile.RegisterTests;
+  utcCSVReadWrite.RegisterTests;
+  utcMaskUtils.RegisterTests;
+  utcCSVDocument.RegisterTests;
+  utcfptemplate.RegisterTests;
+  utcbasenenc.RegisterTests;
+  utclzw.RegisterTests;
+  lSuite:=AddSuite('ExpressionParser');
+  utcExprParsScanner.RegisterTests(lSuite);
+  utcExprParsNodes.RegisterTests(lSuite);
+  utcExprParsOps.RegisterTests(lSuite);
+  utcExprParsAggr.RegisterTests(lSuite);
+  utcExprBuiltin.RegisterTests(lSuite);
+  utcInterlocked.RegisterTests;
+  utcDirwatch.RegisterTests;
+  RunAllSysTests;
+end.
+

+ 0 - 174
packages/fcl-base/tests/testinterlocked.pp

@@ -1,174 +0,0 @@
-program TInterlocked_tests;
-
-{$mode Delphi}
-
-uses
-  SysUtils, SyncObjs, Classes;
-
-var
-  i32: Longint;
-  New32, Old32: Longint;
-  i64: Int64;
-  New64, Old64: Int64;
-  Changed, OldBitValue: Boolean;
-  list1, list2, oldlist: TStringList;
-  d1, d2, dOld: Double;
-  s1, s2, sOld: Single;
-
-begin
-  writeln('start testing of TInterlocked methods');
-
-  {* test all kinds of Longint usage *}
-  i32 := 12;
-  New32 := TInterlocked.Increment(i32);
-  if New32 <> 13 then halt(1);
-  if i32 <> 13 then halt(2);
-
-  New32 := TInterlocked.Decrement(i32);
-  if New32 <> 12 then halt(3);
-  if i32 <> 12 then halt(4);
-
-  New32 := TInterlocked.Add(i32, 12);
-  if New32 <> 24 then halt(5);
-  if i32 <> 24 then halt(6);
-
-  Old32 := TInterlocked.CompareExchange(i32, 36, 24);
-  if Old32 <> 24 then halt(7);
-  if i32 <> 36 then halt(8);
-
-  Old32 := TInterlocked.CompareExchange(i32, 48, 36, Changed);
-  if Old32 <> 36 then halt(9);
-  if Changed <> True then halt(10);
-  if i32 <> 48 then halt(11);
-
-  Old32 := TInterlocked.CompareExchange(i32, 123, 96, Changed);
-  if Old32 <> 48 then halt(12);
-  if Changed <> False then halt(13);
-  if i32 <> 48 then halt(14);
-
-  Old32 := TInterlocked.Exchange(i32, 96);
-  if Old32 <> 48 then halt(15);
-  if i32 <> 96 then halt(15);
-
-{$ifdef cpu64}
-  {* test all kinds of Int64 usage *}
-  i64 := 12;
-  New64 := TInterlocked.Increment(i64);
-  if New64 <> 13 then halt(20);
-  if i64 <> 13 then halt(21);
-
-  New64 := TInterlocked.Decrement(i64);
-  if New64 <> 12 then halt(22);
-  if i64 <> 12 then halt(23);
-
-  New64 := TInterlocked.Add(i64, 12);
-  if New64 <> 24 then halt(24);
-  if i64 <> 24 then halt(25);
-
-  Old64 := TInterlocked.CompareExchange(i64, 36, 24);
-  if Old64 <> 24 then halt(26);
-  if i64 <> 36 then halt(27);
-
-  Old64 := TInterlocked.Exchange(i64, 48);
-  if Old64 <> 36 then halt(28);
-  if i64 <> 48 then halt(29);
-
-  Old64 := TInterlocked.Read(i64);
-  if Old64 <> 48 then halt(30);
-  if i64 <> 48 then halt(31);
-{$endif}
-
-  {* test all kinds of TObject and generic class usage *}
-  list1 := TStringList.Create;
-  list2 := TStringList.Create;
-  try
-    list1.Add('A');
-    list2.Add('B');
-    list2.Add('C');
-
-    { TObject }
-    oldlist := TStringList(TInterlocked.CompareExchange(TObject(list1), TObject(list2), TObject(list1)));
-    if list1 <> list2 then halt(32);
-    if oldlist.Count = list1.Count then halt(33);
-    if oldlist.Count = list2.Count then halt(34);
-
-    oldlist := TStringList(TInterlocked.Exchange(TObject(list1), TObject(oldlist)));
-    if oldlist <> list2 then halt(35);
-    if list1.Count <> 1 then halt(36);
-    if list2.Count <> 2 then halt(37);
-
-    { generic class }
-    oldlist := TInterlocked.CompareExchange<TStringList>(list1, list2, list1);
-    if list1 <> list2 then halt(38);
-    if oldlist.Count = list1.Count then halt(39);
-    if oldlist.Count = list2.Count then halt(40);
-
-    oldlist := TInterlocked.Exchange<TStringList>(list1, oldlist);
-    if oldlist <> list2 then halt(41);
-    if list1.Count <> 1 then halt(42);
-    if list2.Count <> 2 then halt(43);
-  finally
-    list1.Free;
-    list2.Free;
-  end;
-
-  writeln('tests passed so far');
-
-{$ifdef cpu64}
-  {* test all kinds of Double usage *}
-  d1 := Double(3.14);
-  d2 := Double(6.28);
-  dOld := TInterlocked.CompareExchange(d1, d2, d1);
-  if dOld <> Double(3.14) then halt(44);
-  if d1 = Double(3.14) then halt(45);
-  if d1 <> d2 then halt(46);
-
-  d1 := dOld;
-  dOld := TInterlocked.Exchange(d1, d2);
-  if dOld <> Double(3.14) then halt(47);
-  if d1 <> Double(6.28) then halt(48);
-  if d1 <> d2 then halt(49);
-
-  dOld := TInterlocked.CompareExchange(d1, dOld, d2);
-  if dOld <> Double(6.28) then halt(50);
-  if d1 <> Double(3.14) then halt(51);
-  if d1 = d2 then halt(52);
-{$endif}
-
-  {* test all kinds of Single usage *}
-  s1 := Single(3.14);
-  s2 := Single(6.28);
-  sOld := TInterlocked.CompareExchange(s1, s2, s1);
-  if sOld <> Single(3.14) then halt(53);
-  if s1 = Single(3.14) then halt(54);
-  if s1 <> s2 then halt(55);
-
-  sOld := TInterlocked.CompareExchange(s1, sOld, s2);
-  if sOld <> Single(6.28) then halt(56);
-  if s1 <> Single(3.14) then halt(57);
-  if s1 = s2 then halt(58);
-
-  sOld := TInterlocked.Exchange(s2, s1);
-  if sOld <> Single(6.28) then halt(59);
-  if s1 <> Single(3.14) then halt(60);
-  if s1 <> s2 then halt(61);
-
-  {* test BitTestAndClear usage *}
-  i32 := 96;
-  OldBitValue := TInterlocked.BitTestAndClear(i32, 6);
-  if OldBitValue <> True then halt(62);
-  if i32 <> 32 then halt(63);
-  OldBitValue := TInterlocked.BitTestAndClear(i32, 6);
-  if OldBitValue <> False then halt(64);
-  if i32 <> 32 then halt(65);
-
-  {* test BitTestAndSet usage *}
-  OldBitValue := TInterlocked.BitTestAndSet(i32, 6);
-  if OldBitValue <> False then halt(66);
-  if i32 <> 96 then halt(67);
-  OldBitValue := TInterlocked.BitTestAndSet(i32, 6);
-  if OldBitValue <> True then halt(68);
-  if i32 <> 96 then halt(69);
-
-  writeln('testing of TInterlocked methods ended');
-end.

+ 0 - 192
packages/fcl-base/tests/tests_fptemplate.pp

@@ -1,192 +0,0 @@
-unit tests_fptemplate;
-
-{$mode objfpc}{$H+}
-
-interface
-
-uses
-  Classes, SysUtils, fpcunit, testutils, testregistry;
-
-type
-
-  { TTestTemplateParser }
-
-  TTestTemplateParser= class(TTestCase)
-  private
-    Procedure TestAllowTagParamsBasics_replacetag(Sender : TObject; Const TagString : String; TagParams:TStringList; Out ReplaceText : String);
-    Procedure TestAllowTagParamsFunctionLike_replacetag(Sender : TObject; Const TagString : String; TagParams:TStringList; Out ReplaceText : String);
-    Procedure TestAllowTagParamsDelphiStyle_replacetag(Sender : TObject; Const TagString : String; TagParams:TStringList; Out ReplaceText : String);
-  published
-    procedure TestBasics;
-    procedure TestBasicDelimiters;
-    procedure TestAllowTagParamsBasics;
-    procedure TestAllowTagParamsFunctionLike;
-    procedure TestAllowTagParamsDelphiStyle;
-  end;
-
-implementation
-
-uses
-  fpTemplate;
-
-procedure TTestTemplateParser.TestBasics;
-var
-  templ: TTemplateParser;
-begin
-  templ := TTemplateParser.Create;
-  try
-    templ.Values['dream'] := 'think';
-    templ.Values['test'] := 'template';
-    CheckEquals('This is the simplest template I could think of.',
-                 templ.ParseString('This is the simplest {test} I could {dream} of.'));
-
-    templ.recursive := true;
-    templ.Values['val2'] := 'template';
-    templ.Values['test'] := '{val2} test';
-    CheckEquals('This is the simplest template test I could think of.',
-               templ.ParseString('This is the simplest {test} I could {dream} of.'));
-
-  finally
-    templ.free;
-  end;
-end;
-
-procedure TTestTemplateParser.TestBasicDelimiters;
-var
-  templ: TTemplateParser;
-begin
-  templ := TTemplateParser.Create;
-  try
-    templ.StartDelimiter:='[-';
-    templ.EndDelimiter:=')';
-    templ.Values['dream'] := 'think';
-    templ.Values['test'] := 'template';
-    CheckEquals('This is [the] simplest template I could think (of).',
-                 templ.ParseString('This is [the] simplest [-test) I could [-dream) (of).'));
-
-
-    templ.StartDelimiter:='(';
-    templ.EndDelimiter:='-)';
-    templ.Values['dream'] := 'think';
-    templ.Values['test'] := 'template';
-    CheckEquals('This is [the] simplest template I could think of:-).',
-                 templ.ParseString('This is [the] simplest (test-) I could (dream-) of:-).'));
-
-
-  finally
-    templ.free;
-  end;
-end;
-
-procedure TTestTemplateParser.TestAllowTagParamsBasics;
-var
-  templ: TTemplateParser;
-begin
-  templ := TTemplateParser.Create;
-  try
-    templ.AllowTagParams := true;
-    templ.OnReplaceTag := @TestAllowTagParamsBasics_replacetag;
-    CheckEquals('This is the simplest template I could think of.',
-                 templ.ParseString('This is the simplest {test [- param1=test -]} I could {dream} of.'));
-
-    CheckEquals('This is the simplest template I could think of.',
-                 templ.ParseString('This is the simplest {test[- param1=test -]} I could {dream} of.'));
-
-    templ.ParamValueSeparator:=':';
-    CheckEquals('This is the simplest template I could think of.',
-                 templ.ParseString('This is the simplest {test [- param1:test -]} I could {dream} of.'));
-
-    CheckEquals('This is the simplest template I could think of.',
-                 templ.ParseString('This is the simplest {test [-param1:test -]} I could {dream} of.'));
-
-    CheckEquals('This is the simplest template I could think of.',
-                 templ.ParseString('This is the simplest {test  [-param1:test -]} I could {dream} of.'));
-
-  finally
-    templ.free;
-  end;
-end;
-
-procedure TTestTemplateParser.TestAllowTagParamsFunctionLike;
-var
-  templ: TTemplateParser;
-begin
-  templ := TTemplateParser.Create;
-  try
-    templ.AllowTagParams := true;
-    templ.ParamStartDelimiter:='(';
-    templ.ParamEndDelimiter:=')';
-    templ.OnReplaceTag := @TestAllowTagParamsFunctionLike_replacetag;
-
-    CheckEquals('THIS should be uppercased.',
-                 templ.ParseString('{uppercase(This)} should be uppercased.'));
-  finally
-    templ.free;
-  end;
-end;
-
-procedure TTestTemplateParser.TestAllowTagParamsDelphiStyle;
-var
-  templ: TTemplateParser;
-begin
-  templ := TTemplateParser.Create;
-  try
-    templ.AllowTagParams := true;
-    templ.StartDelimiter:='<#';
-    templ.EndDelimiter:='>';
-    templ.ParamStartDelimiter:=' ';
-    templ.ParamEndDelimiter:='"';
-    templ.ParamValueSeparator:='="';
-    templ.OnReplaceTag := @TestAllowTagParamsDelphiStyle_replacetag;
-
-    CheckEquals('Test for a Delphi parameter.',
-                 templ.ParseString('Test for a <#DelphiTag param1="first param" param2="second param">.'));
-  finally
-    templ.free;
-  end;
-end;
-
-procedure TTestTemplateParser.TestAllowTagParamsBasics_replacetag(
-  Sender: TObject; const TagString: String; TagParams: TStringList; out
-  ReplaceText: String);
-begin
-  if TagString='test' then
-    begin
-    CheckEquals(1,TagParams.Count);
-    CheckEquals('param1',TagParams.Names[0]);
-    CheckEquals('test ',TagParams.ValueFromIndex[0]);
-    ReplaceText := 'template'
-
-    end
-  else if TagString='dream' then ReplaceText := 'think';
-end;
-
-procedure TTestTemplateParser.TestAllowTagParamsFunctionLike_replacetag(
-  Sender: TObject; const TagString: String; TagParams: TStringList; out
-  ReplaceText: String);
-begin
-  if TagString='uppercase' then
-    begin
-    CheckEquals(1,TagParams.Count);
-    ReplaceText:=UpperCase(TagParams[0]);
-    end;
-end;
-
-procedure TTestTemplateParser.TestAllowTagParamsDelphiStyle_replacetag(
-  Sender: TObject; const TagString: String; TagParams: TStringList; out
-  ReplaceText: String);
-begin
-  CheckEquals(2,TagParams.Count);
-  CheckEquals('param1',TagParams.Names[0]);
-  CheckEquals('first param',TagParams.ValueFromIndex[0]);
-  CheckEquals('param2',TagParams.Names[1]);
-  CheckEquals('second param',TagParams.ValueFromIndex[1]);
-  ReplaceText := 'Delphi parameter'
-
-end;
-
-initialization
-
-  RegisterTest(TTestTemplateParser);
-end.
-

+ 107 - 0
packages/fcl-base/tests/utcbasenenc.pp

@@ -0,0 +1,107 @@
+unit utcbasenenc;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, punit, basenenc;
+
+procedure RegisterTests;
+
+implementation
+
+function BytesToStr(const aBytes: TBytes): String;
+var
+  I: Integer;
+begin
+  Result := '';
+  for I := Low(aBytes) to High(aBytes) do
+  begin
+    if Result <> '' then
+      Result := Result + ',';
+    Result := Result + IntToStr(aBytes[I]);
+  end;
+  Result := '[' + Result + ']';
+end;
+
+function AssertBytesEqual(const Msg: String; const aActual, aExpected: TBytes): Boolean;
+var
+  Cmp: Boolean;
+begin
+  Cmp := (Length(aActual) = Length(aExpected)) and CompareMem(Pointer(aActual), Pointer(aExpected), Length(aActual));
+  Result := AssertTrue(Msg + '. Expected: ' + BytesToStr(aExpected) + ', Actual: ' + BytesToStr(aActual), Cmp);
+end;
+
+function TestBaseN_RFC3548: TTestString;
+begin
+  Result := '';
+  AssertEquals('RFC3548 B64 1', 'FPucA9l+', Base64.Encode([$14,$fb,$9c,$03,$d9,$7e]));
+  AssertBytesEqual('RFC3548 B64 1 Decode', [$14,$fb,$9c,$03,$d9,$7e], Base64.Decode('FPucA9l+'));
+  AssertEquals('RFC3548 B64 2', 'FPucA9k=', Base64.Encode([$14,$fb,$9c,$03,$d9]));
+  AssertBytesEqual('RFC3548 B64 2 Decode', [$14,$fb,$9c,$03,$d9], Base64.Decode('FPucA9k='));
+  AssertEquals('RFC3548 B64 3', 'FPucAw==', Base64.Encode([$14,$fb,$9c,$03]));
+  AssertBytesEqual('RFC3548 B64 3 Decode', [$14,$fb,$9c,$03], Base64.Decode('FPucAw=='));
+  AssertEquals('RFC3548 B64 URL', 'FPucA9l-', Base64URL.Encode([$14,$fb,$9c,$03,$d9,$7e]));
+  AssertBytesEqual('RFC3548 B64 URL Decode', [$14,$fb,$9c,$03,$d9,$7e], Base64URL.Decode('FPucA9l-'));
+end;
+
+function TestBaseN_RFC4648_Base64: TTestString;
+begin
+  Result := '';
+  AssertEquals('RFC4648 B64 empty', '', Base64.Encode(''));
+  AssertEquals('RFC4648 B64 "f"', 'Zg==', Base64.Encode('f'));
+  AssertEquals('RFC4648 B64 "fo"', 'Zm8=', Base64.Encode('fo'));
+  AssertEquals('RFC4648 B64 "foo"', 'Zm9v', Base64.Encode('foo'));
+  AssertEquals('RFC4648 B64 "foob"', 'Zm9vYg==', Base64.Encode('foob'));
+  AssertEquals('RFC4648 B64 "fooba"', 'Zm9vYmE=', Base64.Encode('fooba'));
+  AssertEquals('RFC4648 B64 "foobar"', 'Zm9vYmFy', Base64.Encode('foobar'));
+end;
+
+function TestBaseN_RFC4648_Base32: TTestString;
+begin
+  Result := '';
+  AssertEquals('RFC4648 B32 empty', '', Base32.Encode(''));
+  AssertEquals('RFC4648 B32 "f"', 'MY======', Base32.Encode('f'));
+  AssertEquals('RFC4648 B32 "fo"', 'MZXQ====', Base32.Encode('fo'));
+  AssertEquals('RFC4648 B32 "foo"', 'MZXW6===', Base32.Encode('foo'));
+  AssertEquals('RFC4648 B32 "foob"', 'MZXW6YQ=', Base32.Encode('foob'));
+  AssertEquals('RFC4648 B32 "fooba"', 'MZXW6YTB', Base32.Encode('fooba'));
+  AssertEquals('RFC4648 B32 "foobar"', 'MZXW6YTBOI======', Base32.Encode('foobar'));
+end;
+
+function TestBaseN_RFC4648_Base32Hex: TTestString;
+begin
+  Result := '';
+  AssertEquals('RFC4648 B32Hex empty', '', Base32Hex.Encode(''));
+  AssertEquals('RFC4648 B32Hex "f"', 'CO======', Base32Hex.Encode('f'));
+  AssertEquals('RFC4648 B32Hex "fo"', 'CPNG====', Base32Hex.Encode('fo'));
+  AssertEquals('RFC4648 B32Hex "foo"', 'CPNMU===', Base32Hex.Encode('foo'));
+  AssertEquals('RFC4648 B32Hex "foob"', 'CPNMUOG=', Base32Hex.Encode('foob'));
+  AssertEquals('RFC4648 B32Hex "fooba"', 'CPNMUOJ1', Base32Hex.Encode('fooba'));
+  AssertEquals('RFC4648 B32Hex "foobar"', 'CPNMUOJ1E8======', Base32Hex.Encode('foobar'));
+end;
+
+function TestBaseN_RFC4648_Base16: TTestString;
+begin
+  Result := '';
+  AssertEquals('RFC4648 B16 empty', '', Base16.Encode(''));
+  AssertEquals('RFC4648 B16 "f"', '66', Base16.Encode('f'));
+  AssertEquals('RFC4648 B16 "fo"', '666F', Base16.Encode('fo'));
+  AssertEquals('RFC4648 B16 "foo"', '666F6F', Base16.Encode('foo'));
+  AssertEquals('RFC4648 B16 "foob"', '666F6F62', Base16.Encode('foob'));
+  AssertEquals('RFC4648 B16 "fooba"', '666F6F6261', Base16.Encode('fooba'));
+  AssertEquals('RFC4648 B16 "foobar"', '666F6F626172', Base16.Encode('foobar'));
+end;
+
+procedure RegisterTests;
+begin
+  AddSuite('TBaseNTests');
+  AddTest('TestRFC3548', @TestBaseN_RFC3548, 'TBaseNTests');
+  AddTest('TestRFC4648_Base64', @TestBaseN_RFC4648_Base64, 'TBaseNTests');
+  AddTest('TestRFC4648_Base32', @TestBaseN_RFC4648_Base32, 'TBaseNTests');
+  AddTest('TestRFC4648_Base32Hex', @TestBaseN_RFC4648_Base32Hex, 'TBaseNTests');
+  AddTest('TestRFC4648_Base16', @TestBaseN_RFC4648_Base16, 'TBaseNTests');
+end;
+
+end.

+ 295 - 0
packages/fcl-base/tests/utcbufferedfilestream.pp

@@ -0,0 +1,295 @@
+unit utcBufferedFileStream;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, punit, bufstream;
+
+procedure RegisterTests;
+
+implementation
+
+const
+  TEST_RANDOM_READS=10000;
+  TEST_SEQUENTIAL_READS=1000000;
+  TEST_FILENAME='testfile.bin';
+  TEST_WRITEC_FILE='testwritecache.bin';
+  TEST_WRITEF_FILE='testwritedirec.bin';
+
+function CompareStreams(const aStream1: TStream; const aStream2: TStream): Boolean;
+const
+  BUFFER_SIZE=5213; // Odd number
+var
+  b1: array [0..BUFFER_SIZE-1] of BYTE;
+  b2: array [0..BUFFER_SIZE-1] of BYTE;
+  lReadBytes: integer;
+  lAvailable: integer;
+  lEffectiveRead1: integer;
+  lEffectiveRead2: integer;
+begin
+  b1[0]:=0; // Avoid initalization hint
+  b2[0]:=0; // Avoid initalization hint
+  Result:=false;
+  if aStream1.Size<>aStream2.Size then exit;
+  aStream1.Position:=0;
+  aStream2.Position:=0;
+  while aStream1.Position<aStream1.Size do begin
+    lAvailable:=aStream1.Size-aStream1.Position;
+    if lAvailable>=BUFFER_SIZE then begin
+      lReadBytes:=BUFFER_SIZE;
+    end else begin
+      lReadBytes:=aStream1.Size-aStream1.Position;
+    end;
+    lEffectiveRead1:=aStream1.Read(b1[0],lReadBytes);
+    lEffectiveRead2:=aStream2.Read(b2[0],lReadBytes);
+    if lEffectiveRead1<>lEffectiveRead2 then exit;
+    if not CompareMem(@b1[0],@b2[0],lEffectiveRead1) then exit;
+  end;
+  Result:=true;
+end;
+
+function Setup: TTestString;
+var
+  F: TFileStream;
+  b: array [0..10000-1] of AnsiChar;
+  j: integer;
+begin
+  Result := '';
+  for j := 0 to Pred(10000) do begin
+    b[j]:=AnsiChar(ord('0')+j mod 10);
+  end;
+  try
+    F:=TFileStream.Create(TEST_FILENAME,fmCreate);
+    try
+      for j := 0 to Pred(1000) do begin
+        F.Write(b,sizeof(b));
+      end;
+    finally
+      F.Free;
+    end;
+  except
+    On E: Exception do
+      Result := 'Setup failed: ' + E.Message;
+  end;
+end;
+
+function TearDown: TTestString;
+begin
+  Result := '';
+  try
+    DeleteFile(TEST_FILENAME);
+    DeleteFile(TEST_WRITEC_FILE);
+    DeleteFile(TEST_WRITEF_FILE);
+  except
+    On E: Exception do
+      Result := 'TearDown failed: ' + E.Message;
+  end;
+end;
+
+function TBufferedFileStream_TestCacheRead : TTestString;
+var
+  lBufferedStream: TBufferedFileStream;
+  lStream: TFileStream;
+  b: array [0..10000-1] of AnsiChar;
+  j,k: integer;
+  lBytesToRead: integer;
+  lEffectiveRead: integer;
+  lReadPosition: int64;
+  lCheckInitV: integer;
+begin
+  Result := '';
+  b[0]:=#0; // Avoid initalization hint
+  lBufferedStream:=TBufferedFileStream.Create(TEST_FILENAME,fmOpenRead or fmShareDenyWrite);
+  lStream:=TFileStream.Create(TEST_FILENAME,fmOpenRead or fmShareDenyWrite);
+  try
+    RandSeed:=1;
+    Randomize;
+    for j := 0 to Pred(TEST_RANDOM_READS) do begin
+      lBytesToRead:=Random(10000);
+      lReadPosition:=Random(lBufferedStream.Size);
+      lBufferedStream.Position:=lReadPosition;
+      lEffectiveRead:=lBufferedStream.Read(b,lBytesToRead);
+
+      lCheckInitV:=lReadPosition mod 10;
+      for k := 0 to Pred(lEffectiveRead) do begin
+        if b[k]<>AnsiChar(ord('0')+lCheckInitV mod 10) then
+        begin
+          Result := 'Expected data error in random read test';
+          Exit;
+        end;
+        inc(lCheckInitV);
+      end;
+    end;
+
+    lBytesToRead:=1;
+    lReadPosition:=0;
+    lBufferedStream.Position:=lReadPosition;
+    for j := 0 to Pred(TEST_SEQUENTIAL_READS) do begin
+      lEffectiveRead:=lBufferedStream.Read(b,lBytesToRead);
+      lCheckInitV:=lReadPosition mod 10;
+      for k := 0 to Pred(lEffectiveRead) do begin
+        if b[k]<>AnsiChar(ord('0')+lCheckInitV mod 10) then
+        begin
+          Result := 'Expected data error in sequential read test';
+          Exit;
+        end;
+        inc(lCheckInitV);
+      end;
+      inc(lReadPosition,lBytesToRead);
+    end;
+
+    lBufferedStream.Position:=lBufferedStream.Size-1;
+    lEffectiveRead:=lBufferedStream.Read(b,2);
+    if lEffectiveRead<>1 then
+    begin
+      Result := 'Read beyond limits, returned bytes: '+inttostr(lEffectiveRead);
+      Exit;
+    end;
+  finally
+    lBufferedStream.Free;
+    lStream.Free;
+  end;
+end;
+
+function TBufferedFileStream_TestCacheWrite : TTestString;
+const
+  EXPECTED_SIZE=10000000;
+  TEST_ROUNDS=100000;
+var
+  lBufferedStream: TBufferedFileStream;
+  lStream: TFileStream;
+  lVerifyStream1,lVerifyStream2: TFileStream;
+  b: array [0..10000-1] of AnsiChar;
+  j: integer;
+  lBytesToWrite: integer;
+  lWritePosition: int64;
+begin
+  Result := '';
+  RandSeed:=1;
+  Randomize;
+  for j := 0 to Pred(10000) do
+    b[j]:='0';
+
+  lBufferedStream:=TBufferedFileStream.Create(TEST_WRITEC_FILE,fmCreate);
+  lStream:=TFileStream.Create(TEST_WRITEF_FILE,fmCreate);
+  try
+    for j := 0 to Pred(EXPECTED_SIZE div Sizeof(b)) do
+    begin
+      lBufferedStream.Write(b,sizeof(b));
+      lStream.Write(b,sizeof(b));
+    end;
+    for j := 0 to Pred(Sizeof(b)) do
+      b[j]:=AnsiChar(ord('0')+j mod 10);
+  finally
+    lBufferedStream.Free;
+    lStream.Free;
+  end;
+
+  lBufferedStream:=TBufferedFileStream.Create(TEST_WRITEC_FILE,fmOpenReadWrite);
+  lStream:=TFileStream.Create(TEST_WRITEF_FILE,fmOpenWrite);
+  try
+    for j := 0 to Pred(TEST_ROUNDS) do
+    begin
+      if lStream.Size<>lBufferedStream.Size then
+      begin
+        Result := 'Mismatched lengths during write';
+        Exit;
+      end;
+      lWritePosition:=Random(EXPECTED_SIZE);
+      lBytesToWrite:=Random(sizeof(b));
+      lBufferedStream.Position:=lWritePosition;
+      lStream.Position:=lWritePosition;
+      lBufferedStream.Write(b,lBytesToWrite);
+      lStream.Write(b,lBytesToWrite);
+    end;
+    if lStream.Size<>lBufferedStream.Size then
+    begin
+      Result := 'Mismatched lengths after write';
+      Exit;
+    end;
+  finally
+    lBufferedStream.Free;
+    lStream.Free;
+  end;
+
+  lVerifyStream1:=TFileStream.Create(TEST_WRITEC_FILE,fmOpenRead or fmShareDenyWrite);
+  lVerifyStream2:=TFileStream.Create(TEST_WRITEF_FILE,fmOpenRead or fmShareDenyWrite);
+  try
+    if not CompareStreams(lVerifyStream1,lVerifyStream2) then
+    begin
+      Result := 'Streams are different after write test!';
+      Exit;
+    end;
+  finally
+    lVerifyStream1.Free;
+    lVerifyStream2.Free;
+  end;
+end;
+
+function TBufferedFileStream_TestCacheSeek : TTestString;
+var
+  lBufferedStream: TBufferedFileStream;
+  lStream: TFileStream;
+  bBuffered: array [0..10000] of BYTE;
+  bStream: array [0..10000] of BYTE;
+  bread : Integer;
+begin
+  Result := '';
+  bBuffered[0]:=0;
+  bStream[0]:=0;
+  lBufferedStream:=TBufferedFileStream.Create(TEST_FILENAME,fmOpenRead or fmShareDenyWrite);
+  lStream:=TFileStream.Create(TEST_FILENAME,fmOpenRead or fmShareDenyWrite);
+  try
+    lStream.Position:=-1;
+    lBufferedStream.Position:=-1;
+    if lStream.Position<>lBufferedStream.Position then
+    begin
+      Result := 'Positions are not the same after setting to -1.';
+      Exit;
+    end;
+
+    lStream.Read(bBuffered[0],10);
+    lBufferedStream.Read(bStream[0],10);
+    if (not CompareMem(@bBuffered[0],@bStream[0],10)) or (lStream.Position<>lBufferedStream.Position) then
+    begin
+      Result := 'Read data or positions are not the same after reading at -1.';
+      Exit;
+    end;
+
+    lStream.Seek(-1,soBeginning);
+    lBufferedStream.Seek(-1,soBeginning);
+
+    lStream.Read(bBuffered[0],10);
+    lBufferedStream.Read(bStream[0],10);
+    if (not CompareMem(@bBuffered[0],@bStream[0],10)) or (lStream.Position<>lBufferedStream.Position) then
+    begin
+      Result := 'Read data or positions are not the same after seeking to -1.';
+      Exit;
+    end;
+
+    lStream.Seek(lStream.Position*-2,soCurrent);
+    lBufferedStream.Seek(lBufferedStream.Position*-2,soCurrent);
+    lStream.Read(bBuffered[0],10);
+    lBufferedStream.Read(bStream[0],10);
+    if (not CompareMem(@bBuffered[0],@bStream[0],10)) or (lStream.Position<>lBufferedStream.Position) then
+    begin
+      Result := 'Read data or positions are not the same after seeking from current.';
+      Exit;
+    end;
+  finally
+    lBufferedStream.Free;
+    lStream.Free;
+  end;
+end;
+
+procedure RegisterTests;
+begin
+  AddSuite('TBufferedFileStreamTests', @Setup, @TearDown);
+  AddTest('TestCacheRead', @TBufferedFileStream_TestCacheRead, 'TBufferedFileStreamTests');
+  AddTest('TestCacheWrite', @TBufferedFileStream_TestCacheWrite, 'TBufferedFileStreamTests');
+  AddTest('TestCacheSeek', @TBufferedFileStream_TestCacheSeek, 'TBufferedFileStreamTests');
+end;
+
+end.

+ 145 - 0
packages/fcl-base/tests/utcclasslist.pp

@@ -0,0 +1,145 @@
+unit utcClassList;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, contnrs, punit;
+
+procedure RegisterTests;
+
+implementation
+
+Function TClassList_TestCreate : TTestString;
+var
+  L: TClassList;
+begin
+  Result:='';
+  L := TClassList.Create;
+  try
+    AssertNotNull('List should be created', L);
+    AssertEquals('Count should be 0 on creation', 0, L.Count);
+  finally
+    L.Free;
+  end;
+end;
+
+Function TClassList_TestAdd : TTestString;
+var
+  L: TClassList;
+begin
+  Result:='';
+  L := TClassList.Create;
+  try
+    L.Add(TObject);
+    AssertEquals('Count should be 1 after adding one class', 1, L.Count);
+    AssertEquals('First item should be TObject', TObject, L.Items[0]);
+    L.Add(TList);
+    AssertEquals('Count should be 2 after adding a second class', 2, L.Count);
+    AssertEquals('Second item should be TList', TList, L.Items[1]);
+  finally
+    L.Free;
+  end;
+end;
+
+Function TClassList_TestExtract : TTestString;
+var
+  L: TClassList;
+  Extracted: TClass;
+begin
+  Result:='';
+  L := TClassList.Create;
+  try
+    L.Add(TObject);
+    L.Add(TList);
+    Extracted := L.Extract(TObject);
+    AssertEquals('Extracted class should be TObject', TObject, Extracted);
+    AssertEquals('Count should be 1 after extracting a class', 1, L.Count);
+    AssertEquals('First item should now be TList', TList, L.Items[0]);
+  finally
+    L.Free;
+  end;
+end;
+
+Function TClassList_TestRemove : TTestString;
+var
+  L: TClassList;
+begin
+  Result:='';
+  L := TClassList.Create;
+  try
+    L.Add(TObject);
+    L.Add(TList);
+    L.Remove(TObject);
+    AssertEquals('Count should be 1 after removing a class', 1, L.Count);
+    AssertEquals('First item should now be TList', TList, L.Items[0]);
+  finally
+    L.Free;
+  end;
+end;
+
+Function TClassList_TestIndexOf : TTestString;
+var
+  L: TClassList;
+begin
+  Result:='';
+  L := TClassList.Create;
+  try
+    L.Add(TObject);
+    L.Add(TList);
+    AssertEquals('Index of TObject should be 0', 0, L.IndexOf(TObject));
+    AssertEquals('Index of TList should be 1', 1, L.IndexOf(TList));
+    AssertEquals('Index of a non-existent class should be -1', -1, L.IndexOf(TComponent));
+  finally
+    L.Free;
+  end;
+end;
+
+Function TClassList_TestInsert : TTestString;
+var
+  L: TClassList;
+begin
+  Result:='';
+  L := TClassList.Create;
+  try
+    L.Add(TObject);
+    L.Add(TList);
+    L.Insert(1, TComponent);
+    AssertEquals('Count should be 3 after inserting a class', 3, L.Count);
+    AssertEquals('Item at index 1 should be TComponent', TComponent, L.Items[1]);
+    AssertEquals('Item at index 2 should be TList', TList, L.Items[2]);
+  finally
+    L.Free;
+  end;
+end;
+
+Function TClassList_TestFirstLast : TTestString;
+var
+  L: TClassList;
+begin
+  Result:='';
+  L := TClassList.Create;
+  try
+    L.Add(TObject);
+    L.Add(TList);
+    AssertEquals('First class should be TObject', TObject, L.First);
+    AssertEquals('Last class should be TList', TList, L.Last);
+  finally
+    L.Free;
+  end;
+end;
+
+procedure RegisterTests;
+begin
+  AddSuite('TClassListTests');
+  AddTest('TestCreate', @TClassList_TestCreate, 'TClassListTests');
+  AddTest('TestAdd', @TClassList_TestAdd, 'TClassListTests');
+  AddTest('TestExtract', @TClassList_TestExtract, 'TClassListTests');
+  AddTest('TestRemove', @TClassList_TestRemove, 'TClassListTests');
+  AddTest('TestIndexOf', @TClassList_TestIndexOf, 'TClassListTests');
+  AddTest('TestInsert', @TClassList_TestInsert, 'TClassListTests');
+  AddTest('TestFirstLast', @TClassList_TestFirstLast, 'TClassListTests');
+end;
+
+end.

+ 216 - 0
packages/fcl-base/tests/utccomponentlist.pp

@@ -0,0 +1,216 @@
+unit utcComponentList;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, contnrs, punit;
+
+procedure RegisterTests;
+
+implementation
+
+type
+  TMyComponent = class(TComponent)
+  public
+    IsFreed: ^Boolean;
+    constructor Create(AOwner: TComponent); override;
+    destructor Destroy; override;
+  end;
+
+constructor TMyComponent.Create(AOwner: TComponent);
+begin
+  inherited Create(AOwner);
+  IsFreed := nil;
+end;
+
+destructor TMyComponent.Destroy;
+begin
+  if Assigned(IsFreed) then
+    IsFreed^ := True;
+  inherited Destroy;
+end;
+
+Function TComponentList_TestCreate : TTestString;
+var
+  L: TComponentList;
+begin
+  Result:='';
+  L := TComponentList.Create;
+  try
+    AssertNotNull('List should be created', L);
+    AssertEquals('Count should be 0 on creation', 0, L.Count);
+    AssertTrue('OwnsObjects should be true by default', L.OwnsObjects);
+  finally
+    L.Free;
+  end;
+end;
+
+Function TComponentList_TestAdd : TTestString;
+var
+  L: TComponentList;
+  C1, C2: TComponent;
+begin
+  Result:='';
+  L := TComponentList.Create(False);
+  try
+    C1 := TComponent.Create(nil);
+    C2 := TComponent.Create(nil);
+    L.Add(C1);
+    AssertEquals('Count should be 1 after adding one component', 1, L.Count);
+    AssertSame('First item should be C1', C1, L.Items[0]);
+    L.Add(C2);
+    AssertEquals('Count should be 2 after adding a second component', 2, L.Count);
+    AssertSame('Second item should be C2', C2, L.Items[1]);
+  finally
+    L.Free;
+    C1.Free;
+    C2.Free;
+  end;
+end;
+
+Function TComponentList_TestExtract : TTestString;
+var
+  L: TComponentList;
+  C1, C2, Extracted: TComponent;
+begin
+  Result:='';
+  L := TComponentList.Create(False);
+  try
+    C1 := TComponent.Create(nil);
+    C2 := TComponent.Create(nil);
+    L.Add(C1);
+    L.Add(C2);
+    Extracted := L.Extract(C1);
+    AssertSame('Extracted component should be C1', C1, Extracted);
+    AssertEquals('Count should be 1 after extracting a component', 1, L.Count);
+    AssertSame('First item should now be C2', C2, L.Items[0]);
+  finally
+    L.Free;
+    C1.Free;
+    C2.Free;
+  end;
+end;
+
+Function TComponentList_TestRemove : TTestString;
+var
+  L: TComponentList;
+  C1, C2: TComponent;
+begin
+  Result:='';
+  L := TComponentList.Create(False);
+  try
+    C1 := TComponent.Create(nil);
+    C2 := TComponent.Create(nil);
+    L.Add(C1);
+    L.Add(C2);
+    L.Remove(C1);
+    AssertEquals('Count should be 1 after removing a component', 1, L.Count);
+    AssertSame('First item should now be C2', C2, L.Items[0]);
+  finally
+    L.Free;
+    C2.Free;
+  end;
+end;
+
+Function TComponentList_TestIndexOf : TTestString;
+var
+  L: TComponentList;
+  C1, C2, C3: TComponent;
+begin
+  Result:='';
+  L := TComponentList.Create(False);
+  C3 := TComponent.Create(nil);
+  try
+    C1 := TComponent.Create(nil);
+    C2 := TComponent.Create(nil);
+    L.Add(C1);
+    L.Add(C2);
+    AssertEquals('Index of C1 should be 0', 0, L.IndexOf(C1));
+    AssertEquals('Index of C2 should be 1', 1, L.IndexOf(C2));
+    AssertEquals('Index of a non-existent component should be -1', -1, L.IndexOf(C3));
+  finally
+    L.Free;
+    C1.Free;
+    C2.Free;
+    C3.Free;
+  end;
+end;
+
+Function TComponentList_TestInsert : TTestString;
+var
+  L: TComponentList;
+  C1, C2, C3: TComponent;
+begin
+  Result:='';
+  L := TComponentList.Create(False);
+  try
+    C1 := TComponent.Create(nil);
+    C2 := TComponent.Create(nil);
+    C3 := TComponent.Create(nil);
+    L.Add(C1);
+    L.Add(C2);
+    L.Insert(1, C3);
+    AssertEquals('Count should be 3 after inserting a component', 3, L.Count);
+    AssertSame('Item at index 1 should be C3', C3, L.Items[1]);
+    AssertSame('Item at index 2 should be C2', C2, L.Items[2]);
+  finally
+    L.Free;
+    C1.Free;
+    C2.Free;
+    C3.Free;
+  end;
+end;
+
+Function TComponentList_TestFirstLast : TTestString;
+var
+  L: TComponentList;
+  C1, C2: TComponent;
+begin
+  Result:='';
+  L := TComponentList.Create(False);
+  try
+    C1 := TComponent.Create(nil);
+    C2 := TComponent.Create(nil);
+    L.Add(C1);
+    L.Add(C2);
+    AssertSame('First component should be C1', C1, L.First);
+    AssertSame('Last component should be C2', C2, L.Last);
+  finally
+    L.Free;
+    C1.Free;
+    C2.Free;
+  end;
+end;
+
+Function TComponentList_TestOwnsObjects : TTestString;
+var
+  L: TComponentList;
+  C1: TMyComponent;
+  Freed: Boolean;
+begin
+  Result:='';
+  L := TComponentList.Create(True);
+  Freed := False;
+  C1 := TMyComponent.Create(nil);
+  C1.IsFreed := @Freed;
+  L.Add(C1);
+  L.Free; // This should free C1 as well
+  AssertTrue('Component should be freed when OwnsObjects is true and list is freed', Freed);
+end;
+
+procedure RegisterTests;
+begin
+  AddSuite('TComponentListTests');
+  AddTest('TestCreate', @TComponentList_TestCreate, 'TComponentListTests');
+  AddTest('TestAdd', @TComponentList_TestAdd, 'TComponentListTests');
+  AddTest('TestExtract', @TComponentList_TestExtract, 'TComponentListTests');
+  AddTest('TestRemove', @TComponentList_TestRemove, 'TComponentListTests');
+  AddTest('TestIndexOf', @TComponentList_TestIndexOf, 'TComponentListTests');
+  AddTest('TestInsert', @TComponentList_TestInsert, 'TComponentListTests');
+  AddTest('TestFirstLast', @TComponentList_TestFirstLast, 'TComponentListTests');
+  AddTest('TestOwnsObjects', @TComponentList_TestOwnsObjects, 'TComponentListTests');
+end;
+
+end.

+ 122 - 0
packages/fcl-base/tests/utccsvdocument.pp

@@ -0,0 +1,122 @@
+unit utcCSVDocument;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, punit, csvdocument;
+
+procedure RegisterTests;
+
+implementation
+
+const
+  TestFileName = 'test.csv';
+  ColCount = 3;
+  RowCount = 4;
+
+type
+  TRow = array[0..ColCount-1] of String;
+  TCells = array[0..RowCount-1] of TRow;
+
+const
+  Cells : TCells = (
+    ('a','b','c'),
+    ('1','"one"','1.1'),
+    ('2','"two"','2.2'),
+    ('3','"three"','3.3')
+  );
+
+var
+  FDoc: TCSVDocument;
+
+procedure RemoveTestFile;
+begin
+  if FileExists(TestFileName) then
+    DeleteFile(TestFileName);
+end;
+
+function StripQuotes(S: String): String;
+var
+  L: integer;
+begin
+  Result := S;
+  L := Length(Result);
+  if (L > 1) and (Result[1] = '"') and (Result[L] = '"') then
+    Result := Copy(Result, 2, L - 2);
+end;
+
+procedure CreateTestFile;
+var
+  L: TStringList;
+  R, C: Integer;
+  S: String;
+begin
+  L := TStringList.Create;
+  try
+    for R := 0 to RowCount - 1 do
+    begin
+      S := '';
+      for C := 0 to ColCount - 1 do
+      begin
+        if S <> '' then
+          S := S + ',';
+        S := S + Cells[R, C];
+      end;
+      L.Add(S);
+    end;
+    L.SaveToFile(TestFileName);
+  finally
+    L.Free;
+  end;
+end;
+
+procedure TestTheFile;
+var
+  R, C: Integer;
+begin
+  AssertEquals('Row count', RowCount, FDoc.RowCount);
+  for R := 0 to RowCount - 1 do
+    for C := 0 to ColCount - 1 do
+    begin
+      AssertEquals('Col[' + IntToStr(R) + '] count', ColCount, FDoc.ColCount[R]);
+      AssertEquals(Format('Cell[%d,%d]', [C, R]), StripQuotes(Cells[R, C]), FDoc.Cells[C, R]);
+    end;
+end;
+
+function Setup: TTestString;
+begin
+  Result := '';
+  FDoc := TCSVDocument.Create;
+end;
+
+function TearDown: TTestString;
+begin
+  Result := '';
+  RemoveTestFile;
+  FreeAndNil(FDoc);
+end;
+
+function TCSVDocument_TestEmpty: TTestString;
+begin
+  Result := '';
+  AssertNotNull('Have document', FDoc);
+end;
+
+function TCSVDocument_TestRead: TTestString;
+begin
+  Result := '';
+  CreateTestFile;
+  FDoc.LoadFromFile(TestFileName);
+  TestTheFile;
+end;
+
+procedure RegisterTests;
+begin
+  AddSuite('TCSVDocumentTests', @Setup, @TearDown);
+  AddTest('TestEmpty', @TCSVDocument_TestEmpty, 'TCSVDocumentTests');
+  AddTest('TestRead', @TCSVDocument_TestRead, 'TCSVDocumentTests');
+end;
+
+end.

+ 117 - 0
packages/fcl-base/tests/utccsvreadwrite.pp

@@ -0,0 +1,117 @@
+unit utcCSVReadWrite;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, punit, csvreadwrite;
+
+procedure RegisterTests;
+
+implementation
+
+var
+  FData: TStrings;
+  FParser: TCSVParser;
+
+procedure HaveNext(ARow, ACol: integer; AValue: String);
+var
+  CN: String;
+begin
+  CN := Format('Cell(row: %d, col: %d)', [ARow, ACol]);
+  AssertTrue('Have ' + CN, FParser.ParseNextCell);
+  AssertEquals(CN + ': Row matches', ARow, FParser.CurrentRow);
+  AssertEquals(CN + ': Col matches', ACol, FParser.CurrentCol);
+  AssertEquals(CN + ': Value', AValue, FParser.CurrentCellText);
+end;
+
+procedure AssertLine(ARow: Integer; const AValues: array of String);
+var
+  I: Integer;
+begin
+  for I := 0 to High(AValues) do
+    HaveNext(ARow, I, AValues[I]);
+end;
+
+function Setup: TTestString;
+begin
+  Result := '';
+  if Assigned(FParser) then
+    FParser.Free;
+  FParser := TCSVParser.Create;
+  if Assigned(FData) then
+    FData.Free;
+  FData := TStringList.Create;
+end;
+
+function TearDown: TTestString;
+begin
+  Result := '';
+  FreeAndNil(FData);
+  FreeAndNil(FParser);
+end;
+
+function TCSVReadWrite_TestEmpty: TTestString;
+begin
+  Result := '';
+  AssertNotNull('Have parser', FParser);
+end;
+
+function TCSVReadWrite_TestNormalLine: TTestString;
+begin
+  Result := '';
+  FParser.SetSource('this,is,a,normal,line');
+  AssertLine(0, ['this', 'is', 'a', 'normal', 'line']);
+end;
+
+function TCSVReadWrite_TestQuotedLine: TTestString;
+begin
+  Result := '';
+  FParser.SetSource('"this","is","a","quoted","line"');
+  AssertLine(0, ['this', 'is', 'a', 'quoted', 'line']);
+end;
+
+function TCSVReadWrite_TestInlineQuotedLine: TTestString;
+begin
+  Result := '';
+  FParser.SetSource('"this","line",has,mixed" quoting"');
+  AssertLine(0, ['this', 'line', 'has', 'mixed quoting']);
+end;
+
+function TCSVReadWrite_TestQuotedNewLine: TTestString;
+begin
+  Result := '';
+  FParser.SetSource('"this","line",has,"an embedded' + LineEnding + 'newline"');
+  AssertLine(0, ['this', 'line', 'has', 'an embedded' + LineEnding + 'newline']);
+end;
+
+function TCSVReadWrite_Test2Lines: TTestString;
+begin
+  Result := '';
+ 
+  FParser.SetSource('"this","line",has,an embedded' + LineEnding + 'newline');
+  AssertLine(0, ['this', 'line', 'has', 'an embedded']);
+  AssertLine(1, ['newline']);
+end;
+
+function TCSVReadWrite_TestEscapedQuotes: TTestString;
+begin
+  Result := '';
+  FParser.SetSource('"this","line",has,"an embedded "" quote"');
+  AssertLine(0, ['this', 'line', 'has', 'an embedded " quote']);
+end;
+
+procedure RegisterTests;
+begin
+  AddSuite('TCSVReadWriteTests', @Setup, @TearDown,Nil,True);
+  AddTest('TestEmpty', @TCSVReadWrite_TestEmpty, 'TCSVReadWriteTests');
+  AddTest('TestNormalLine', @TCSVReadWrite_TestNormalLine, 'TCSVReadWriteTests');
+  AddTest('TestQuotedLine', @TCSVReadWrite_TestQuotedLine, 'TCSVReadWriteTests');
+  AddTest('TestInlineQuotedLine', @TCSVReadWrite_TestInlineQuotedLine, 'TCSVReadWriteTests');
+  AddTest('TestQuotedNewLine', @TCSVReadWrite_TestQuotedNewLine, 'TCSVReadWriteTests');
+  AddTest('Test2Lines', @TCSVReadWrite_Test2Lines, 'TCSVReadWriteTests');
+  AddTest('TestEscapedQuotes', @TCSVReadWrite_TestEscapedQuotes, 'TCSVReadWriteTests');
+end;
+
+end.

+ 324 - 0
packages/fcl-base/tests/utcdirwatch.pp

@@ -0,0 +1,324 @@
+unit utcdirwatch;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, punit, testutils, testregistry, dirwatch;
+
+procedure RegisterTests;
+
+implementation
+
+uses typinfo, inifiles;
+
+type
+  TChangedEntry = record
+    Dir : TWatchDirectoryEntry;
+    Events : TWatchFileEvents;
+    FN : String;
+  end;
+  TChangedEntryArray = Array of TChangedEntry;
+
+  { TEventObject }
+
+  TEventObject = class
+    procedure DoChange(Sender: TObject; const aEvent: TFileChangeEvent);
+  private
+    procedure DoCheck(sender: TObject; var aContinue: Boolean);
+    procedure HandleCreateFile(Sender: TObject);
+  end;
+
+var
+  FDirWatch: TDirwatch;
+  FTestDir: string;
+  FChanged: TChangedEntryArray;
+  FCheckCount : Integer;
+  FMaxLoopCount : Integer;
+  FDoCheckOne : TNotifyEvent;
+  BaseDir : String;
+  Events : TEventObject;
+
+// Helper functions from the original test case
+procedure CleanDirs(aDir: String);
+Var
+  Info : TSearchRec;
+  lDir,lFull : String;
+begin
+  lDir:=IncludeTrailingPathDelimiter(aDir);
+  If FindFirst(lDir+AllFilesMask,sysutils.faDirectory,Info)=0 then
+    try
+      Repeat
+        lFull:=lDir+Info.Name;
+        if (Info.Attr and faDirectory)<>0 then
+          begin
+          if not ((Info.Name='.') or (Info.Name='..')) then
+            begin
+            CleanDirs(lFull);
+            if not RemoveDir(lFull) then
+              Fail('Failed to remove directory '+lFull)
+            end;
+          end
+        else if not DeleteFile(lFull) then
+          Fail('Failed to remove file '+lFull)
+      until FindNext(Info)<>0;
+    finally
+      FindClose(Info);
+    end;
+end;
+
+
+procedure TEventObject.DoChange(Sender: TObject; const aEvent: TFileChangeEvent);
+var
+  Len : Integer;
+begin
+  len:=Length(FChanged);
+  SetLength(FChanged,Len+1);
+  FChanged[Len].Dir:=aEvent.Entry;
+  FChanged[Len].Events:=aEvent.Events;
+  FChanged[Len].FN:=aEvent.FileName;
+end;
+
+procedure TEventObject.DoCheck(sender: TObject; var aContinue: Boolean);
+begin
+  aContinue:=FCheckCount<FMaxLoopCount;
+  if (FCheckCount=0) then
+    if Assigned(FDoCheckOne) then
+       FDoCheckOne(nil);
+  inc(FCheckCount);
+end;
+
+procedure DoAppendFile(const aName : string);
+var
+  FD : THandle;
+begin
+  FD:=FileOpen(FTestDir+aName,fmOpenWrite);
+  try
+    FileSeek(FD,0,fsFromEnd);
+    if FileWrite(FD,aName[1],Length(aName))=-1 then
+      Writeln(GetLastOSError);
+  finally
+    FileClose(FD);
+  end;
+end;
+
+procedure DoCreateFile(const aName : string);
+var
+  L: TStrings;
+begin
+  L:=TStringList.Create;
+  try
+    L.Add(aName);
+    L.SaveToFile(FTestDir+aName);
+  finally
+    L.Free;
+  end;
+end;
+
+procedure DoDeleteFile(const aName: string);
+begin
+  If not DeleteFile(FTestDir+aName) then
+    Fail('Failed to delete file '+FTestDir+aName);
+end;
+
+procedure TEventObject.HandleCreateFile(Sender: TObject);
+begin
+  DoCreateFile('name.txt');
+end;
+
+procedure AssertEventsEquals(const Msg: String; aExpected, aActual: TWatchFileEvents);
+begin
+  AssertEquals(Msg,SetToString(PTypeInfo(TypeInfo(TWatchFileEvents)),Longint(aExpected),False),
+                   SetToString(PTypeInfo(TypeInfo(TWatchFileEvents)),Longint(aActual),False));
+end;
+
+procedure AssertChange(const Msg: String; aIndex: Integer; aEntry: TWatchDirectoryEntry; aEvents: TWatchFileEvents; const aFileName: string = '');
+var
+  M : String;
+begin
+  M:=Msg+Format(' [%d]: ',[aIndex]);
+  AssertTrue(M+'correct index',aIndex<Length(FChanged));
+  AssertSame(M+'correct dir entry',aEntry,FChanged[aIndex].Dir);
+  AssertEventsEquals(M+'correct changes',aEvents,FChanged[aIndex].Events);
+  if aFileName<>'' then
+    AssertEquals(M+'correct fileName',aFileName,FChanged[aIndex].FN);
+end;
+
+// Per-test setup and teardown
+procedure TestSetup;
+begin
+  FDirWatch:=TDirwatch.Create(Nil);
+  FTestDir:=IncludeTrailingPathDelimiter(BaseDir);
+  ForceDirectories(FTestDir);
+  FDirWatch.OnChange:[email protected];
+  FMaxLoopCount:=0;
+  FCheckCount:=0;
+  FDoCheckOne:=Nil;
+  SetLength(FChanged, 0);
+end;
+
+procedure TestTearDown;
+begin
+  FDirWatch.Free;
+  CleanDirs(FTestDir);
+end;
+
+// Flattened Tests
+function TestDirWatch_TestHookUp: TTestString;
+begin
+  Result := '';
+  TestSetup;
+  try
+    AssertNotNull('Have watch',FDirWatch);
+    AssertEquals('No watches',0,FDirWatch.Watches.Count);
+    AssertTrue('Have test dir',FTestDir<>'');
+    AssertTrue('test dir exists',DirectoryExists(FTestDir));
+    AssertEquals('No max check count',0,FMaxLoopCount);
+    AssertEquals('No check count',0,FCheckCount);
+    AssertTrue('No docheckone',FDoCheckOne=nil);
+  finally
+    TestTearDown;
+  end;
+end;
+
+function TestDirWatch_TestAddFile: TTestString;
+begin
+  Result := '';
+  TestSetup;
+  try
+    FDirwatch.AddWatch(FTestDir,[feCreate]);
+    FDirWatch.InitWatch;
+    DoCreateFile('name.txt');
+    AssertEquals('Change detected', 1, FDirWatch.Check);
+    AssertChange('Create',0,FDirWatch.Watches[0],[feCreate],'name.txt');
+  finally
+    TestTearDown;
+  end;
+end;
+
+function TestDirWatch_TestAppendFile: TTestString;
+begin
+  Result := '';
+  TestSetup;
+  try
+    FDirwatch.AddWatch(FTestDir,[feModify]);
+    DoCreateFile('name.txt');
+    FDirWatch.InitWatch;
+    DoAppendFile('name.txt');
+    AssertEquals('Change detected',1,FDirWatch.Check);
+    AssertChange('Change detected',0,FDirWatch.Watches[0],[feModify],'name.txt');
+  finally
+    TestTearDown;
+  end;
+end;
+
+function TestDirWatch_TestDeleteFile: TTestString;
+begin
+  Result := '';
+  TestSetup;
+  try
+    FDirwatch.AddWatch(FTestDir,[feDelete]);
+    DoCreateFile('name.txt');
+    FDirWatch.InitWatch;
+    DoDeleteFile('name.txt');
+    AssertEquals('Change detected',1,FDirWatch.Check);
+    AssertChange('Change detected',0,FDirWatch.Watches[0],[feDelete],'name.txt');
+  finally
+    TestTearDown;
+  end;
+end;
+
+function TestDirWatch_TestLoopNoThread: TTestString;
+begin
+  Result := '';
+  TestSetup;
+  try
+    FDirwatch.AddWatch(FTestDir,[feCreate]);
+    FDirwatch.OnCheck:[email protected];
+    FDoCheckOne:[email protected];
+    FMaxLoopCount:=2;
+    FDirWatch.StartLoop;
+    AssertChange('Change detected',0,FDirWatch.Watches[0],[feCreate],'name.txt');
+  finally
+    TestTearDown;
+  end;
+end;
+
+function TestDirWatch_TestLoopThread: TTestString;
+var
+  I : Integer;
+begin
+  Result := '';
+  TestSetup;
+  try
+    FDirwatch.AddWatch(FTestDir,[feCreate]);
+    FDirwatch.Threaded:=True;
+    FDirWatch.StartLoop;
+    Sleep(50);
+    DoCreateFile('name.txt');
+    I:=0;
+    Repeat
+      Sleep(10);
+      CheckSynchronize;
+      inc(i);
+    until (I>=50) or (length(FChanged)>0);
+    AssertChange('Change detected',0,FDirWatch.Watches[0],[feCreate],'name.txt');
+  finally
+    TestTearDown;
+  end;
+end;
+
+function TestDirWatch_TestAddFileBaseDir: TTestString;
+begin
+  Result := '';
+  TestSetup;
+  try
+    FDirwatch.BaseDir:=FTestDir;
+    AssertTrue('Create Subdir ',ForceDirectories(FTestDir+'sub'));
+    FDirwatch.AddWatch('',[feCreate]);
+    FDirWatch.InitWatch;
+    DoCreateFile('sub/name.txt');
+    AssertEquals('Subdirs not watched',0,FDirWatch.Check);
+  finally
+    TestTearDown;
+  end;
+end;
+
+// Suite setup and registration
+procedure GetBaseDir;
+var
+  FN : string;
+begin
+  BaseDir:=IncludeTrailingPathDelimiter(GetTempDir)+'Dirwatch'+PathDelim;
+  FN:=ExtractFilePath(ParamStr(0))+'config.ini';
+  If FileExists(FN) then
+    With TMemIniFile.Create(FN) do
+      try
+        BaseDir:=ReadString('dirwatch','basedir',BaseDir);
+      finally
+        Free;
+      end;
+end;
+
+function SuiteSetup: string;
+begin
+  Result := '';
+  GetBaseDir;
+end;
+
+procedure RegisterTests;
+var
+  lSuite : PSuite;
+begin
+  lSuite:=AddSuite('TDirWatchTests', @SuiteSetup, nil, nil, true);
+  AddTest('TestHookUp', @TestDirWatch_TestHookUp, lSuite);
+  AddTest('TestAddFile', @TestDirWatch_TestAddFile, lSuite);
+  AddTest('TestAppendFile', @TestDirWatch_TestAppendFile, lSuite);
+  AddTest('TestDeleteFile', @TestDirWatch_TestDeleteFile, lSuite);
+  AddTest('TestLoopNoThread', @TestDirWatch_TestLoopNoThread, lSuite);
+  AddTest('TestLoopThread', @TestDirWatch_TestLoopThread, lSuite);
+  AddTest('TestAddFileBaseDir', @TestDirWatch_TestAddFileBaseDir, lSuite);
+end;
+
+end.

+ 1018 - 0
packages/fcl-base/tests/utcexprbuiltin.pp

@@ -0,0 +1,1018 @@
+unit utcExprBuiltin;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, punit, math, fpexprpars;
+
+procedure RegisterTests(aTop : PSuite);
+
+implementation
+
+uses dateutils, typinfo;
+
+procedure AssertEquals(Msg: String; AResultType: TResultType;  ANode: TFPExprNode); overload;
+begin
+  AssertNotNull(Msg+': Node not null',ANode);
+  AssertEquals(Msg,ResultTypeName(AResultType),ResultTypeName(Anode.NodeType));
+end;
+
+procedure AssertEquals(Msg: String; AExpected, AActual: TResultType); overload;
+begin
+  AssertEquals(Msg,ResultTypeName(AExpected),ResultTypeName(AActual));
+end;
+
+type
+  TMyFPExpressionParser = class(TFPExpressionParser)
+  public
+    property ExprNode;
+    property Scanner;
+    property Dirty;
+  end;
+
+
+var
+  FValue : Integer;
+  FP: TMyFPExpressionParser;
+  FM : TExprBuiltInManager;
+  FileFormatSettings: TFormatSettings;
+
+procedure DummyGetDate(var Result: TFPExpressionResult; const Args: TExprParameterArray);
+begin
+  Result.resDateTime:=Date;
+end;
+
+procedure DummyEchoDate(var Result: TFPExpressionResult; const Args: TExprParameterArray);
+begin
+  Result.resDateTime:=Args[0].resDateTime;
+end;
+
+
+function SuiteSetup: string;
+begin
+  Result := '';
+  FP := TMyFPExpressionParser.Create(nil);
+  FM := TExprBuiltInManager.Create(Nil);
+  FValue := 0;
+end;
+
+function SuiteTearDown : string;
+begin
+  Result := '';
+  FValue := 0;
+  FreeAndNil(FM);
+  FreeAndNil(FP);
+end;
+
+function TestBuiltinsManager_TestCreate: TTestString;
+begin
+  Result := '';
+  AssertEquals('Have no builtin expressions',0,FM.IdentifierCount);
+end;
+
+function TestBuiltinsManager_TestVariable1: TTestString;
+Var
+  I : TFPBuiltinExprIdentifierDef;
+begin
+  Result := '';
+  I:=FM.AddVariable(bcuser,'a',rtBoolean,'True');
+  AssertNotNull('Addvariable returns result',I);
+  AssertEquals('One variable added',1,FM.IdentifierCount);
+  AssertSame('Result equals variable added',I,FM.Identifiers[0]);
+  AssertEquals('Variable has correct category',ord(bcUser),Ord(I.Category));
+  AssertEquals('Variable has correct resulttype',rtBoolean,I.ResultType);
+  AssertEquals('Variable has correct value','True',I.Value);
+end;
+
+function TestBuiltinsManager_TestVariable2: TTestString;
+Var
+  I : TFPBuiltinExprIdentifierDef;
+begin
+  Result := '';
+  I:=FM.AddBooleanVariable(bcUser,'a',False);
+  AssertNotNull('Addvariable returns result',I);
+  AssertEquals('One variable added',1,FM.IdentifierCount);
+  AssertSame('Result equals variable added',I,FM.Identifiers[0]);
+  AssertEquals('Variable has correct category',ord(bcUser),Ord(I.Category));
+  AssertEquals('Variable has correct resulttype',rtBoolean,I.ResultType);
+  AssertEquals('Variable has correct value','False',I.Value);
+end;
+
+function TestBuiltinsManager_TestVariable3: TTestString;
+Var
+  I : TFPBuiltinExprIdentifierDef;
+begin
+  Result := '';
+  I:=FM.AddIntegerVariable(bcUser,'a',123);
+  AssertNotNull('Addvariable returns result',I);
+  AssertEquals('One variable added',1,FM.IdentifierCount);
+  AssertSame('Result equals variable added',I,FM.Identifiers[0]);
+  AssertEquals('Variable has correct category',ord(bcUser),Ord(I.Category));
+  AssertEquals('Variable has correct resulttype',rtInteger,I.ResultType);
+  AssertEquals('Variable has correct value','123',I.Value);
+end;
+
+function TestBuiltinsManager_TestVariable4: TTestString;
+Var
+  I : TFPBuiltinExprIdentifierDef;
+begin
+  Result := '';
+  I:=FM.AddFloatVariable(bcUser,'a',1.23);
+  AssertNotNull('Addvariable returns result',I);
+  AssertEquals('One variable added',1,FM.IdentifierCount);
+  AssertSame('Result equals variable added',I,FM.Identifiers[0]);
+  AssertEquals('Variable has correct category',ord(bcUser),Ord(I.Category));
+  AssertEquals('Variable has correct resulttype',rtFloat,I.ResultType);
+  AssertEquals('Variable has correct value',FloatToStr(1.23, FileFormatSettings),I.Value);
+end;
+
+function TestBuiltinsManager_TestVariable5: TTestString;
+Var
+  I : TFPBuiltinExprIdentifierDef;
+begin
+  Result := '';
+  I:=FM.AddStringVariable(bcUser,'a','1.23');
+  AssertNotNull('Addvariable returns result',I);
+  AssertEquals('One variable added',1,FM.IdentifierCount);
+  AssertSame('Result equals variable added',I,FM.Identifiers[0]);
+  AssertEquals('Variable has correct category',ord(bcUser),Ord(I.Category));
+  AssertEquals('Variable has correct resulttype',rtString,I.ResultType);
+  AssertEquals('Variable has correct value','1.23',I.Value);
+end;
+
+function TestBuiltinsManager_TestVariable6: TTestString;
+Var
+  I : TFPBuiltinExprIdentifierDef;
+  D : TDateTime;
+begin
+  Result := '';
+  D:=Now;
+  I:=FM.AddDateTimeVariable(bcUser,'a',D);
+  AssertNotNull('Addvariable returns result',I);
+  AssertEquals('One variable added',1,FM.IdentifierCount);
+  AssertSame('Result equals variable added',I,FM.Identifiers[0]);
+  AssertEquals('Variable has correct category',ord(bcUser),Ord(I.Category));
+  AssertEquals('Variable has correct resulttype',rtDateTime,I.ResultType);
+  AssertEquals('Variable has correct value',FormatDateTime('yyyy-mm-dd hh:nn:ss',D),I.Value);
+end;
+
+function TestBuiltinsManager_TestVariable7: TTestString;
+Var
+  I : TFPBuiltinExprIdentifierDef;
+begin
+  Result := '';
+  I:=FM.AddCurrencyVariable(bcUser,'a',1.23);
+  AssertNotNull('Addvariable returns result',I);
+  AssertEquals('One variable added',1,FM.IdentifierCount);
+  AssertSame('Result equals variable added',I,FM.Identifiers[0]);
+  AssertEquals('Variable has correct category',ord(bcUser),Ord(I.Category));
+  AssertEquals('Variable has correct resulttype',rtCurrency,I.ResultType);
+  AssertEquals('Variable has correct value',CurrToStr(1.23, FileFormatSettings),I.Value);
+end;
+
+
+
+function TestBuiltinsManager_TestFunction1: TTestString;
+Var
+  I : TFPBuiltinExprIdentifierDef;
+begin
+  Result := '';
+  I:=FM.AddFunction(bcUser,'Date','D','',@DummyGetDate);
+  AssertNotNull('Addvariable returns result',I);
+  AssertEquals('One variable added',1,FM.IdentifierCount);
+  AssertSame('Result equals variable added',I,FM.Identifiers[0]);
+  AssertEquals('Variable has correct category',ord(bcUser),Ord(I.Category));
+  AssertEquals('Function has correct resulttype',rtDateTime,I.ResultType);
+  AssertEquals('Function has correct address',Pointer(@DummyGetDate),Pointer(I.OnGetFunctionValueCallBack));
+end;
+
+function TestBuiltinsManager_TestFunction2: TTestString;
+Var
+  I,I2 : TFPBuiltinExprIdentifierDef;
+  ind : Integer;
+begin
+  Result := '';
+  FM.AddFunction(bcUser,'EchoDate','D','D',@DummyEchoDate);
+  I:=FM.AddFunction(bcUser,'Echo','D','D',@DummyEchoDate);
+  FM.AddFunction(bcUser,'DoEcho','D','D',@DummyEchoDate);
+  ind:=FM.IndexOfIdentifier('Echo');
+  AssertEquals('Found identifier',1,ind);
+  I2:=FM.FindIdentifier('Echo');
+  AssertNotNull('FindIdentifier returns result',I2);
+  AssertSame('Findidentifier returns correct result',I,I2);
+  ind:=FM.IndexOfIdentifier('NoNoNo');
+  AssertEquals('Found no such identifier',-1,ind);
+  I2:=FM.FindIdentifier('NoNoNo');
+  AssertNull('FindIdentifier returns no result',I2);
+end;
+
+function TestBuiltinsManager_TestDelete: TTestString;
+begin
+  Result := '';
+  FM.AddFunction(bcUser,'EchoDate','D','D',@DummyEchoDate);
+  FM.AddFunction(bcUser,'EchoDate2','D','D',@DummyEchoDate);
+  FM.AddFunction(bcUser,'EchoDate3','D','D',@DummyEchoDate);
+  AssertEquals('Count before',3,FM.IdentifierCount);
+  FM.Delete(2);
+  AssertEquals('Count after',2,FM.IdentifierCount);
+  AssertEquals('No more',-1,FM.IndexOfIdentifier('EchoDate3'));
+  AssertEquals('Left 1',0,FM.IndexOfIdentifier('EchoDate'));
+  AssertEquals('Left 2',1,FM.IndexOfIdentifier('EchoDate2'));
+end;
+
+function TestBuiltinsManager_TestRemove: TTestString;
+begin
+  Result := '';
+  FM.AddFunction(bcUser,'EchoDate','D','D',@DummyEchoDate);
+  FM.AddFunction(bcUser,'EchoDate2','D','D',@DummyEchoDate);
+  FM.AddFunction(bcUser,'EchoDate3','D','D',@DummyEchoDate);
+  AssertEquals('Count before',3,FM.IdentifierCount);
+  AssertEquals('Result ',1,FM.Remove('EchoDate2'));
+  AssertEquals('Count after',2,FM.IdentifierCount);
+  AssertEquals('No more',-1,FM.IndexOfIdentifier('EchoDate2'));
+  AssertEquals('Left 1',0,FM.IndexOfIdentifier('EchoDate'));
+  AssertEquals('Left 2',1,FM.IndexOfIdentifier('EchoDate3'));
+  AssertEquals('Result ',-1,FM.Remove('Nono'));
+end;
+
+
+procedure SetExpression(const AExpression: String);
+Var
+  Msg : String;
+begin
+  Msg:='';
+  try
+    FP.Expression:=AExpression;
+  except
+    On E : Exception do
+      Msg:=E.message;
+  end;
+  If (Msg<>'') then
+    Fail('Parsing of expression "'+AExpression+'" failed :'+Msg);
+end;
+
+procedure AssertResult(F: TExprFloat);
+begin
+  AssertEquals('Float result', F, FP.AsFloat, 1E-9);
+end;
+
+procedure AssertResult(I: Int64);
+begin
+  AssertEquals('Integer result', I, FP.AsInteger);
+end;
+
+procedure AssertResult(S: String);
+begin
+  AssertEquals('String result', S, FP.AsString);
+end;
+
+procedure AssertResult(B: Boolean);
+begin
+  AssertEquals('Boolean result', B, FP.AsBoolean);
+end;
+
+procedure AssertDateTimeResult(D: TDateTime);
+begin
+  AssertEquals('DateTime result', D, FP.AsDateTime, 2/SecsPerDay);
+end;
+
+procedure AssertCurrencyResult(C: Currency);
+begin
+  AssertEquals('Currency result', C, FP.AsCurrency, 1E-9);
+end;
+
+procedure AssertExpression(const AExpression: String; AResult: Int64);
+begin
+  FP.BuiltIns:=AllBuiltIns;
+  SetExpression(AExpression);
+  AssertResult(AResult);
+end;
+
+procedure AssertExpression(const AExpression: String; const AResult: String);
+begin
+  FP.BuiltIns:=AllBuiltIns;
+  SetExpression(AExpression);
+  AssertResult(AResult);
+end;
+
+procedure AssertExpression(const AExpression: String; const AResult: TExprFloat);
+begin
+  FP.BuiltIns:=AllBuiltIns;
+  SetExpression(AExpression);
+  AssertResult(AResult);
+end;
+
+procedure AssertExpression(const AExpression: String; const AResult: Boolean);
+begin
+  FP.BuiltIns:=AllBuiltIns;
+  SetExpression(AExpression);
+  AssertResult(AResult);
+end;
+
+procedure AssertDateTimeExpression(const AExpression: String; const AResult: TDateTime);
+begin
+  FP.BuiltIns:=AllBuiltIns;
+  SetExpression(AExpression);
+  AssertDateTimeResult(AResult);
+end;
+
+procedure AssertAggregateExpression(const AExpression: String; AResult: Int64; AUpdateCount: integer);
+begin
+  FP.BuiltIns:=AllBuiltIns;
+  SetExpression(AExpression);
+  AssertEquals('Has aggregate',True,FP.ExprNode.HasAggregate);
+  FP.InitAggregate;
+  While AUpdateCount>0 do
+    begin
+    FP.UpdateAggregate;
+    Dec(AUpdateCount);
+    end;
+  AssertResult(AResult);
+end;
+
+procedure AssertAggregateExpression(const AExpression: String; AResult: TExprFloat; AUpdateCount: integer);
+begin
+  FP.BuiltIns:=AllBuiltIns;
+  SetExpression(AExpression);
+  AssertEquals('Has aggregate',True,FP.ExprNode.HasAggregate);
+  FP.InitAggregate;
+  While AUpdateCount>0 do
+    begin
+    FP.UpdateAggregate;
+    Dec(AUpdateCount);
+    end;
+  AssertResult(AResult);
+end;
+
+procedure AssertAggregateCurrExpression(Const AExpression : String; AResult : Currency; AUpdateCount : integer);
+begin
+  FP.BuiltIns:=AllBuiltIns;
+  SetExpression(AExpression);
+  AssertEquals('Has aggregate',True,FP.ExprNode.HasAggregate);
+  FP.InitAggregate;
+  While AUpdateCount>0 do
+    begin
+    FP.UpdateAggregate;
+    Dec(AUpdateCount);
+    end;
+  AssertCurrencyResult(AResult);
+end;
+
+function TestBuiltins_TestVariablepi: TTestString;
+begin
+  Result := '';
+  AssertExpression('pi',Pi);
+end;
+
+function TestBuiltins_TestFunctioncos: TTestString;
+begin
+  Result := '';
+  AssertExpression('cos(0.5)',Cos(0.5));
+  AssertExpression('cos(0.75)',Cos(0.75));
+end;
+
+function TestBuiltins_TestFunctionsin: TTestString;
+begin
+  Result := '';
+  AssertExpression('sin(0.5)',sin(0.5));
+  AssertExpression('sin(0.75)',sin(0.75));
+end;
+
+function TestBuiltins_TestFunctionarctan: TTestString;
+begin
+  Result := '';
+  AssertExpression('arctan(0.5)',arctan(0.5));
+  AssertExpression('arctan(0.75)',arctan(0.75));
+end;
+
+function TestBuiltins_TestFunctionabs: TTestString;
+begin
+  Result := '';
+  AssertExpression('abs(0.5)',0.5);
+  AssertExpression('abs(-0.75)',0.75);
+end;
+
+function TestBuiltins_TestFunctionsqr: TTestString;
+begin
+  Result := '';
+  AssertExpression('sqr(0.5)',sqr(0.5));
+  AssertExpression('sqr(-0.75)',sqr(0.75));
+end;
+
+function TestBuiltins_TestFunctionsqrt: TTestString;
+begin
+  Result := '';
+  AssertExpression('sqrt(0.5)',sqrt(0.5));
+  AssertExpression('sqrt(0.75)',sqrt(0.75));
+end;
+
+function TestBuiltins_TestFunctionexp: TTestString;
+begin
+  Result := '';
+  AssertExpression('exp(1.0)',exp(1));
+  AssertExpression('exp(0.0)',1.0);
+end;
+
+function TestBuiltins_TestFunctionln: TTestString;
+begin
+  Result := '';
+  AssertExpression('ln(0.5)',ln(0.5));
+  AssertExpression('ln(1.5)',ln(1.5));
+end;
+
+function TestBuiltins_TestFunctionlog: TTestString;
+begin
+  Result := '';
+  AssertExpression('log(0.5)',ln(0.5)/ln(10.0));
+  AssertExpression('log(1.5)',ln(1.5)/ln(10.0));
+  AssertExpression('log(10.0)',1.0);
+end;
+
+function TestBuiltins_TestFunctionfrac: TTestString;
+begin
+  Result := '';
+  AssertExpression('frac(0.5)',frac(0.5));
+  AssertExpression('frac(1.5)',frac(1.5));
+end;
+
+function TestBuiltins_TestFunctionint: TTestString;
+begin
+  Result := '';
+  AssertExpression('int(0.5)',int(0.5));
+  AssertExpression('int(1.5)',int(1.5));
+end;
+
+function TestBuiltins_TestFunctionround: TTestString;
+begin
+  Result := '';
+  AssertExpression('round(0.5)',round(0.5));
+  AssertExpression('round(1.55)',round(1.55));
+end;
+
+function TestBuiltins_TestFunctiontrunc: TTestString;
+begin
+  Result := '';
+  AssertExpression('trunc(0.5)',trunc(0.5));
+  AssertExpression('trunc(1.55)',trunc(1.55));
+end;
+
+function TestBuiltins_TestFunctionlength: TTestString;
+begin
+  Result := '';
+  AssertExpression('length(''123'')',3);
+end;
+
+function TestBuiltins_TestFunctioncopy: TTestString;
+begin
+  Result := '';
+  AssertExpression('copy(''123456'',2,4)','2345');
+end;
+
+function TestBuiltins_TestFunctiondelete: TTestString;
+begin
+  Result := '';
+  AssertExpression('delete(''123456'',2,4)','16');
+end;
+
+function TestBuiltins_TestFunctionpos: TTestString;
+begin
+  Result := '';
+  AssertExpression('pos(''234'',''123456'')',2);
+end;
+
+function TestBuiltins_TestFunctionlowercase: TTestString;
+begin
+  Result := '';
+  AssertExpression('lowercase(''AbCdEf'')','abcdef');
+end;
+
+function TestBuiltins_TestFunctionuppercase: TTestString;
+begin
+  Result := '';
+  AssertExpression('uppercase(''AbCdEf'')','ABCDEF');
+end;
+
+function TestBuiltins_TestFunctionstringreplace: TTestString;
+begin
+  Result := '';
+  // last options are replaceall, ignorecase
+  AssertExpression('stringreplace(''AbCdEf'',''C'',''Z'',false,false)','AbZdEf');
+  AssertExpression('stringreplace(''AbCdEf'',''c'',''Z'',false,false)','AbCdEf');
+  AssertExpression('stringreplace(''AbCdEf'',''c'',''Z'',false,true)','AbZdEf');
+  AssertExpression('stringreplace(''AbCdEfC'',''C'',''Z'',false,false)','AbZdEfC');
+  AssertExpression('stringreplace(''AbCdEfC'',''C'',''Z'',True,false)','AbZdEfZ');
+end;
+
+function TestBuiltins_TestFunctioncomparetext: TTestString;
+begin
+  Result := '';
+  AssertExpression('comparetext(''AbCdEf'',''AbCdEf'')',0);
+  AssertExpression('comparetext(''AbCdEf'',''ABCDEF'')',0);
+  AssertExpression('comparetext(''AbCdEf'',''FEDCBA'')',comparetext('AbCdEf','FEDCBA'));
+end;
+
+function TestBuiltins_TestFunctiondate: TTestString;
+begin
+  Result := '';
+  AssertDateTimeExpression('date',date);
+end;
+
+function TestBuiltins_TestFunctiontime: TTestString;
+begin
+  Result := '';
+  AssertDateTimeExpression('time',time);
+end;
+
+function TestBuiltins_TestFunctionnow: TTestString;
+begin
+  Result := '';
+  AssertDateTimeExpression('now',now);
+end;
+
+function TestBuiltins_TestFunctiondayofweek: TTestString;
+begin
+  Result := '';
+  FP.Identifiers.AddDateTimeVariable('D',Date);
+  AssertExpression('dayofweek(d)',DayOfWeek(date));
+end;
+
+function TestBuiltins_TestFunctionextractyear: TTestString;
+Var
+  Y,M,D : Word;
+begin
+  Result := '';
+  DecodeDate(Date,Y,M,D);
+  FP.Identifiers.AddDateTimeVariable('D',Date);
+  AssertExpression('extractyear(d)',Y);
+end;
+
+function TestBuiltins_TestFunctionextractmonth: TTestString;
+Var
+  Y,M,D : Word;
+begin
+  Result := '';
+  FP.Identifiers.AddDateTimeVariable('D',Date);
+  DecodeDate(Date,Y,M,D);
+  AssertExpression('extractmonth(d)',M);
+end;
+
+function TestBuiltins_TestFunctionextractday: TTestString;
+Var
+  Y,M,D : Word;
+begin
+  Result := '';
+  DecodeDate(Date,Y,M,D);
+  FP.Identifiers.AddDateTimeVariable('D',Date);
+  AssertExpression('extractday(d)',D);
+end;
+
+function TestBuiltins_TestFunctionextracthour: TTestString;
+Var
+  T : TDateTime;
+  H,m,s,ms : Word;
+begin
+  Result := '';
+  T:=Time;
+  DecodeTime(T,h,m,s,ms);
+  FP.Identifiers.AddDateTimeVariable('T',T);
+  AssertExpression('extracthour(t)',h);
+end;
+
+function TestBuiltins_TestFunctionextractmin: TTestString;
+Var
+  T : TDateTime;
+  H,m,s,ms : Word;
+begin
+  Result := '';
+  T:=Time;
+  DecodeTime(T,h,m,s,ms);
+  FP.Identifiers.AddDateTimeVariable('T',T);
+  AssertExpression('extractmin(t)',m);
+end;
+
+function TestBuiltins_TestFunctionextractsec: TTestString;
+Var
+  T : TDateTime;
+  H,m,s,ms : Word;
+begin
+  Result := '';
+  T:=Time;
+  DecodeTime(T,h,m,s,ms);
+  FP.Identifiers.AddDateTimeVariable('T',T);
+  AssertExpression('extractsec(t)',s);
+end;
+
+function TestBuiltins_TestFunctionextractmsec: TTestString;
+Var
+  T : TDateTime;
+  H,m,s,ms : Word;
+begin
+  Result := '';
+  T:=Time;
+  DecodeTime(T,h,m,s,ms);
+  FP.Identifiers.AddDateTimeVariable('T',T);
+  AssertExpression('extractmsec(t)',ms);
+end;
+
+function TestBuiltins_TestFunctionencodedate: TTestString;
+begin
+  Result := '';
+  AssertDateTimeExpression('encodedate(2008,10,11)',EncodeDate(2008,10,11));
+end;
+
+function TestBuiltins_TestFunctionencodetime: TTestString;
+begin
+  Result := '';
+  AssertDateTimeExpression('encodetime(14,10,11,0)',EncodeTime(14,10,11,0));
+end;
+
+function TestBuiltins_TestFunctionencodedatetime: TTestString;
+begin
+  Result := '';
+  AssertDateTimeExpression('encodedatetime(2008,12,13,14,10,11,0)',EncodeDate(2008,12,13)+EncodeTime(14,10,11,0));
+end;
+
+function TestBuiltins_TestFunctionshortdayname: TTestString;
+begin
+  Result := '';
+  AssertExpression('shortdayname(1)',ShortDayNames[1]);
+  AssertExpression('shortdayname(7)',ShortDayNames[7]);
+end;
+
+function TestBuiltins_TestFunctionshortmonthname: TTestString;
+begin
+  Result := '';
+  AssertExpression('shortmonthname(1)',ShortMonthNames[1]);
+  AssertExpression('shortmonthname(12)',ShortMonthNames[12]);
+end;
+
+function TestBuiltins_TestFunctionlongdayname: TTestString;
+begin
+  Result := '';
+  AssertExpression('longdayname(1)',longDayNames[1]);
+  AssertExpression('longdayname(7)',longDayNames[7]);
+end;
+
+function TestBuiltins_TestFunctionlongmonthname: TTestString;
+begin
+  Result := '';
+  AssertExpression('longmonthname(1)',longMonthNames[1]);
+  AssertExpression('longmonthname(12)',longMonthNames[12]);
+end;
+
+function TestBuiltins_TestFunctionformatdatetime: TTestString;
+begin
+  Result := '';
+  AssertExpression('FormatDateTime(''cccc'',Date)',FormatDateTime('cccc',Date));
+end;
+
+function TestBuiltins_TestFunctionshl: TTestString;
+Var
+  I : Int64;
+begin
+  Result := '';
+  AssertExpression('shl(12,3)',12 shl 3);
+  I:=12 shl 30;
+  AssertExpression('shl(12,30)',I);
+end;
+
+function TestBuiltins_TestFunctionshr: TTestString;
+begin
+  Result := '';
+  AssertExpression('shr(12,2)',12 shr 2);
+end;
+
+function TestBuiltins_TestFunctionIFS: TTestString;
+begin
+  Result := '';
+  AssertExpression('ifs(true,''string1'',''string2'')','string1');
+  AssertExpression('ifs(false,''string1'',''string2'')','string2');
+end;
+
+function TestBuiltins_TestFunctionIFF: TTestString;
+begin
+  Result := '';
+  AssertExpression('iff(true,1.0,2.0)',1.0);
+  AssertExpression('iff(false,1.0,2.0)',2.0);
+end;
+
+function TestBuiltins_TestFunctionIFD: TTestString;
+begin
+  Result := '';
+  FP.Identifiers.AddDateTimeVariable('A',Date);
+  FP.Identifiers.AddDateTimeVariable('B',Date-1);
+  AssertDateTimeExpression('ifd(true,A,B)',Date);
+  AssertDateTimeExpression('ifd(false,A,B)',Date-1);
+end;
+
+function TestBuiltins_TestFunctionIFI: TTestString;
+begin
+  Result := '';
+  AssertExpression('ifi(true,1,2)',1);
+  AssertExpression('ifi(false,1,2)',2);
+end;
+
+function TestBuiltins_TestFunctioninttostr: TTestString;
+begin
+  Result := '';
+  AssertExpression('inttostr(2)','2');
+end;
+
+function TestBuiltins_TestFunctionstrtoint: TTestString;
+begin
+  Result := '';
+  AssertExpression('strtoint(''2'')',2);
+end;
+
+function TestBuiltins_TestFunctionstrtointdef: TTestString;
+begin
+  Result := '';
+  AssertExpression('strtointdef(''abc'',2)',2);
+end;
+
+function TestBuiltins_TestFunctionfloattostr: TTestString;
+begin
+  Result := '';
+  AssertExpression('floattostr(1.23)',Floattostr(1.23));
+end;
+
+function TestBuiltins_TestFunctionstrtofloat: TTestString;
+Var
+  S : String;
+begin
+  Result := '';
+  S:='1.23';
+  S[2]:=DecimalSeparator;
+  AssertExpression('strtofloat('''+S+''')',1.23);
+end;
+
+function TestBuiltins_TestFunctionstrtofloatdef: TTestString;
+begin
+  Result := '';
+  AssertExpression('strtofloatdef(''abc'',1.23)',1.23);
+end;
+
+function TestBuiltins_TestFunctionbooltostr: TTestString;
+begin
+  Result := '';
+  AssertExpression('booltostr(True)','True');
+end;
+
+function TestBuiltins_TestFunctionstrtobool: TTestString;
+begin
+  Result := '';
+  AssertExpression('strtobool(''0'')',false);
+end;
+
+function TestBuiltins_TestFunctionstrtobooldef: TTestString;
+begin
+  Result := '';
+  AssertExpression('strtobooldef(''XYZ'',True)',True);
+end;
+
+function TestBuiltins_TestFunctiondatetostr: TTestString;
+begin
+  Result := '';
+  FP.Identifiers.AddDateTimeVariable('A',Date);
+  AssertExpression('DateToStr(A)',DateToStr(Date));
+end;
+
+function TestBuiltins_TestFunctiontimetostr: TTestString;
+Var
+  T : TDateTime;
+begin
+  Result := '';
+  T:=Time;
+  FP.Identifiers.AddDateTimeVariable('A',T);
+  AssertExpression('TimeToStr(A)',TimeToStr(T));
+end;
+
+function TestBuiltins_TestFunctionstrtodate: TTestString;
+begin
+  Result := '';
+  FP.Identifiers.AddStringVariable('S',DateToStr(Date));
+  AssertDateTimeExpression('StrToDate(S)',Date);
+end;
+
+function TestBuiltins_TestFunctionstrtodatedef: TTestString;
+begin
+  Result := '';
+  FP.Identifiers.AddDateTimeVariable('A',Date);
+  AssertDateTimeExpression('StrToDateDef(''S'',A)',Date);
+end;
+
+function TestBuiltins_TestFunctionstrtotime: TTestString;
+Var
+  T : TDateTime;
+begin
+  Result := '';
+  T:=Time;
+  FP.Identifiers.AddStringVariable('S',TimeToStr(T));
+  AssertDateTimeExpression('StrToTime(S)',T);
+end;
+
+function TestBuiltins_TestFunctionstrtotimedef: TTestString;
+Var
+  T : TDateTime;
+begin
+  Result := '';
+  T:=Time;
+  FP.Identifiers.AddDateTimeVariable('S',T);
+  AssertDateTimeExpression('StrToTimeDef(''q'',S)',T);
+end;
+
+function TestBuiltins_TestFunctionstrtodatetime: TTestString;
+Var
+  T : TDateTime;
+  S : String;
+begin
+  Result := '';
+  T:=Now;
+  S:=DateTimetostr(T);
+  AssertDateTimeExpression('StrToDateTime('''+S+''')',T);
+end;
+
+function TestBuiltins_TestFunctionstrtodatetimedef: TTestString;
+Var
+  T : TDateTime;
+  S : String;
+begin
+  Result := '';
+  T:=Now;
+  S:=DateTimetostr(T);
+  FP.Identifiers.AddDateTimeVariable('S',T);
+  AssertDateTimeExpression('StrToDateTimeDef('''+S+''',S)',T);
+end;
+
+function TestBuiltins_TestFunctionAggregateSum: TTestString;
+begin
+  Result := '';
+  FP.Identifiers.AddIntegerVariable('S',2);
+  AssertAggregateExpression('sum(S)',10,5);
+end;
+
+function TestBuiltins_TestFunctionAggregateSumFloat: TTestString;
+begin
+  Result := '';
+  FP.Identifiers.AddFloatVariable('S',2.0);
+  AssertAggregateExpression('sum(S)',10.0,5);
+end;
+
+function TestBuiltins_TestFunctionAggregateSumCurrency: TTestString;
+begin
+  Result := '';
+  FP.Identifiers.AddCurrencyVariable('S',2.0);
+  AssertAggregateCurrExpression('sum(S)',Currency(10.0),5);
+end;
+
+function TestBuiltins_TestFunctionAggregateCount: TTestString;
+begin
+  Result := '';
+  AssertAggregateExpression('count',5,5);
+end;
+
+procedure DoAverage(var Result: TFPExpressionResult; ConstRef AName: ShortString);
+begin
+  Inc(FValue);
+  Result.ResInteger:=FValue;
+  Result.ResultType:=rtInteger;
+end;
+
+procedure DoSeries(var Result: TFPExpressionResult; ConstRef AName: ShortString);
+Const
+  Values : Array[1..10] of double =
+  (1.3,1.8,1.1,9.9,1.4,2.4,5.8,6.5,7.8,8.1);
+begin
+  Inc(FValue);
+  Result.ResFloat:=Values[FValue];
+  Result.ResultType:=rtFloat;
+end;
+
+function TestBuiltins_TestFunctionAggregateAvg: TTestString;
+begin
+  Result := '';
+  FP.Identifiers.AddVariable('S',rtInteger,@DoAverage);
+  AssertAggregateExpression('avg(S)',5.5,10);
+end;
+
+function TestBuiltins_TestFunctionAggregateMin: TTestString;
+begin
+  Result := '';
+  FP.Identifiers.AddVariable('S',rtFloat,@DoSeries);
+  AssertAggregateExpression('Min(S)',1.1,10);
+end;
+
+function TestBuiltins_TestFunctionAggregateMax: TTestString;
+begin
+  Result := '';
+  FP.Identifiers.AddVariable('S',rtFloat,@DoSeries);
+  AssertAggregateExpression('Max(S)',9.9,10);
+end;
+
+
+procedure InitFileFormatSettings;
+begin
+  FileFormatSettings := DefaultFormatSettings;
+  FileFormatSettings.DecimalSeparator := '.';
+  FileFormatSettings.DateSeparator := '-';
+  FileFormatSettings.TimeSeparator := ':';
+  FileFormatsettings.ShortDateFormat := 'yyyy-mm-dd';
+  FileFormatSettings.LongTimeFormat := 'hh:nn:ss';
+end;
+
+procedure RegisterTests(aTop : PSuite);
+var
+  lSuite : PSuite;
+begin
+  InitFileFormatSettings;
+  lSuite:=AddSuite('TBuiltinsManagerTests', @SuiteSetup, @SuiteTearDown,aTop, true);
+  AddTest('TestCreate', @TestBuiltinsManager_TestCreate, lSuite);
+  AddTest('TestVariable1', @TestBuiltinsManager_TestVariable1, lSuite);
+  AddTest('TestVariable2', @TestBuiltinsManager_TestVariable2, lSuite);
+  AddTest('TestVariable3', @TestBuiltinsManager_TestVariable3, lSuite);
+  AddTest('TestVariable4', @TestBuiltinsManager_TestVariable4, lSuite);
+  AddTest('TestVariable5', @TestBuiltinsManager_TestVariable5, lSuite);
+  AddTest('TestVariable6', @TestBuiltinsManager_TestVariable6, lSuite);
+  AddTest('TestVariable7', @TestBuiltinsManager_TestVariable7, lSuite);
+  AddTest('TestFunction1', @TestBuiltinsManager_TestFunction1, lSuite);
+  AddTest('TestFunction2', @TestBuiltinsManager_TestFunction2, lSuite);
+  AddTest('TestDelete', @TestBuiltinsManager_TestDelete, lSuite);
+  AddTest('TestRemove', @TestBuiltinsManager_TestRemove, lSuite);
+
+  lSuite:=AddSuite('TBuiltinsTests', @SuiteSetup, @SuiteTearDown, aTop, True);
+  AddTest('TestVariablepi', @TestBuiltins_TestVariablepi, lSuite);
+  AddTest('TestFunctioncos', @TestBuiltins_TestFunctioncos, lSuite);
+  AddTest('TestFunctionsin', @TestBuiltins_TestFunctionsin, lSuite);
+  AddTest('TestFunctionarctan', @TestBuiltins_TestFunctionarctan, lSuite);
+  AddTest('TestFunctionabs', @TestBuiltins_TestFunctionabs, lSuite);
+  AddTest('TestFunctionsqr', @TestBuiltins_TestFunctionsqr, lSuite);
+  AddTest('TestFunctionsqrt', @TestBuiltins_TestFunctionsqrt, lSuite);
+  AddTest('TestFunctionexp', @TestBuiltins_TestFunctionexp, lSuite);
+  AddTest('TestFunctionln', @TestBuiltins_TestFunctionln, lSuite);
+  AddTest('TestFunctionlog', @TestBuiltins_TestFunctionlog, lSuite);
+  AddTest('TestFunctionfrac', @TestBuiltins_TestFunctionfrac, lSuite);
+  AddTest('TestFunctionint', @TestBuiltins_TestFunctionint, lSuite);
+  AddTest('TestFunctionround', @TestBuiltins_TestFunctionround, lSuite);
+  AddTest('TestFunctiontrunc', @TestBuiltins_TestFunctiontrunc, lSuite);
+  AddTest('TestFunctionlength', @TestBuiltins_TestFunctionlength, lSuite);
+  AddTest('TestFunctioncopy', @TestBuiltins_TestFunctioncopy, lSuite);
+  AddTest('TestFunctiondelete', @TestBuiltins_TestFunctiondelete, lSuite);
+  AddTest('TestFunctionpos', @TestBuiltins_TestFunctionpos, lSuite);
+  AddTest('TestFunctionlowercase', @TestBuiltins_TestFunctionlowercase, lSuite);
+  AddTest('TestFunctionuppercase', @TestBuiltins_TestFunctionuppercase, lSuite);
+  AddTest('TestFunctionstringreplace', @TestBuiltins_TestFunctionstringreplace, lSuite);
+  AddTest('TestFunctioncomparetext', @TestBuiltins_TestFunctioncomparetext, lSuite);
+  AddTest('TestFunctiondate', @TestBuiltins_TestFunctiondate, lSuite);
+  AddTest('TestFunctiontime', @TestBuiltins_TestFunctiontime, lSuite);
+  AddTest('TestFunctionnow', @TestBuiltins_TestFunctionnow, lSuite);
+  AddTest('TestFunctiondayofweek', @TestBuiltins_TestFunctiondayofweek, lSuite);
+  AddTest('TestFunctionextractyear', @TestBuiltins_TestFunctionextractyear, lSuite);
+  AddTest('TestFunctionextractmonth', @TestBuiltins_TestFunctionextractmonth, lSuite);
+  AddTest('TestFunctionextractday', @TestBuiltins_TestFunctionextractday, lSuite);
+  AddTest('TestFunctionextracthour', @TestBuiltins_TestFunctionextracthour, lSuite);
+  AddTest('TestFunctionextractmin', @TestBuiltins_TestFunctionextractmin, lSuite);
+  AddTest('TestFunctionextractsec', @TestBuiltins_TestFunctionextractsec, lSuite);
+  AddTest('TestFunctionextractmsec', @TestBuiltins_TestFunctionextractmsec, lSuite);
+  AddTest('TestFunctionencodedate', @TestBuiltins_TestFunctionencodedate, lSuite);
+  AddTest('TestFunctionencodetime', @TestBuiltins_TestFunctionencodetime, lSuite);
+  AddTest('TestFunctionencodedatetime', @TestBuiltins_TestFunctionencodedatetime, lSuite);
+  AddTest('TestFunctionshortdayname', @TestBuiltins_TestFunctionshortdayname, lSuite);
+  AddTest('TestFunctionshortmonthname', @TestBuiltins_TestFunctionshortmonthname, lSuite);
+  AddTest('TestFunctionlongdayname', @TestBuiltins_TestFunctionlongdayname, lSuite);
+  AddTest('TestFunctionlongmonthname', @TestBuiltins_TestFunctionlongmonthname, lSuite);
+  AddTest('TestFunctionformatdatetime', @TestBuiltins_TestFunctionformatdatetime, lSuite);
+  AddTest('TestFunctionshl', @TestBuiltins_TestFunctionshl, lSuite);
+  AddTest('TestFunctionshr', @TestBuiltins_TestFunctionshr, lSuite);
+  AddTest('TestFunctionIFS', @TestBuiltins_TestFunctionIFS, lSuite);
+  AddTest('TestFunctionIFF', @TestBuiltins_TestFunctionIFF, lSuite);
+  AddTest('TestFunctionIFD', @TestBuiltins_TestFunctionIFD, lSuite);
+  AddTest('TestFunctionIFI', @TestBuiltins_TestFunctionIFI, lSuite);
+  AddTest('TestFunctioninttostr', @TestBuiltins_TestFunctioninttostr, lSuite);
+  AddTest('TestFunctionstrtoint', @TestBuiltins_TestFunctionstrtoint, lSuite);
+  AddTest('TestFunctionstrtointdef', @TestBuiltins_TestFunctionstrtointdef, lSuite);
+  AddTest('TestFunctionfloattostr', @TestBuiltins_TestFunctionfloattostr, lSuite);
+  AddTest('TestFunctionstrtofloat', @TestBuiltins_TestFunctionstrtofloat, lSuite);
+  AddTest('TestFunctionstrtofloatdef', @TestBuiltins_TestFunctionstrtofloatdef, lSuite);
+  AddTest('TestFunctionbooltostr', @TestBuiltins_TestFunctionbooltostr, lSuite);
+  AddTest('TestFunctionstrtobool', @TestBuiltins_TestFunctionstrtobool, lSuite);
+  AddTest('TestFunctionstrtobooldef', @TestBuiltins_TestFunctionstrtobooldef, lSuite);
+  AddTest('TestFunctiondatetostr', @TestBuiltins_TestFunctiondatetostr, lSuite);
+  AddTest('TestFunctiontimetostr', @TestBuiltins_TestFunctiontimetostr, lSuite);
+  AddTest('TestFunctionstrtodate', @TestBuiltins_TestFunctionstrtodate, lSuite);
+  AddTest('TestFunctionstrtodatedef', @TestBuiltins_TestFunctionstrtodatedef, lSuite);
+  AddTest('TestFunctionstrtotime', @TestBuiltins_TestFunctionstrtotime, lSuite);
+  AddTest('TestFunctionstrtotimedef', @TestBuiltins_TestFunctionstrtotimedef, lSuite);
+  AddTest('TestFunctionstrtodatetime', @TestBuiltins_TestFunctionstrtodatetime, lSuite);
+  AddTest('TestFunctionstrtodatetimedef', @TestBuiltins_TestFunctionstrtodatetimedef, lSuite);
+  AddTest('TestFunctionAggregateSum', @TestBuiltins_TestFunctionAggregateSum, lSuite);
+  AddTest('TestFunctionAggregateSumFloat', @TestBuiltins_TestFunctionAggregateSumFloat, lSuite);
+  AddTest('TestFunctionAggregateSumCurrency', @TestBuiltins_TestFunctionAggregateSumCurrency, lSuite);
+  AddTest('TestFunctionAggregateCount', @TestBuiltins_TestFunctionAggregateCount, lSuite);
+  AddTest('TestFunctionAggregateAvg', @TestBuiltins_TestFunctionAggregateAvg, lSuite);
+  AddTest('TestFunctionAggregateMin', @TestBuiltins_TestFunctionAggregateMin, lSuite);
+  AddTest('TestFunctionAggregateMax', @TestBuiltins_TestFunctionAggregateMax, lSuite);
+end;
+
+end.

+ 419 - 0
packages/fcl-base/tests/utcexprparsaggr.pp

@@ -0,0 +1,419 @@
+unit utcExprParsAggr;
+
+{$mode objfpc}
+{$h+}
+interface
+
+uses
+  Classes, SysUtils, math, punit, fpexprpars;
+
+procedure RegisterTests(aTop : PSuite);
+
+implementation
+
+uses typinfo;
+
+type
+  TAggregateNode = Class(TFPExprNode)
+  Public
+    InitCount : Integer;
+    UpdateCount : Integer;
+    Class Function IsAggregate: Boolean; override;
+    Function NodeType: TResultType; override;
+    Procedure InitAggregate; override;
+    Procedure UpdateAggregate; override;
+    procedure GetNodeValue(var Result: TFPExpressionResult); override;
+  end;
+
+  TVarCallback = class
+    procedure GetVar(var Result: TFPExpressionResult; constref AName: ShortString);
+  end;
+
+var
+  VarCallBack : TVarCallback;
+  FVarValue : Integer;
+  FLeft : TAggregateNode;
+  FRight : TAggregateNode;
+  FFunction : TFPExprIdentifierDef;
+  FFunction2 : TFPExprIdentifierDef;
+
+
+procedure TVarCallback.GetVar(var Result: TFPExpressionResult; constref AName: ShortString);
+begin
+  Result.ResultType:=FFunction2.ResultType;
+  Case Result.ResultType of
+    rtInteger : Result.ResInteger:=FVarValue;
+    rtFloat : Result.ResFloat:=FVarValue / 2;
+    rtCurrency : Result.ResCurrency:=FVarValue / 2;
+  end;
+end;
+
+procedure AssertEquals(Msg: String; AExpected, AActual: TResultType); overload;
+begin
+  AssertEquals(Msg, ResultTypeName(AExpected), ResultTypeName(AActual));
+end;
+
+
+function SuiteSetup: TTestString;
+begin
+  Result := '';
+  FVarValue:=0;
+  VarCallBack:=TVarCallback.Create;
+  FFunction:=TFPExprIdentifierDef.Create(Nil);
+  FFunction.Name:='Count';
+  FFunction2:=TFPExprIdentifierDef.Create(Nil);
+  FFunction2.Name:='MyVar';
+  FFunction2.ResultType:=rtInteger;
+  FFunction2.IdentifierType:=itVariable;
+  FFunction2.OnGetVariableValue:[email protected];
+  FLeft:=TAggregateNode.Create;
+  FRight:=TAggregateNode.Create;
+end;
+
+function SuiteTearDown: TTestString;
+begin
+  Result := '';
+  FreeAndNil(VarCallBack);
+  FreeAndNil(FFunction);
+  FreeAndNil(FFunction2);
+  FreeAndNil(FLeft);
+  FreeAndNil(FRight);
+end;
+
+function TestParserAggregate_TestIsAggregate: TTestString;
+begin
+  Result:='';
+  AssertEquals('ExprNode',False,TFPExprNode.IsAggregate);
+  AssertEquals('TAggregateExpr',True,TAggregateExpr.IsAggregate);
+  AssertEquals('TAggregateExpr',False,TFPBinaryOperation.IsAggregate);
+end;
+
+function TestParserAggregate_TestHasAggregate: TTestString;
+Var
+  N :  TFPExprNode;
+begin
+  Result:='';
+  N:=TFPExprNode.Create;
+  try
+    AssertEquals('ExprNode',False,N.HasAggregate);
+  finally
+    N.Free;
+  end;
+  N:=TAggregateExpr.Create;
+  try
+    AssertEquals('TAggregateExpr',True,N.HasAggregate);
+  finally
+    N.Free;
+  end;
+end;
+
+function TestParserAggregate_TestBinaryAggregate: TTestString;
+Var
+  B :  TFPBinaryOperation;
+begin
+  Result:='';
+  B:=TFPBinaryOperation.Create(Fleft,TFPConstExpression.CreateInteger(1));
+  try
+    FLeft:=Nil;
+    AssertEquals('Binary',True,B.HasAggregate);
+  finally
+    B.Free;
+    FLeft:=TAggregateNode.Create; // Recreate for next test
+  end;
+  B:=TFPBinaryOperation.Create(TFPConstExpression.CreateInteger(1),FRight);
+  try
+    FRight:=Nil;
+    AssertEquals('Binary',True,B.HasAggregate);
+  finally
+    B.Free;
+    FRight:=TAggregateNode.Create; // Recreate for next test
+  end;
+end;
+
+function TestParserAggregate_TestUnaryAggregate: TTestString;
+Var
+  B : TFPUnaryOperator;
+begin
+  Result:='';
+  B:=TFPUnaryOperator.Create(Fleft);
+  try
+    FLeft:=Nil;
+    AssertEquals('Unary',True,B.HasAggregate);
+  finally
+    B.Free;
+    FLeft:=TAggregateNode.Create; // Recreate for next test
+  end;
+end;
+
+function TestParserAggregate_TestCountAggregate: TTestString;
+Var
+  C : TAggregateCount;
+  I : Integer;
+  R : TFPExpressionResult;
+begin
+  Result:='';
+  FFunction.ResultType:=rtInteger;
+  FFunction.ParameterTypes:='';
+  C:=TAggregateCount.CreateFunction(FFunction,Nil);
+  try
+    C.Check;
+    C.InitAggregate;
+    For I:=1 to 11 do
+      C.UpdateAggregate;
+    C.GetNodeValue(R);
+    AssertEquals('Correct type',rtInteger,R.ResultType);
+    AssertEquals('Correct value',11,R.ResInteger);
+  finally
+    C.Free;
+  end;
+end;
+
+function TestParserAggregate_TestSumAggregate: TTestString;
+Var
+  C : TAggregateSum;
+  V : TFPExprVariable;
+  I : Integer;
+  R : TFPExpressionResult;
+  A : TExprArgumentArray;
+begin
+  Result:='';
+  FFunction.ResultType:=rtInteger;
+  FFunction.ParameterTypes:='I';
+  FFunction.Name:='SUM';
+  FFunction2.ResultType:=rtInteger;
+  C:=Nil;
+  V:=TFPExprVariable.CreateIdentifier(FFunction2);
+  try
+    SetLength(A,1);
+    A[0]:=V;
+    C:=TAggregateSum.CreateFunction(FFunction,A);
+    C.Check;
+    C.InitAggregate;
+    For I:=1 to 10 do
+      begin
+      FVarValue:=I;
+      C.UpdateAggregate;
+      end;
+    C.GetNodeValue(R);
+    AssertEquals('Correct type',rtInteger,R.ResultType);
+    AssertEquals('Correct value',55,R.ResInteger);
+  finally
+    C.Free;
+  end;
+end;
+
+function TestParserAggregate_TestSumAggregate2: TTestString;
+Var
+  C : TAggregateSum;
+  V : TFPExprVariable;
+  I : Integer;
+  R : TFPExpressionResult;
+  A : TExprArgumentArray;
+begin
+  Result:='';
+  FFunction.ResultType:=rtFloat;
+  FFunction.ParameterTypes:='F';
+  FFunction.Name:='SUM';
+  FFunction2.ResultType:=rtFloat;
+  C:=Nil;
+  V:=TFPExprVariable.CreateIdentifier(FFunction2);
+  try
+    SetLength(A,1);
+    A[0]:=V;
+    C:=TAggregateSum.CreateFunction(FFunction,A);
+    C.Check;
+    C.InitAggregate;
+    For I:=1 to 10 do
+      begin
+      FVarValue:=I;
+      C.UpdateAggregate;
+      end;
+    C.GetNodeValue(R);
+    AssertEquals('Correct type',rtFloat,R.ResultType);
+    AssertEquals('Correct value',55/2,R.ResFloat,0.1);
+  finally
+    C.Free;
+  end;
+end;
+
+function TestParserAggregate_TestSumAggregate3: TTestString;
+Var
+  C : TAggregateSum;
+  V : TFPExprVariable;
+  I : Integer;
+  R : TFPExpressionResult;
+  A : TExprArgumentArray;
+begin
+  Result:='';
+  FFunction.ResultType:=rtCurrency;
+  FFunction.ParameterTypes:='F';
+  FFunction.Name:='SUM';
+  FFunction2.ResultType:=rtCurrency;
+  C:=Nil;
+  V:=TFPExprVariable.CreateIdentifier(FFunction2);
+  try
+    SetLength(A,1);
+    A[0]:=V;
+    C:=TAggregateSum.CreateFunction(FFunction,A);
+    C.Check;
+    C.InitAggregate;
+    For I:=1 to 10 do
+      begin
+      FVarValue:=I;
+      C.UpdateAggregate;
+      end;
+    C.GetNodeValue(R);
+    AssertEquals('Correct type',rtCurrency,R.ResultType);
+    AssertEquals('Correct value',55/2,R.ResCurrency,0.1);
+  finally
+    C.Free;
+  end;
+end;
+
+function TestParserAggregate_TestAvgAggregate: TTestString;
+Var
+  C : TAggregateAvg;
+  V : TFPExprVariable;
+  I : Integer;
+  R : TFPExpressionResult;
+  A : TExprArgumentArray;
+begin
+  Result:='';
+  FFunction.ResultType:=rtInteger;
+  FFunction.ParameterTypes:='F';
+  FFunction.Name:='AVG';
+  FFunction2.ResultType:=rtInteger;
+  C:=Nil;
+  V:=TFPExprVariable.CreateIdentifier(FFunction2);
+  try
+    SetLength(A,1);
+    A[0]:=V;
+    C:=TAggregateAvg.CreateFunction(FFunction,A);
+    C.Check;
+    C.InitAggregate;
+    For I:=1 to 10 do
+      begin
+      FVarValue:=I;
+      C.UpdateAggregate;
+      end;
+    C.GetNodeValue(R);
+    AssertEquals('Correct type',rtFloat,R.ResultType);
+    AssertEquals('Correct value',5.5,R.ResFloat,0.1);
+  finally
+    C.Free;
+  end;
+end;
+
+function TestParserAggregate_TestAvgAggregate2: TTestString;
+Var
+  C : TAggregateAvg;
+  V : TFPExprVariable;
+  I : Integer;
+  R : TFPExpressionResult;
+  A : TExprArgumentArray;
+begin
+  Result:='';
+  FFunction.ResultType:=rtInteger;
+  FFunction.ParameterTypes:='F';
+  FFunction.Name:='AVG';
+  FFunction2.ResultType:=rtFloat;
+  C:=Nil;
+  V:=TFPExprVariable.CreateIdentifier(FFunction2);
+  try
+    SetLength(A,1);
+    A[0]:=V;
+    C:=TAggregateAvg.CreateFunction(FFunction,A);
+    C.Check;
+    C.InitAggregate;
+    For I:=1 to 10 do
+      begin
+      FVarValue:=I;
+      C.UpdateAggregate;
+      end;
+    C.GetNodeValue(R);
+    AssertEquals('Correct type',rtFloat,R.ResultType);
+    AssertEquals('Correct value',5.5/2,R.ResFloat,0.1);
+  finally
+    C.Free;
+  end;
+end;
+
+function TestParserAggregate_TestAvgAggregate3: TTestString;
+Var
+  C : TAggregateAvg;
+  V : TFPExprVariable;
+  R : TFPExpressionResult;
+  A : TExprArgumentArray;
+begin
+  Result:='';
+  FFunction.ResultType:=rtInteger;
+  FFunction.ParameterTypes:='F';
+  FFunction.Name:='AVG';
+  FFunction2.ResultType:=rtFloat;
+  C:=Nil;
+  V:=TFPExprVariable.CreateIdentifier(FFunction2);
+  try
+    SetLength(A,1);
+    A[0]:=V;
+    C:=TAggregateAvg.CreateFunction(FFunction,A);
+    C.Check;
+    C.InitAggregate;
+    C.GetNodeValue(R);
+    AssertEquals('Correct type',rtFloat,R.ResultType);
+    AssertEquals('Correct value',0.0,R.ResFloat,0.1);
+  finally
+    C.Free;
+  end;
+end;
+
+{ TAggregateNode }
+
+class function TAggregateNode.IsAggregate: Boolean;
+begin
+  Result:=True
+end;
+
+function TAggregateNode.NodeType: TResultType;
+begin
+  Result:=rtInteger;
+end;
+
+procedure TAggregateNode.InitAggregate;
+begin
+  inherited InitAggregate;
+  inc(InitCount)
+end;
+
+procedure TAggregateNode.UpdateAggregate;
+begin
+  inherited UpdateAggregate;
+  inc(UpdateCount);
+end;
+
+procedure TAggregateNode.GetNodeValue(var Result: TFPExpressionResult);
+begin
+  Result.ResultType:=rtInteger;
+  Result.ResInteger:=updateCount;
+end;
+
+procedure RegisterTests(aTop: PSuite);
+
+var
+  lSuite : PSuite;
+
+begin
+  lSuite:=AddSuite('TParserAggregateTests', @SuiteSetup, @SuiteTearDown, aTop);
+  AddTest('TestIsAggregate', @TestParserAggregate_TestIsAggregate, lSuite);
+  AddTest('TestHasAggregate', @TestParserAggregate_TestHasAggregate, lSuite);
+  AddTest('TestBinaryAggregate', @TestParserAggregate_TestBinaryAggregate, lSuite);
+  AddTest('TestUnaryAggregate', @TestParserAggregate_TestUnaryAggregate, lSuite);
+  AddTest('TestCountAggregate', @TestParserAggregate_TestCountAggregate, lSuite);
+  AddTest('TestSumAggregate', @TestParserAggregate_TestSumAggregate, lSuite);
+  AddTest('TestSumAggregate2', @TestParserAggregate_TestSumAggregate2, lSuite);
+  AddTest('TestSumAggregate3', @TestParserAggregate_TestSumAggregate3, lSuite);
+  AddTest('TestAvgAggregate', @TestParserAggregate_TestAvgAggregate, lSuite);
+  AddTest('TestAvgAggregate2', @TestParserAggregate_TestAvgAggregate2, lSuite);
+  AddTest('TestAvgAggregate3', @TestParserAggregate_TestAvgAggregate3, lSuite);
+end;
+
+end.

+ 2612 - 0
packages/fcl-base/tests/utcexprparsnodes.pp

@@ -0,0 +1,2612 @@
+unit utcExprParsNodes;
+
+{$mode objfpc}
+{$h+}
+interface
+
+uses
+  Classes, SysUtils, punit, fpexprpars;
+
+procedure RegisterTests(aTop : PSuite);
+
+procedure AssertEquals(Msg: String; AResultType: TResultType;  ANode: TFPExprNode); overload;
+procedure AssertEquals(Msg: String; AExpected, AActual: TResultType); overload;
+procedure AssertNodeType(Msg: String; AClass: TClass;  ANode: TFPExprNode);
+
+
+implementation
+
+Type
+  TMyDestroyNode = Class(TFPConstExpression)
+  Public
+    Destructor Destroy; override;
+  end;
+
+Var
+  FCheckNode : TFPExprNode;
+  FDestroyCalled : Integer;
+  
+function SuiteSetup: TTestString;
+begin
+  Result := '';
+  FCheckNode := Nil;
+  FDestroyCalled:=0;
+end;
+
+function SuiteTearDown: TTestString;
+begin
+  Result := '';
+end;
+
+procedure DoCheck;
+begin
+  FCheckNode.Check;
+end;
+
+procedure AssertNodeType(Msg: String; AClass: TClass;  ANode: TFPExprNode);
+begin
+  AssertNotNull(Msg+': Not null',ANode);
+  AssertEquals(Msg+': Class OK',AClass,ANode.ClassType);
+end;
+
+procedure AssertEquals(Msg: String; AResultType: TResultType;  ANode: TFPExprNode); overload;
+begin
+  AssertNotNull(Msg+': Node not null',ANode);
+  AssertEquals(Msg,AResultType,Anode.NodeType);
+end;
+
+procedure AssertEquals(Msg: String; AExpected, AActual: TResultType); overload;
+
+begin
+  AssertEquals(Msg,ResultTypeName(AExpected),ResultTypeName(AActual));
+end;
+
+function CreateIntNode(AInteger: Integer): TFPExprNode;
+begin
+  Result:=TFPConstExpression.CreateInteger(AInteger);
+end;
+
+function CreateFloatNode(AFloat: TExprFloat): TFPExprNode;
+begin
+  Result:=TFPConstExpression.CreateFloat(AFloat);
+end;
+
+function CreateStringNode(Astring: String): TFPExprNode;
+begin
+  Result:=TFPConstExpression.CreateString(AString);
+end;
+
+function CreateDateTimeNode(ADateTime: TDateTime): TFPExprNode;
+begin
+  Result:=TFPConstExpression.CreateDateTime(ADateTime);
+end;
+
+procedure AssertNodeOK(FN: TFPExprNode);
+
+Var
+  B : Boolean;
+  Msg : String;
+
+begin
+  AssertNotNull('Node to test OK',FN);
+  B:=False;
+  try
+    FN.Check;
+    B:=True;
+  except
+    On E : Exception do
+      Msg:=E.Message;
+  end;
+  If Not B then
+    Fail(Format('Node %s not OK: %s',[FN.ClassName,Msg]));
+end;
+
+procedure AssertNodeNotOK(const MSg : String; FN: TFPExprNode);
+begin
+  FCheckNode:=FN;
+  AssertException(Msg,EExprParser,@DoCheck);
+end;
+
+function CreateBoolNode(ABoolean: Boolean): TFPExprNode;
+begin
+  Result:=TFPConstExpression.CreateBoolean(ABoolean);
+end;
+
+destructor TMyDestroyNode.Destroy;
+begin
+  Inc(FDestroyCalled);
+  inherited Destroy;
+end;
+
+Function TestDestroyNode_TestDestroy : TTestString;
+Var
+  FN : TMyDestroyNode;
+begin
+  Result:='';
+  FDestroyCalled := 0;
+  AssertEquals('Destroy not called yet',0,FDestroyCalled);
+  FN:=TMyDestroyNode.CreateInteger(1);
+  FN.Free;
+  AssertEquals('Destroy called',1,FDestroyCalled)
+end;
+
+Function TestConstExprNode_TestCreateInteger : TTestString;
+var
+  FN : TFPConstExpression;
+begin
+  Result:='';
+  FN:=TFPConstExpression.CreateInteger(1);
+  try
+    AssertEquals('Correct type',rtInteger,FN.NodeType);
+    AssertEquals('Correct result',1,FN.ConstValue.ResInteger);
+    AssertEquals('Correct result',1,FN.NodeValue.ResInteger);
+    AssertEquals('AsString ok','1',FN.AsString);
+  finally
+    FN.Free;
+  end;
+end;
+
+Function TestConstExprNode_TestCreateFloat : TTestString;
+Var
+  FN : TFPConstExpression;
+  F : Double;
+  C : Integer;
+begin
+  Result:='';
+  FN:=TFPConstExpression.CreateFloat(2.34);
+  try
+    AssertEquals('Correct type',rtFloat,FN.NodeType);
+    AssertEquals('Correct result',2.34,FN.ConstValue.ResFloat);
+    AssertEquals('Correct result',2.34,FN.NodeValue.ResFloat);
+    Val(FN.AsString,F,C);
+    AssertEquals('Correct conversion',0,C);
+    AssertEquals('AsString ok',2.34,F,0.001);
+  finally
+    FN.Free;
+  end;
+end;
+
+Function TestConstExprNode_TestCreateBoolean : TTestString;
+var
+  FN : TFPConstExpression;
+begin
+  Result:='';
+  FN:=TFPConstExpression.CreateBoolean(True);
+  try
+    AssertEquals('Correct type',rtBoolean,FN.NodeType);
+    AssertEquals('Correct result',True,FN.ConstValue.ResBoolean);
+    AssertEquals('Correct result',True,FN.NodeValue.ResBoolean);
+    AssertEquals('AsString ok','True',FN.AsString);
+  finally
+    FN.Free;
+  end;
+  FN:=TFPConstExpression.CreateBoolean(False);
+  try
+    AssertEquals('AsString ok','False',FN.AsString);
+  finally
+    FN.Free;
+  end;
+end;
+
+Function TestConstExprNode_TestCreateDateTime : TTestString;
+Var
+  FN : TFPConstExpression;
+  D : TDateTime;
+  S : String;
+begin
+  Result:='';
+  D:=Now;
+  FN:=TFPConstExpression.CreateDateTime(D);
+  try
+    AssertEquals('Correct type',rtDateTime,FN.NodeType);
+    AssertEquals('Correct result',D,FN.ConstValue.ResDateTime);
+    AssertEquals('Correct result',D,FN.NodeValue.ResDateTime);
+    S:=''''+FormatDateTime('cccc',D)+'''';
+    AssertEquals('AsString ok',S,FN.AsString);
+  finally
+    FN.Free;
+  end;
+end;
+
+Function TestConstExprNode_TestCreateString : TTestString;
+Var
+  FN : TFPConstExpression;
+  S : String;
+begin
+  Result:='';
+  S:='Ohlala';
+  FN:=TFPConstExpression.CreateString(S);
+  try
+    AssertEquals('Correct type',rtString,FN.NodeType);
+    AssertEquals('Correct result',S,FN.ConstValue.ResString);
+    AssertEquals('Correct result',S,FN.NodeValue.ResString);
+    AssertEquals('AsString ok',''''+S+'''',FN.AsString);
+  finally
+    FN.Free;
+  end;
+end;
+
+Function TestNegateExprNode_TestCreateInteger : TTestString;
+var
+  FN : TFPNegateOperation;
+begin
+  Result:='';
+  FN:=TFPNegateOperation.Create(CreateIntNode(23));
+  try
+    AssertEquals('Negate has correct type',rtInteger,FN.NodeType);
+    AssertEquals('Negate has correct result',-23,FN.NodeValue.Resinteger);
+    AssertEquals('Negate has correct string','-23',FN.AsString);
+    AssertNodeOK(FN);
+  finally
+    FN.Free;
+  end;
+end;
+
+Function TestNegateExprNode_TestCreateFloat : TTestString;
+var
+  FN : TFPNegateOperation;
+  S : String;
+begin
+  Result:='';
+  FN:=TFPNegateOperation.Create(CreateFloatNode(1.23));
+  try
+    AssertEquals('Negate has correct type',rtFloat,FN.NodeType);
+    AssertEquals('Negate has correct result',-1.23,FN.NodeValue.ResFloat);
+    Str(TExprFloat(-1.23),S);
+    AssertEquals('Negate has correct string',S,FN.AsString);
+    AssertNodeOK(FN);
+  finally
+    FN.Free;
+  end;
+end;
+
+Function TestNegateExprNode_TestCreateOther1 : TTestString;
+var
+  FN : TFPNegateOperation;
+begin
+  Result:='';
+  FN:=TFPNegateOperation.Create(TFPConstExpression.CreateString('1.23'));
+  try
+    AssertNodeNotOK('Negate does not accept string',FN);
+  finally
+    FN.Free;
+  end;
+end;
+
+Function TestNegateExprNode_TestCreateOther2 : TTestString;
+var
+  FN : TFPNegateOperation;
+begin
+  Result:='';
+  FN:=TFPNegateOperation.Create(TFPConstExpression.CreateBoolean(True));
+  try
+    AssertNodeNotOK('Negate does not accept boolean',FN)
+  finally
+    FN.Free;
+  end;
+end;
+
+Function TestNegateExprNode_TestDestroy : TTestString;
+var
+  FN : TFPNegateOperation;
+begin
+  Result:='';
+  FDestroyCalled := 0;
+  FN:=TFPNegateOperation.Create(TMyDestroyNode.CreateInteger(1));
+  FN.Free;
+  AssertEquals('Operand Destroy called',1,FDestroyCalled)
+end;
+
+Function TestBinaryAndNode_TestCreateInteger : TTestString;
+var
+  FN : TFPBinaryAndOperation;
+begin
+  Result:='';
+  FN:=TFPBinaryAndOperation.Create(CreateIntNode(3),CreateIntNode(2));
+  try
+    AssertNodeOK(FN);
+    AssertEquals('Correct node type',rtInteger,FN.NodeType);
+    AssertEquals('Correct result',2,FN.NodeValue.ResInteger);
+  finally
+    FN.Free;
+  end;
+end;
+
+Function TestBinaryAndNode_TestCreateBoolean : TTestString;
+var
+  FN : TFPBinaryAndOperation;
+begin
+  Result:='';
+  FN:=TFPBinaryAndOperation.Create(CreateBoolNode(True),CreateBoolNode(True));
+  try
+    AssertNodeOK(FN);
+    AssertEquals('Correct node type',rtBoolean,FN.NodeType);
+    AssertEquals('Correct result',True,FN.NodeValue.ResBoolean);
+  finally
+    FN.Free;
+  end;
+end;
+
+Function TestBinaryAndNode_TestCreateBooleanInteger : TTestString;
+var
+  FN : TFPBinaryAndOperation;
+begin
+  Result:='';
+  FN:=TFPBinaryAndOperation.Create(CreateBoolNode(True),CreateIntNode(0));
+  try
+    AssertNodeNotOK('Different node types',FN);
+  finally
+    FN.Free;
+  end;
+end;
+
+Function TestBinaryAndNode_TestCreateString : TTestString;
+var
+  FN : TFPBinaryAndOperation;
+begin
+  Result:='';
+  FN:=TFPBinaryAndOperation.Create(CreateStringNode('True'),CreateStringNode('True'));
+  try
+    AssertNodeNotOK('String node type',FN);
+  finally
+    FN.Free;
+  end;
+end;
+
+Function TestBinaryAndNode_TestCreateFloat : TTestString;
+var
+  FN : TFPBinaryAndOperation;
+begin
+  Result:='';
+  FN:=TFPBinaryAndOperation.Create(CreateFloatNode(1.23),CreateFloatNode(1.23));
+  try
+    AssertNodeNotOK('float node type',FN);
+  finally
+    FN.Free;
+  end;
+end;
+
+Function TestBinaryAndNode_TestCreateDateTime : TTestString;
+var
+  FN : TFPBinaryAndOperation;
+begin
+  Result:='';
+  FN:=TFPBinaryAndOperation.Create(CreateDateTimeNode(Now),CreateDateTimeNode(Now));
+  try
+    AssertNodeNotOK('DateTime node type',FN);
+  finally
+    FN.Free;
+  end;
+end;
+
+Function TestBinaryAndNode_TestDestroy : TTestString;
+var
+  FN : TFPBinaryAndOperation;
+begin
+  Result:='';
+  FDestroyCalled := 0;
+  FN:=TFPBinaryAndOperation.Create(TMyDestroyNode.CreateInteger(1),TMyDestroyNode.CreateInteger(1));
+  FN.Free;
+  AssertEquals('Destroy called for left and right nodes',2,FDestroyCalled)
+end;
+
+Function TestNotNode_TestCreateInteger : TTestString;
+var
+  FN : TFPNotNode;
+begin
+  Result:='';
+  FN:=TFPNotNode.Create(CreateIntNode(3));
+  try
+    AssertNodeOK(FN);
+    AssertEquals('Correct node type',rtInteger,FN.NodeType);
+    AssertEquals('Correct result',Not(Int64(3)),FN.NodeValue.ResInteger);
+  finally
+    FN.Free;
+  end;
+end;
+
+Function TestNotNode_TestCreateBoolean : TTestString;
+var
+  FN : TFPNotNode;
+begin
+  Result:='';
+  FN:=TFPNotNode.Create(CreateBoolNode(True));
+  try
+    AssertNodeOK(FN);
+    AssertEquals('Correct node type',rtBoolean,FN.NodeType);
+    AssertEquals('Correct result',False,FN.NodeValue.ResBoolean);
+  finally
+    FN.Free;
+  end;
+end;
+
+Function TestNotNode_TestCreateString : TTestString;
+var
+  FN : TFPNotNode;
+begin
+  Result:='';
+  FN:=TFPNotNode.Create(CreateStringNode('True'));
+  try
+    AssertNodeNotOK('String node type',FN);
+  finally
+    FN.Free;
+  end;
+end;
+
+Function TestNotNode_TestCreateFloat : TTestString;
+var
+  FN : TFPNotNode;
+begin
+  Result:='';
+  FN:=TFPNotNode.Create(CreateFloatNode(1.23));
+  try
+    AssertNodeNotOK('String node type',FN);
+  finally
+    FN.Free;
+  end;
+end;
+
+Function TestNotNode_TestCreateDateTime : TTestString;
+var
+  FN : TFPNotNode;
+begin
+  Result:='';
+  FN:=TFPNotNode.Create(CreateDateTimeNode(Now));
+  try
+    AssertNodeNotOK('String node type',FN);
+  finally
+    FN.Free;
+  end;
+end;
+
+Function TestNotNode_TestDestroy : TTestString;
+var
+  FN : TFPNotNode;
+begin
+  Result:='';
+  FDestroyCalled := 0;
+  FN:=TFPNotNode.Create(TMyDestroyNode.CreateInteger(1));
+  FN.Free;
+  AssertEquals('Destroy called for operand',1,FDestroyCalled)
+end;
+
+Function TestBinaryOrNode_TestCreateInteger : TTestString;
+var
+  FN : TFPBinaryOrOperation;
+begin
+  Result:='';
+  FN:=TFPBinaryOrOperation.Create(CreateIntNode(1),CreateIntNode(2));
+  try
+    AssertNodeOK(FN);
+    AssertEquals('Correct node type',rtInteger,FN.NodeType);
+    AssertEquals('Correct result',3,FN.NodeValue.ResInteger);
+  finally
+    FN.Free;
+  end;
+end;
+
+Function TestBinaryOrNode_TestCreateBoolean : TTestString;
+var
+  FN : TFPBinaryOrOperation;
+begin
+  Result:='';
+  FN:=TFPBinaryOrOperation.Create(CreateBoolNode(True),CreateBoolNode(False));
+  try
+    AssertNodeOK(FN);
+    AssertEquals('Correct node type',rtBoolean,FN.NodeType);
+    AssertEquals('Correct result',True,FN.NodeValue.ResBoolean);
+  finally
+    FN.Free;
+  end;
+end;
+
+Function TestBinaryOrNode_TestCreateBooleanInteger : TTestString;
+var
+  FN : TFPBinaryOrOperation;
+begin
+  Result:='';
+  FN:=TFPBinaryOrOperation.Create(CreateBoolNode(True),CreateIntNode(0));
+  try
+    AssertNodeNotOK('Different node types',FN);
+  finally
+    FN.Free;
+  end;
+end;
+
+Function TestBinaryOrNode_TestCreateString : TTestString;
+var
+  FN : TFPBinaryOrOperation;
+begin
+  Result:='';
+  FN:=TFPBinaryOrOperation.Create(CreateStringNode('True'),CreateStringNode('True'));
+  try
+    AssertNodeNotOK('String node type',FN);
+  finally
+    FN.Free;
+  end;
+end;
+
+Function TestBinaryOrNode_TestCreateFloat : TTestString;
+var
+  FN : TFPBinaryOrOperation;
+begin
+  Result:='';
+  FN:=TFPBinaryOrOperation.Create(CreateFloatNode(1.23),CreateFloatNode(1.23));
+  try
+    AssertNodeNotOK('float node type',FN);
+  finally
+    FN.Free;
+  end;
+end;
+
+Function TestBinaryOrNode_TestCreateDateTime : TTestString;
+var
+  FN : TFPBinaryOrOperation;
+begin
+  Result:='';
+  FN:=TFPBinaryOrOperation.Create(CreateDateTimeNode(Now),CreateDateTimeNode(Now));
+  try
+    AssertNodeNotOK('DateTime node type',FN);
+  finally
+    FN.Free;
+  end;
+end;
+
+Function TestBinaryOrNode_TestDestroy : TTestString;
+var
+  FN : TFPBinaryOrOperation;
+begin
+  Result:='';
+  FDestroyCalled := 0;
+  FN:=TFPBinaryOrOperation.Create(TMyDestroyNode.CreateInteger(1),TMyDestroyNode.CreateInteger(1));
+  FN.Free;
+  AssertEquals('Destroy called for left and right nodes',2,FDestroyCalled)
+end;
+
+Function TestBinaryXorNode_TestCreateInteger : TTestString;
+var
+  FN : TFPBinaryXorOperation;
+begin
+  Result:='';
+  FN:=TFPBinaryXorOperation.Create(CreateIntNode(1),CreateIntNode(2));
+  try
+    AssertNodeOK(FN);
+    AssertEquals('Correct node type',rtInteger,FN.NodeType);
+    AssertEquals('Correct result',3,FN.NodeValue.ResInteger);
+  finally
+    FN.Free;
+  end;
+end;
+
+Function TestBinaryXorNode_TestCreateBoolean : TTestString;
+var
+  FN : TFPBinaryXorOperation;
+begin
+  Result:='';
+  FN:=TFPBinaryXorOperation.Create(CreateBoolNode(True),CreateBoolNode(True));
+  try
+    AssertNodeOK(FN);
+    AssertEquals('Correct node type',rtBoolean,FN.NodeType);
+    AssertEquals('Correct result',False,FN.NodeValue.ResBoolean);
+  finally
+    FN.Free;
+  end;
+end;
+
+Function TestBinaryXorNode_TestCreateBooleanInteger : TTestString;
+var
+  FN : TFPBinaryXorOperation;
+begin
+  Result:='';
+  FN:=TFPBinaryXorOperation.Create(CreateBoolNode(True),CreateIntNode(0));
+  try
+    AssertNodeNotOK('Different node types',FN);
+  finally
+    FN.Free;
+  end;
+end;
+
+Function TestBinaryXorNode_TestCreateString : TTestString;
+var
+  FN : TFPBinaryXorOperation;
+begin
+  Result:='';
+  FN:=TFPBinaryXorOperation.Create(CreateStringNode('True'),CreateStringNode('True'));
+  try
+    AssertNodeNotOK('String node type',FN);
+  finally
+    FN.Free;
+  end;
+end;
+
+Function TestBinaryXorNode_TestCreateFloat : TTestString;
+var
+  FN : TFPBinaryXorOperation;
+begin
+  Result:='';
+  FN:=TFPBinaryXorOperation.Create(CreateFloatNode(1.23),CreateFloatNode(1.23));
+  try
+    AssertNodeNotOK('float node type',FN);
+  finally
+    FN.Free;
+  end;
+end;
+
+Function TestBinaryXorNode_TestCreateDateTime : TTestString;
+var
+  FN : TFPBinaryXorOperation;
+begin
+  Result:='';
+  FN:=TFPBinaryXorOperation.Create(CreateDateTimeNode(Now),CreateDateTimeNode(Now));
+  try
+    AssertNodeNotOK('DateTime node type',FN);
+  finally
+    FN.Free;
+  end;
+end;
+
+Function TestBinaryXorNode_TestDestroy : TTestString;
+var
+  FN : TFPBinaryXorOperation;
+begin
+  Result:='';
+  FDestroyCalled := 0;
+  FN:=TFPBinaryXorOperation.Create(TMyDestroyNode.CreateInteger(1),TMyDestroyNode.CreateInteger(1));
+  FN.Free;
+  AssertEquals('Destroy called for left and right nodes',2,FDestroyCalled)
+end;
+
+procedure TestEqualNode(B: TFPBooleanResultOperation; AResult: Boolean);
+begin
+  AssertEquals(Format('Test %s(%s,%s) result',[B.ClassName,B.Left.AsString,B.Right.AsString]),AResult,B.NodeValue.resBoolean);
+end;
+
+Function TestEqualNode_TestCreateIntegerEqual : TTestString;
+var
+  FN : TFPBooleanResultOperation;
+begin
+  Result:='';
+  FN:=TFPEqualOperation.Create(CreateIntNode(1),CreateIntNode(1));
+  try
+    AssertNodeOk(FN);
+    AssertEquals('Boolean result',rtBoolean,FN.NodeType);
+    TestEqualNode(FN,True);
+  finally
+    FN.Free;
+  end;
+end;
+
+Function TestEqualNode_TestCreateIntegerUnEqual : TTestString;
+var
+  FN : TFPBooleanResultOperation;
+begin
+  Result:='';
+  FN:=TFPEqualOperation.Create(CreateIntNode(2),CreateIntNode(1));
+  try
+    AssertNodeOk(FN);
+    AssertEquals('Boolean result',rtBoolean,FN.NodeType);
+    TestEqualNode(FN,False);
+  finally
+    FN.Free;
+  end;
+end;
+
+Function TestEqualNode_TestCreateFloatEqual : TTestString;
+var
+  FN : TFPBooleanResultOperation;
+begin
+  Result:='';
+  FN:=TFPEqualOperation.Create(CreateFloatNode(1.23),CreateFloatNode(1.23));
+  try
+    AssertNodeOk(FN);
+    AssertEquals('Boolean result',rtBoolean,FN.NodeType);
+    TestEqualNode(FN,True);
+  finally
+    FN.Free;
+  end;
+end;
+
+Function TestEqualNode_TestCreateFloatUnEqual : TTestString;
+var
+  FN : TFPBooleanResultOperation;
+begin
+  Result:='';
+  FN:=TFPEqualOperation.Create(CreateFloatNode(1.23),CreateFloatNode(1.34));
+  try
+    AssertNodeOk(FN);
+    AssertEquals('Boolean result',rtBoolean,FN.NodeType);
+    TestEqualNode(FN,False);
+  finally
+    FN.Free;
+  end;
+end;
+
+Function TestEqualNode_TestCreateStringEqual : TTestString;
+var
+  FN : TFPBooleanResultOperation;
+begin
+  Result:='';
+  FN:=TFPEqualOperation.Create(CreateStringNode('now'),CreateStringNode('now'));
+  try
+    AssertNodeOk(FN);
+    AssertEquals('Boolean result',rtBoolean,FN.NodeType);
+    TestEqualNode(FN,True);
+  finally
+    FN.Free;
+  end;
+end;
+
+Function TestEqualNode_TestCreateStringUnEqual : TTestString;
+var
+  FN : TFPBooleanResultOperation;
+begin
+  Result:='';
+  FN:=TFPEqualOperation.Create(CreateStringNode('now'),CreateStringNode('then'));
+  try
+    AssertNodeOk(FN);
+    AssertEquals('Boolean result',rtBoolean,FN.NodeType);
+    TestEqualNode(FN,False);
+  finally
+    FN.Free;
+  end;
+end;
+
+Function TestEqualNode_TestCreateBooleanEqual : TTestString;
+var
+  FN : TFPBooleanResultOperation;
+begin
+  Result:='';
+  FN:=TFPEqualOperation.Create(CreateBoolNode(True),CreateBoolNode(True));
+  try
+    AssertNodeOk(FN);
+    AssertEquals('Boolean result',rtBoolean,FN.NodeType);
+    TestEqualNode(FN,True);
+  finally
+    FN.Free;
+  end;
+end;
+
+Function TestEqualNode_TestCreateBooleanUnEqual : TTestString;
+var
+  FN : TFPBooleanResultOperation;
+begin
+  Result:='';
+  FN:=TFPEqualOperation.Create(CreateBoolNode(False),CreateBoolNode(True));
+  try
+    AssertNodeOk(FN);
+    AssertEquals('Boolean result',rtBoolean,FN.NodeType);
+    TestEqualNode(FN,False);
+  finally
+    FN.Free;
+  end;
+end;
+
+Function TestEqualNode_TestCreateDateTimeEqual : TTestString;
+Var
+  FN : TFPBooleanResultOperation;
+  D : TDateTime;
+begin
+  Result:='';
+  D:=Now;
+  FN:=TFPEqualOperation.Create(CreateDateTimeNode(D),CreateDateTimeNode(D));
+  try
+    AssertNodeOk(FN);
+    AssertEquals('Boolean result',rtBoolean,FN.NodeType);
+    TestEqualNode(FN,True);
+  finally
+    FN.Free;
+  end;
+end;
+
+Function TestEqualNode_TestCreateDateTimeUnEqual : TTestString;
+Var
+  FN : TFPBooleanResultOperation;
+  D : TDateTime;
+begin
+  Result:='';
+  D:=Now;
+  FN:=TFPEqualOperation.Create(CreateDateTimeNode(D),CreateDateTimeNode(D-1));
+  try
+    AssertNodeOk(FN);
+    AssertEquals('Boolean result',rtBoolean,FN.NodeType);
+    TestEqualNode(FN,False);
+  finally
+    FN.Free;
+  end;
+end;
+
+Function TestEqualNode_TestDestroy : TTestString;
+var
+  FN : TFPBooleanResultOperation;
+begin
+  Result:='';
+  FDestroyCalled := 0;
+  FN:=TFPEqualOperation.Create(TMyDestroyNode.CreateInteger(1),TMyDestroyNode.CreateInteger(1));
+  FN.Free;
+  AssertEquals('Destroy called for left and right nodes',2,FDestroyCalled)
+end;
+
+Function TestEqualNode_TestWrongTypes1 : TTestString;
+var
+  FN : TFPBooleanResultOperation;
+begin
+  Result:='';
+  FN:=TFPEqualOperation.Create(CreateIntNode(3),CreateStringNode('1.23'));
+  try
+    AssertNodeNotOk('Wrong Types',FN);
+  finally
+    FN.Free;
+  end;
+end;
+
+Function TestEqualNode_TestWrongTypes2 : TTestString;
+var
+  FN : TFPBooleanResultOperation;
+begin
+  Result:='';
+  FN:=TFPEqualOperation.Create(CreateDateTimeNode(3),CreateStringNode('1.23'));
+  try
+    AssertNodeNotOk('Wrong Types',FN);
+  finally
+    FN.Free;
+  end;
+end;
+
+Function TestEqualNode_TestWrongTypes3 : TTestString;
+var
+  FN : TFPBooleanResultOperation;
+begin
+  Result:='';
+  FN:=TFPEqualOperation.Create(CreateFloatNode(1.3),CreateStringNode('1.23'));
+  try
+    AssertNodeNotOk('Wrong Types',FN);
+  finally
+    FN.Free;
+  end;
+end;
+
+Function TestEqualNode_TestWrongTypes4 : TTestString;
+var
+  FN : TFPBooleanResultOperation;
+begin
+  Result:='';
+  FN:=TFPEqualOperation.Create(CreateBoolNode(False),CreateStringNode('1.23'));
+  try
+    AssertNodeNotOk('Wrong Types',FN);
+  finally
+    FN.Free;
+  end;
+end;
+
+Function TestEqualNode_TestWrongTypes5 : TTestString;
+var
+  FN : TFPBooleanResultOperation;
+begin
+  Result:='';
+  FN:=TFPEqualOperation.Create(CreateFloatNode(1),CreateIntNode(1));
+  try
+    AssertNodeNotOk('Wrong Types',FN);
+  finally
+    FN.Free;
+  end;
+end;
+
+Function TestEqualNode_TestAsString : TTestString;
+var
+  FN : TFPBooleanResultOperation;
+begin
+  Result:='';
+  FN:=TFPEqualOperation.Create(CreateIntNode(1),CreateIntNode(2));
+  try
+    AssertEquals('Asstring works ok','1 = 2',FN.AsString);
+  finally
+    FN.Free;
+  end;
+end;
+
+Function TestUnEqualNode_TestCreateIntegerEqual : TTestString;
+var
+  FN : TFPBooleanResultOperation;
+begin
+  Result:='';
+  FN:=TFPUnEqualOperation.Create(CreateIntNode(1),CreateIntNode(1));
+  try
+    AssertNodeOk(FN);
+    AssertEquals('Boolean result',rtBoolean,FN.NodeType);
+    TestEqualNode(FN,False);
+  finally
+    FN.Free;
+  end;
+end;
+
+Function TestUnEqualNode_TestCreateIntegerUnEqual : TTestString;
+var
+  FN : TFPBooleanResultOperation;
+begin
+  Result:='';
+  FN:=TFPUnEqualOperation.Create(CreateIntNode(2),CreateIntNode(1));
+  try
+    AssertNodeOk(FN);
+    AssertEquals('Boolean result',rtBoolean,FN.NodeType);
+    TestEqualNode(FN,True);
+  finally
+    FN.Free;
+  end;
+end;
+
+Function TestUnEqualNode_TestCreateFloatEqual : TTestString;
+var
+  FN : TFPBooleanResultOperation;
+begin
+  Result:='';
+  FN:=TFPUnEqualOperation.Create(CreateFloatNode(1.23),CreateFloatNode(1.23));
+  try
+    AssertNodeOk(FN);
+    AssertEquals('Boolean result',rtBoolean,FN.NodeType);
+    TestEqualNode(FN,False);
+  finally
+    FN.Free;
+  end;
+end;
+
+Function TestUnEqualNode_TestCreateFloatUnEqual : TTestString;
+var
+  FN : TFPBooleanResultOperation;
+begin
+  Result:='';
+  FN:=TFPUnEqualOperation.Create(CreateFloatNode(1.23),CreateFloatNode(1.34));
+  try
+    AssertNodeOk(FN);
+    AssertEquals('Boolean result',rtBoolean,FN.NodeType);
+    TestEqualNode(FN,True);
+  finally
+    FN.Free;
+  end;
+end;
+
+Function TestUnEqualNode_TestCreateStringEqual : TTestString;
+var
+  FN : TFPBooleanResultOperation;
+begin
+  Result:='';
+  FN:=TFPUnEqualOperation.Create(CreateStringNode('now'),CreateStringNode('now'));
+  try
+    AssertNodeOk(FN);
+    AssertEquals('Boolean result',rtBoolean,FN.NodeType);
+    TestEqualNode(FN,False);
+  finally
+    FN.Free;
+  end;
+end;
+
+Function TestUnEqualNode_TestCreateStringUnEqual : TTestString;
+var
+  FN : TFPBooleanResultOperation;
+begin
+  Result:='';
+  FN:=TFPUnEqualOperation.Create(CreateStringNode('now'),CreateStringNode('then'));
+  try
+    AssertNodeOk(FN);
+    AssertEquals('Boolean result',rtBoolean,FN.NodeType);
+    TestEqualNode(FN,True);
+  finally
+    FN.Free;
+  end;
+end;
+
+Function TestUnEqualNode_TestCreateBooleanEqual : TTestString;
+var
+  FN : TFPBooleanResultOperation;
+begin
+  Result:='';
+  FN:=TFPUnEqualOperation.Create(CreateBoolNode(True),CreateBoolNode(True));
+  try
+    AssertNodeOk(FN);
+    AssertEquals('Boolean result',rtBoolean,FN.NodeType);
+    TestEqualNode(FN,False);
+  finally
+    FN.Free;
+  end;
+end;
+
+Function TestUnEqualNode_TestCreateBooleanUnEqual : TTestString;
+var
+  FN : TFPBooleanResultOperation;
+begin
+  Result:='';
+  FN:=TFPUnEqualOperation.Create(CreateBoolNode(False),CreateBoolNode(True));
+  try
+    AssertNodeOk(FN);
+    AssertEquals('Boolean result',rtBoolean,FN.NodeType);
+    TestEqualNode(FN,True);
+  finally
+    FN.Free;
+  end;
+end;
+
+Function TestUnEqualNode_TestCreateDateTimeEqual : TTestString;
+Var
+  FN : TFPBooleanResultOperation;
+  D : TDateTime;
+begin
+  Result:='';
+  D:=Now;
+  FN:=TFPUnEqualOperation.Create(CreateDateTimeNode(D),CreateDateTimeNode(D));
+  try
+    AssertNodeOk(FN);
+    AssertEquals('Boolean result',rtBoolean,FN.NodeType);
+    TestEqualNode(FN,False);
+  finally
+    FN.Free;
+  end;
+end;
+
+Function TestUnEqualNode_TestCreateDateTimeUnEqual : TTestString;
+Var
+  FN : TFPBooleanResultOperation;
+  D : TDateTime;
+begin
+  Result:='';
+  D:=Now;
+  FN:=TFPUnEqualOperation.Create(CreateDateTimeNode(D),CreateDateTimeNode(D-1));
+  try
+    AssertNodeOk(FN);
+    AssertEquals('Boolean result',rtBoolean,FN.NodeType);
+    TestEqualNode(FN,True);
+  finally
+    FN.Free;
+  end;
+end;
+
+Function TestUnEqualNode_TestDestroy : TTestString;
+var
+  FN : TFPBooleanResultOperation;
+begin
+  Result:='';
+  FDestroyCalled := 0;
+  FN:=TFPUnEqualOperation.Create(TMyDestroyNode.CreateInteger(1),TMyDestroyNode.CreateInteger(1));
+  FN.Free;
+  AssertEquals('Destroy called for left and right nodes',2,FDestroyCalled)
+end;
+
+Function TestUnEqualNode_TestWrongTypes1 : TTestString;
+var
+  FN : TFPBooleanResultOperation;
+begin
+  Result:='';
+  FN:=TFPUnEqualOperation.Create(CreateIntNode(3),CreateStringNode('1.23'));
+  try
+    AssertNodeNotOk('Wrong Types',FN);
+  finally
+    FN.Free;
+  end;
+end;
+
+Function TestUnEqualNode_TestWrongTypes2 : TTestString;
+var
+  FN : TFPBooleanResultOperation;
+begin
+  Result:='';
+  FN:=TFPUnEqualOperation.Create(CreateDateTimeNode(3),CreateStringNode('1.23'));
+  try
+    AssertNodeNotOk('Wrong Types',FN);
+  finally
+    FN.Free;
+  end;
+end;
+
+Function TestUnEqualNode_TestWrongTypes3 : TTestString;
+var
+  FN : TFPBooleanResultOperation;
+begin
+  Result:='';
+  FN:=TFPUnEqualOperation.Create(CreateFloatNode(1.3),CreateStringNode('1.23'));
+  try
+    AssertNodeNotOk('Wrong Types',FN);
+  finally
+    FN.Free;
+  end;
+end;
+
+Function TestUnEqualNode_TestWrongTypes4 : TTestString;
+var
+  FN : TFPBooleanResultOperation;
+begin
+  Result:='';
+  FN:=TFPUnEqualOperation.Create(CreateBoolNode(False),CreateStringNode('1.23'));
+  try
+    AssertNodeNotOk('Wrong Types',FN);
+  finally
+    FN.Free;
+  end;
+end;
+
+Function TestUnEqualNode_TestWrongTypes5 : TTestString;
+var
+  FN : TFPBooleanResultOperation;
+begin
+  Result:='';
+  FN:=TFPUnEqualOperation.Create(CreateFloatNode(1),CreateIntNode(1));
+  try
+    AssertNodeNotOk('Wrong Types',FN);
+  finally
+    FN.Free;
+  end;
+end;
+
+Function TestUnEqualNode_TestAsString : TTestString;
+var
+  FN : TFPBooleanResultOperation;
+begin
+  Result:='';
+  FN:=TFPUnEqualOperation.Create(CreateIntNode(1),CreateIntNode(2));
+  try
+    AssertEquals('Asstring works ok','1 <> 2',FN.AsString);
+  finally
+    FN.Free;
+  end;
+end;
+
+Function TestLessThanNode_TestCreateDateTimeSmaller : TTestString;
+Var
+   FN : TFPBooleanResultOperation;
+   D : TDateTime;
+begin
+  Result:='';
+  D:=Now;
+  FN:=TFPLessThanOperation.Create(CreateDateTimeNode(D),CreateDateTimeNode(D+1));
+  try
+    AssertNodeOk(FN);
+    AssertEquals('Boolean result',rtBoolean,FN.NodeType);
+    TestEqualNode(FN,True);
+  finally
+    FN.Free;
+  end;
+end;
+
+Function TestLessThanNode_TestCreateDateTimeLarger : TTestString;
+Var
+  FN : TFPBooleanResultOperation;
+  D : TDateTime;
+begin
+  Result:='';
+  D:=Now;
+  FN:=TFPLessThanOperation.Create(CreateDateTimeNode(D),CreateDateTimeNode(D-1));
+  try
+    AssertNodeOk(FN);
+    AssertEquals('Boolean result',rtBoolean,FN.NodeType);
+    TestEqualNode(FN,False);
+  finally
+    FN.Free;
+  end;
+end;
+
+Function TestLessThanNode_TestCreateStringEqual : TTestString;
+var
+  FN : TFPBooleanResultOperation;
+begin
+  Result:='';
+  FN:=TFPLessThanOperation.Create(CreateStringNode('now'),CreateStringNode('now'));
+  try
+    AssertNodeOk(FN);
+    AssertEquals('Boolean result',rtBoolean,FN.NodeType);
+    TestEqualNode(FN,False);
+  finally
+    FN.Free;
+  end;
+end;
+
+Function TestLessThanNode_TestCreateStringSmaller : TTestString;
+var
+  FN : TFPBooleanResultOperation;
+begin
+  Result:='';
+  FN:=TFPLessThanOperation.Create(CreateStringNode('now'),CreateStringNode('then'));
+  try
+    AssertNodeOk(FN);
+    AssertEquals('Boolean result',rtBoolean,FN.NodeType);
+    TestEqualNode(FN,True);
+  finally
+    FN.Free;
+  end;
+end;
+
+Function TestLessThanNode_TestCreateStringLarger : TTestString;
+var
+  FN : TFPBooleanResultOperation;
+begin
+  Result:='';
+  FN:=TFPLessThanOperation.Create(CreateStringNode('then'),CreateStringNode('now'));
+  try
+    AssertNodeOk(FN);
+    AssertEquals('Boolean result',rtBoolean,FN.NodeType);
+    TestEqualNode(FN,False);
+  finally
+    FN.Free;
+  end;
+end;
+
+Function TestLessThanNode_TestWrongTypes1 : TTestString;
+var
+  FN : TFPBooleanResultOperation;
+begin
+  Result:='';
+  FN:=TFPLessThanOperation.Create(CreateIntNode(3),CreateStringNode('1.23'));
+  try
+    AssertNodeNotOk('Wrong Types',FN);
+  finally
+    FN.Free;
+  end;
+end;
+
+Function TestLessThanNode_TestWrongTypes2 : TTestString;
+var
+  FN : TFPBooleanResultOperation;
+begin
+  Result:='';
+  FN:=TFPLessThanOperation.Create(CreateDateTimeNode(3),CreateStringNode('1.23'));
+  try
+    AssertNodeNotOk('Wrong Types',FN);
+  finally
+    FN.Free;
+  end;
+end;
+
+Function TestLessThanNode_TestWrongTypes3 : TTestString;
+var
+  FN : TFPBooleanResultOperation;
+begin
+  Result:='';
+  FN:=TFPLessThanOperation.Create(CreateFloatNode(1.3),CreateStringNode('1.23'));
+  try
+    AssertNodeNotOk('Wrong Types',FN);
+  finally
+    FN.Free;
+  end;
+end;
+
+Function TestLessThanNode_TestWrongTypes4 : TTestString;
+var
+  FN : TFPBooleanResultOperation;
+begin
+  Result:='';
+  FN:=TFPLessThanOperation.Create(CreateBoolNode(False),CreateStringNode('1.23'));
+  try
+    AssertNodeNotOk('Wrong Types',FN);
+  finally
+    FN.Free;
+  end;
+end;
+
+Function TestLessThanNode_TestWrongTypes5 : TTestString;
+var
+  FN : TFPBooleanResultOperation;
+begin
+  Result:='';
+  FN:=TFPLessThanOperation.Create(CreateFloatNode(1.23),CreateIntNode(1));
+  try
+    AssertNodeNotOk('Wrong Types',FN);
+  finally
+    FN.Free;
+  end;
+end;
+
+Function TestLessThanNode_TestNoBoolean1 : TTestString;
+var
+  FN : TFPBooleanResultOperation;
+begin
+  Result:='';
+  FN:=TFPLessThanOperation.Create(CreateBoolNode(False),CreateIntNode(1));
+  try
+    AssertNodeNotOk('Wrong Types',FN);
+  finally
+    FN.Free;
+  end;
+end;
+
+Function TestLessThanNode_TestNoBoolean2 : TTestString;
+ var
+  FN : TFPBooleanResultOperation;
+begin
+  Result:='';
+  FN:=TFPLessThanOperation.Create(CreateIntNode(1),CreateBoolNode(False));
+  try
+    AssertNodeNotOk('Wrong Types',FN);
+  finally
+    FN.Free;
+  end;
+end;
+
+Function TestLessThanNode_TestNoBoolean3 : TTestString;
+var
+  FN : TFPBooleanResultOperation;
+begin
+  Result:='';
+  FN:=TFPLessThanOperation.Create(CreateBoolNode(False),CreateBoolNode(False));
+  try
+    AssertNodeNotOk('Wrong Types',FN);
+  finally
+    FN.Free;
+  end;
+end;
+
+Function TestLessThanNode_TestAsString : TTestString;
+var
+  FN : TFPBooleanResultOperation;
+begin
+  Result:='';
+  FN:=TFPLessThanOperation.Create(CreateIntNode(1),CreateIntNode(2));
+  try
+    AssertEquals('Asstring works ok','1 < 2',FN.AsString);
+  finally
+    FN.Free;
+  end;
+end;
+
+Function TestLessThanEqualNode_TestCreateDateTimeSmaller : TTestString;
+Var
+   FN : TFPBooleanResultOperation;
+   D : TDateTime;
+begin
+  Result:='';
+  D:=Now;
+  FN:=TFPLessThanEqualOperation.Create(CreateDateTimeNode(D),CreateDateTimeNode(D+1));
+  try
+    AssertNodeOk(FN);
+    AssertEquals('Boolean result',rtBoolean,FN.NodeType);
+    TestEqualNode(FN,True);
+  finally
+    FN.Free;
+  end;
+end;
+
+Function TestLessThanEqualNode_TestCreateDateTimeLarger : TTestString;
+Var
+  FN : TFPBooleanResultOperation;
+  D : TDateTime;
+begin
+  Result:='';
+  D:=Now;
+  FN:=TFPLessThanEqualOperation.Create(CreateDateTimeNode(D),CreateDateTimeNode(D-1));
+  try
+    AssertNodeOk(FN);
+    AssertEquals('Boolean result',rtBoolean,FN.NodeType);
+    TestEqualNode(FN,False);
+  finally
+    FN.Free;
+  end;
+end;
+
+Function TestLessThanEqualNode_TestCreateStringEqual : TTestString;
+var
+  FN : TFPBooleanResultOperation;
+begin
+  Result:='';
+  FN:=TFPLessThanEqualOperation.Create(CreateStringNode('now'),CreateStringNode('now'));
+  try
+    AssertNodeOk(FN);
+    AssertEquals('Boolean result',rtBoolean,FN.NodeType);
+    TestEqualNode(FN,True);
+  finally
+    FN.Free;
+  end;
+end;
+
+Function TestLessThanEqualNode_TestCreateStringSmaller : TTestString;
+var
+  FN : TFPBooleanResultOperation;
+begin
+  Result:='';
+  FN:=TFPLessThanEqualOperation.Create(CreateStringNode('now'),CreateStringNode('then'));
+  try
+    AssertNodeOk(FN);
+    AssertEquals('Boolean result',rtBoolean,FN.NodeType);
+    TestEqualNode(FN,True);
+  finally
+    FN.Free;
+  end;
+end;
+
+Function TestLessThanEqualNode_TestCreateStringLarger : TTestString;
+var
+  FN : TFPBooleanResultOperation;
+begin
+  Result:='';
+  FN:=TFPLessThanEqualOperation.Create(CreateStringNode('then'),CreateStringNode('now'));
+  try
+    AssertNodeOk(FN);
+    AssertEquals('Boolean result',rtBoolean,FN.NodeType);
+    TestEqualNode(FN,False);
+  finally
+    FN.Free;
+  end;
+end;
+
+Function TestLessThanEqualNode_TestWrongTypes1 : TTestString;
+var
+  FN : TFPBooleanResultOperation;
+begin
+  Result:='';
+  FN:=TFPLessThanEqualOperation.Create(CreateIntNode(3),CreateStringNode('1.23'));
+  try
+    AssertNodeNotOk('Wrong Types',FN);
+  finally
+    FN.Free;
+  end;
+end;
+
+Function TestLessThanEqualNode_TestWrongTypes2 : TTestString;
+var
+  FN : TFPBooleanResultOperation;
+begin
+  Result:='';
+  FN:=TFPLessThanEqualOperation.Create(CreateDateTimeNode(3),CreateStringNode('1.23'));
+  try
+    AssertNodeNotOk('Wrong Types',FN);
+  finally
+    FN.Free;
+  end;
+end;
+
+Function TestLessThanEqualNode_TestWrongTypes3 : TTestString;
+var
+  FN : TFPBooleanResultOperation;
+begin
+  Result:='';
+  FN:=TFPLessThanEqualOperation.Create(CreateFloatNode(1.3),CreateStringNode('1.23'));
+  try
+    AssertNodeNotOk('Wrong Types',FN);
+  finally
+    FN.Free;
+  end;
+end;
+
+Function TestLessThanEqualNode_TestWrongTypes4 : TTestString;
+var
+  FN : TFPBooleanResultOperation;
+begin
+  Result:='';
+  FN:=TFPLessThanEqualOperation.Create(CreateBoolNode(False),CreateStringNode('1.23'));
+  try
+    AssertNodeNotOk('Wrong Types',FN);
+  finally
+    FN.Free;
+  end;
+end;
+
+Function TestLessThanEqualNode_TestWrongTypes5 : TTestString;
+var
+  FN : TFPBooleanResultOperation;
+begin
+  Result:='';
+  FN:=TFPLessThanEqualOperation.Create(CreateFloatNode(1.23),CreateIntNode(1));
+  try
+    AssertNodeNotOk('Wrong Types',FN);
+  finally
+    FN.Free;
+  end;
+end;
+
+Function TestLessThanEqualNode_TestNoBoolean1 : TTestString;
+var
+  FN : TFPBooleanResultOperation;
+begin
+  Result:='';
+  FN:=TFPLessThanEqualOperation.Create(CreateBoolNode(False),CreateIntNode(1));
+  try
+    AssertNodeNotOk('Wrong Types',FN);
+  finally
+    FN.Free;
+  end;
+end;
+
+Function TestLessThanEqualNode_TestNoBoolean2 : TTestString;
+ var
+  FN : TFPBooleanResultOperation;
+begin
+  Result:='';
+  FN:=TFPLessThanEqualOperation.Create(CreateIntNode(1),CreateBoolNode(False));
+  try
+    AssertNodeNotOk('Wrong Types',FN);
+  finally
+    FN.Free;
+  end;
+end;
+
+Function TestLessThanEqualNode_TestNoBoolean3 : TTestString;
+var
+  FN : TFPBooleanResultOperation;
+begin
+  Result:='';
+  FN:=TFPLessThanEqualOperation.Create(CreateBoolNode(False),CreateBoolNode(False));
+  try
+    AssertNodeNotOk('Wrong Types',FN);
+  finally
+    FN.Free;
+  end;
+end;
+
+Function TestLessThanEqualNode_TestAsString : TTestString;
+var
+  FN : TFPBooleanResultOperation;
+begin
+  Result:='';
+  FN:=TFPLessThanEqualOperation.Create(CreateIntNode(1),CreateIntNode(2));
+  try
+    AssertEquals('Asstring works ok','1 <= 2',FN.AsString);
+  finally
+    FN.Free;
+  end;
+end;
+
+
+Function TestLargerThanNode_TestCreateDateTimeSmaller : TTestString;
+Var
+   FN : TFPBooleanResultOperation;
+   D : TDateTime;
+begin
+  Result:='';
+  D:=Now;
+  FN:=TFPGreaterThanOperation.Create(CreateDateTimeNode(D),CreateDateTimeNode(D+1));
+  try
+    AssertNodeOk(FN);
+    AssertEquals('Boolean result',rtBoolean,FN.NodeType);
+    TestEqualNode(FN,False);
+  finally
+    FN.Free;
+  end;
+end;
+
+Function TestLargerThanNode_TestCreateDateTimeLarger : TTestString;
+Var
+  FN : TFPBooleanResultOperation;
+  D : TDateTime;
+begin
+  Result:='';
+  D:=Now;
+  FN:=TFPGreaterThanOperation.Create(CreateDateTimeNode(D),CreateDateTimeNode(D-1));
+  try
+    AssertNodeOk(FN);
+    AssertEquals('Boolean result',rtBoolean,FN.NodeType);
+    TestEqualNode(FN,True);
+  finally
+    FN.Free;
+  end;
+end;
+
+Function TestLargerThanNode_TestCreateStringEqual : TTestString;
+var
+  FN : TFPBooleanResultOperation;
+begin
+  Result:='';
+  FN:=TFPGreaterThanOperation.Create(CreateStringNode('now'),CreateStringNode('now'));
+  try
+    AssertNodeOk(FN);
+    AssertEquals('Boolean result',rtBoolean,FN.NodeType);
+    TestEqualNode(FN,False);
+  finally
+    FN.Free;
+  end;
+end;
+
+Function TestLargerThanNode_TestCreateStringSmaller : TTestString;
+var
+  FN : TFPBooleanResultOperation;
+begin
+  Result:='';
+  FN:=TFPGreaterThanOperation.Create(CreateStringNode('now'),CreateStringNode('then'));
+  try
+    AssertNodeOk(FN);
+    AssertEquals('Boolean result',rtBoolean,FN.NodeType);
+    TestEqualNode(FN,False);
+  finally
+    FN.Free;
+  end;
+end;
+
+Function TestLargerThanNode_TestCreateStringLarger : TTestString;
+var
+  FN : TFPBooleanResultOperation;
+begin
+  Result:='';
+  FN:=TFPGreaterThanOperation.Create(CreateStringNode('then'),CreateStringNode('now'));
+  try
+    AssertNodeOk(FN);
+    AssertEquals('Boolean result',rtBoolean,FN.NodeType);
+    TestEqualNode(FN,True);
+  finally
+    FN.Free;
+  end;
+end;
+
+Function TestLargerThanNode_TestWrongTypes1 : TTestString;
+var
+  FN : TFPBooleanResultOperation;
+begin
+  Result:='';
+  FN:=TFPGreaterThanOperation.Create(CreateIntNode(3),CreateStringNode('1.23'));
+  try
+    AssertNodeNotOk('Wrong Types',FN);
+  finally
+    FN.Free;
+  end;
+end;
+
+Function TestLargerThanNode_TestWrongTypes2 : TTestString;
+var
+  FN : TFPBooleanResultOperation;
+begin
+  Result:='';
+  FN:=TFPGreaterThanOperation.Create(CreateDateTimeNode(3),CreateStringNode('1.23'));
+  try
+    AssertNodeNotOk('Wrong Types',FN);
+  finally
+    FN.Free;
+  end;
+end;
+
+Function TestLargerThanNode_TestWrongTypes3 : TTestString;
+var
+  FN : TFPBooleanResultOperation;
+begin
+  Result:='';
+  FN:=TFPGreaterThanOperation.Create(CreateFloatNode(1.3),CreateStringNode('1.23'));
+  try
+    AssertNodeNotOk('Wrong Types',FN);
+  finally
+    FN.Free;
+  end;
+end;
+
+Function TestLargerThanNode_TestWrongTypes4 : TTestString;
+var
+  FN : TFPBooleanResultOperation;
+begin
+  Result:='';
+  FN:=TFPGreaterThanOperation.Create(CreateBoolNode(False),CreateStringNode('1.23'));
+  try
+    AssertNodeNotOk('Wrong Types',FN);
+  finally
+    FN.Free;
+  end;
+end;
+
+Function TestLargerThanNode_TestWrongTypes5 : TTestString;
+var
+  FN : TFPBooleanResultOperation;
+begin
+  Result:='';
+  FN:=TFPGreaterThanOperation.Create(CreateFloatNode(1.23),CreateIntNode(1));
+  try
+    AssertNodeNotOk('Wrong Types',FN);
+  finally
+    FN.Free;
+  end;
+end;
+
+Function TestLargerThanNode_TestNoBoolean1 : TTestString;
+var
+  FN : TFPBooleanResultOperation;
+begin
+  Result:='';
+  FN:=TFPGreaterThanOperation.Create(CreateBoolNode(False),CreateIntNode(1));
+  try
+    AssertNodeNotOk('Wrong Types',FN);
+  finally
+    FN.Free;
+  end;
+end;
+
+Function TestLargerThanNode_TestNoBoolean2 : TTestString;
+ var
+  FN : TFPBooleanResultOperation;
+begin
+  Result:='';
+  FN:=TFPGreaterThanOperation.Create(CreateIntNode(1),CreateBoolNode(False));
+  try
+    AssertNodeNotOk('Wrong Types',FN);
+  finally
+    FN.Free;
+  end;
+end;
+
+Function TestLargerThanNode_TestNoBoolean3 : TTestString;
+var
+  FN : TFPBooleanResultOperation;
+begin
+  Result:='';
+  FN:=TFPGreaterThanOperation.Create(CreateBoolNode(False),CreateBoolNode(False));
+  try
+    AssertNodeNotOk('Wrong Types',FN);
+  finally
+    FN.Free;
+  end;
+end;
+
+Function TestLargerThanNode_TestAsString : TTestString;
+var
+  FN : TFPBooleanResultOperation;
+begin
+  Result:='';
+  FN:=TFPGreaterThanOperation.Create(CreateIntNode(1),CreateIntNode(2));
+  try
+    AssertEquals('Asstring works ok','1 > 2',FN.AsString);
+  finally
+    FN.Free;
+  end;
+end;
+
+Function TestLargerThanEqualNode_TestCreateDateTimeSmaller : TTestString;
+Var
+   FN : TFPBooleanResultOperation;
+   D : TDateTime;
+begin
+  Result:='';
+  D:=Now;
+  FN:=TFPGreaterThanEqualOperation.Create(CreateDateTimeNode(D),CreateDateTimeNode(D+1));
+  try
+    AssertNodeOk(FN);
+    AssertEquals('Boolean result',rtBoolean,FN.NodeType);
+    TestEqualNode(FN,False);
+  finally
+    FN.Free;
+  end;
+end;
+
+Function TestLargerThanEqualNode_TestCreateDateTimeLarger : TTestString;
+Var
+  FN : TFPBooleanResultOperation;
+  D : TDateTime;
+begin
+  Result:='';
+  D:=Now;
+  FN:=TFPGreaterThanEqualOperation.Create(CreateDateTimeNode(D),CreateDateTimeNode(D-1));
+  try
+    AssertNodeOk(FN);
+    AssertEquals('Boolean result',rtBoolean,FN.NodeType);
+    TestEqualNode(FN,True);
+  finally
+    FN.Free;
+  end;
+end;
+
+Function TestLargerThanEqualNode_TestCreateStringEqual : TTestString;
+var
+  FN : TFPBooleanResultOperation;
+begin
+  Result:='';
+  FN:=TFPGreaterThanEqualOperation.Create(CreateStringNode('now'),CreateStringNode('now'));
+  try
+    AssertNodeOk(FN);
+    AssertEquals('Boolean result',rtBoolean,FN.NodeType);
+    TestEqualNode(FN,True);
+  finally
+    FN.Free;
+  end;
+end;
+
+Function TestLargerThanEqualNode_TestCreateStringSmaller : TTestString;
+var
+  FN : TFPBooleanResultOperation;
+begin
+  Result:='';
+  FN:=TFPGreaterThanEqualOperation.Create(CreateStringNode('now'),CreateStringNode('then'));
+  try
+    AssertNodeOk(FN);
+    AssertEquals('Boolean result',rtBoolean,FN.NodeType);
+    TestEqualNode(FN,False);
+  finally
+    FN.Free;
+  end;
+end;
+
+Function TestLargerThanEqualNode_TestCreateStringLarger : TTestString;
+var
+  FN : TFPBooleanResultOperation;
+begin
+  Result:='';
+  FN:=TFPGreaterThanEqualOperation.Create(CreateStringNode('then'),CreateStringNode('now'));
+  try
+    AssertNodeOk(FN);
+    AssertEquals('Boolean result',rtBoolean,FN.NodeType);
+    TestEqualNode(FN,True);
+  finally
+    FN.Free;
+  end;
+end;
+
+Function TestLargerThanEqualNode_TestWrongTypes1 : TTestString;
+var
+  FN : TFPBooleanResultOperation;
+begin
+  Result:='';
+  FN:=TFPGreaterThanEqualOperation.Create(CreateIntNode(3),CreateStringNode('1.23'));
+  try
+    AssertNodeNotOk('Wrong Types',FN);
+  finally
+    FN.Free;
+  end;
+end;
+
+Function TestLargerThanEqualNode_TestWrongTypes2 : TTestString;
+var
+  FN : TFPBooleanResultOperation;
+begin
+  Result:='';
+  FN:=TFPGreaterThanEqualOperation.Create(CreateDateTimeNode(3),CreateStringNode('1.23'));
+  try
+    AssertNodeNotOk('Wrong Types',FN);
+  finally
+    FN.Free;
+  end;
+end;
+
+Function TestLargerThanEqualNode_TestWrongTypes3 : TTestString;
+var
+  FN : TFPBooleanResultOperation;
+begin
+  Result:='';
+  FN:=TFPGreaterThanEqualOperation.Create(CreateFloatNode(1.3),CreateStringNode('1.23'));
+  try
+    AssertNodeNotOk('Wrong Types',FN);
+  finally
+    FN.Free;
+  end;
+end;
+
+Function TestLargerThanEqualNode_TestWrongTypes4 : TTestString;
+var
+  FN : TFPBooleanResultOperation;
+begin
+  Result:='';
+  FN:=TFPGreaterThanEqualOperation.Create(CreateBoolNode(False),CreateStringNode('1.23'));
+  try
+    AssertNodeNotOk('Wrong Types',FN);
+  finally
+    FN.Free;
+  end;
+end;
+
+Function TestLargerThanEqualNode_TestWrongTypes5 : TTestString;
+var
+  FN : TFPBooleanResultOperation;
+begin
+  Result:='';
+  FN:=TFPGreaterThanEqualOperation.Create(CreateFloatNode(1.23),CreateIntNode(1));
+  try
+    AssertNodeNotOk('Wrong Types',FN);
+  finally
+    FN.Free;
+  end;
+end;
+
+Function TestLargerThanEqualNode_TestNoBoolean1 : TTestString;
+var
+  FN : TFPBooleanResultOperation;
+begin
+  Result:='';
+  FN:=TFPGreaterThanEqualOperation.Create(CreateBoolNode(False),CreateIntNode(1));
+  try
+    AssertNodeNotOk('Wrong Types',FN);
+  finally
+    FN.Free;
+  end;
+end;
+
+Function TestLargerThanEqualNode_TestNoBoolean2 : TTestString;
+ var
+  FN : TFPBooleanResultOperation;
+begin
+  Result:='';
+  FN:=TFPGreaterThanEqualOperation.Create(CreateIntNode(1),CreateBoolNode(False));
+  try
+    AssertNodeNotOk('Wrong Types',FN);
+  finally
+    FN.Free;
+  end;
+end;
+
+Function TestLargerThanEqualNode_TestNoBoolean3 : TTestString;
+var
+  FN : TFPBooleanResultOperation;
+begin
+  Result:='';
+  FN:=TFPGreaterThanEqualOperation.Create(CreateBoolNode(False),CreateBoolNode(False));
+  try
+    AssertNodeNotOk('Wrong Types',FN);
+  finally
+    FN.Free;
+  end;
+end;
+
+Function TestLargerThanEqualNode_TestAsString : TTestString;
+var
+  FN : TFPBooleanResultOperation;
+begin
+  Result:='';
+  FN:=TFPGreaterThanEqualOperation.Create(CreateIntNode(1),CreateIntNode(2));
+  try
+    AssertEquals('Asstring works ok','1 >= 2',FN.AsString);
+  finally
+    FN.Free;
+  end;
+end;
+
+Function TTestAddNode_TestCreateInteger : TTestString;
+var
+  FN : TFPAddOperation;
+begin
+  Result:='';
+  FN:=TFPAddOperation.Create(CreateIntNode(1),CreateIntNode(2));
+  try
+    AssertEquals('Add has correct type',rtInteger,FN.NodeType);
+    AssertEquals('Add has correct result',3,FN.NodeValue.ResInteger);
+  finally
+    FN.Free;
+  end;
+end;
+
+Function TTestAddNode_TestCreateFloat : TTestString;
+var
+  FN : TFPAddOperation;
+begin
+  Result:='';
+  FN:=TFPAddOperation.Create(CreateFloatNode(1.23),CreateFloatNode(4.56));
+  try
+    AssertEquals('Add has correct type',rtFloat,FN.NodeType);
+    AssertEquals('Add has correct result',5.79,FN.NodeValue.ResFloat, 1e-9);
+  finally
+    FN.Free;
+  end;
+end;
+
+Function TTestAddNode_TestCreateDateTime : TTestString;
+var
+  FN : TFPAddOperation;
+  D,T : TDateTime;
+begin
+  Result:='';
+  D:=Date;
+  T:=Time;
+  FN:=TFPAddOperation.Create(CreateDateTimeNode(D),CreateDateTimeNode(T));
+  try
+    AssertEquals('Add has correct type',rtDateTime,FN.NodeType);
+    AssertEquals('Add has correct result',D+T,FN.NodeValue.ResDateTime);
+  finally
+    FN.Free;
+  end;
+end;
+
+Function TTestAddNode_TestCreateString : TTestString;
+var
+  FN : TFPAddOperation;
+begin
+  Result:='';
+  FN:=TFPAddOperation.Create(CreateStringNode('alo'),CreateStringNode('ha'));
+  try
+    AssertEquals('Add has correct type',rtString,FN.NodeType);
+    AssertEquals('Add has correct result','aloha',FN.NodeValue.ResString);
+  finally
+    FN.Free;
+  end;
+end;
+
+Function TTestAddNode_TestCreateBoolean : TTestString;
+var
+  FN : TFPAddOperation;
+begin
+  Result:='';
+  FN:=TFPAddOperation.Create(CreateBoolNode(True),CreateBoolNode(False));
+  try
+    AssertNodeNotOK('No boolean addition',FN);
+  finally
+    FN.Free;
+  end;
+end;
+
+Function TTestAddNode_TestDestroy : TTestString;
+var
+  FN : TFPAddOperation;
+begin
+  Result:='';
+  FDestroyCalled := 0;
+  FN:=TFPAddOperation.Create(TMyDestroyNode.CreateInteger(1),TMyDestroyNode.CreateInteger(1));
+  FN.Free;
+  AssertEquals('Destroy called for left and right nodes',2,FDestroyCalled);
+end;
+
+Function TTestAddNode_TestAsString : TTestString;
+var
+  FN : TFPAddOperation;
+begin
+  Result:='';
+  FN:=TFPAddOperation.Create(CreateIntNode(1),CreateIntNode(2));
+  try
+    AssertEquals('Asstring works ok','1 + 2',FN.AsString);
+  finally
+    FN.Free;
+  end;
+end;
+
+Function TTestSubtractNode_TestCreateInteger : TTestString;
+var
+  FN : TFPSubtractOperation;
+begin
+  Result:='';
+  FN:=TFPSubtractOperation.Create(CreateIntNode(4),CreateIntNode(1));
+  try
+    AssertEquals('Subtract has correct type',rtInteger,FN.NodeType);
+    AssertEquals('Subtract has correct result',3,FN.NodeValue.ResInteger);
+  finally
+    FN.Free;
+  end;
+end;
+
+Function TTestSubtractNode_TestCreateFloat : TTestString;
+var
+  FN : TFPSubtractOperation;
+begin
+  Result:='';
+  FN:=TFPSubtractOperation.Create(CreateFloatNode(4.56),CreateFloatNode(1.23));
+  try
+    AssertEquals('Subtract has correct type',rtFloat,FN.NodeType);
+    AssertEquals('Subtract has correct result',3.33,FN.NodeValue.ResFloat, 1e-9);
+  finally
+    FN.Free;
+  end;
+end;
+
+Function TTestSubtractNode_TestCreateDateTime : TTestString;
+var
+  FN : TFPSubtractOperation;
+  D,T : TDateTime;
+begin
+  Result:='';
+  D:=Date;
+  T:=Time;
+  FN:=TFPSubtractOperation.Create(CreateDateTimeNode(D+T),CreateDateTimeNode(T));
+  try
+    AssertEquals('Subtract has correct type',rtDateTime,FN.NodeType);
+    AssertEquals('Subtract has correct result',D,FN.NodeValue.ResDateTime);
+  finally
+    FN.Free;
+  end;
+end;
+
+Function TTestSubtractNode_TestCreateString : TTestString;
+var
+  FN : TFPSubtractOperation;
+begin
+  Result:='';
+  FN:=TFPSubtractOperation.Create(CreateStringNode('alo'),CreateStringNode('ha'));
+  try
+    AssertNodeNotOK('No string Subtract',FN);
+  finally
+    FN.Free;
+  end;
+end;
+
+Function TTestSubtractNode_TestCreateBoolean : TTestString;
+var
+  FN : TFPSubtractOperation;
+begin
+  Result:='';
+  FN:=TFPSubtractOperation.Create(CreateBoolNode(True),CreateBoolNode(False));
+  try
+    AssertNodeNotOK('No boolean Subtract',FN);
+  finally
+    FN.Free;
+  end;
+end;
+
+Function TTestSubtractNode_TestDestroy : TTestString;
+var
+  FN : TFPSubtractOperation;
+begin
+  Result:='';
+  FDestroyCalled := 0;
+  FN:=TFPSubtractOperation.Create(TMyDestroyNode.CreateInteger(1),TMyDestroyNode.CreateInteger(1));
+  FN.Free;
+  AssertEquals('Destroy called for left and right nodes',2,FDestroyCalled);
+end;
+
+Function TTestSubtractNode_TestAsString : TTestString;
+var
+  FN : TFPSubtractOperation;
+begin
+  Result:='';
+  FN:=TFPSubtractOperation.Create(CreateIntNode(1),CreateIntNode(2));
+  try
+    AssertEquals('Asstring works ok','1 - 2',FN.AsString);
+  finally
+    FN.Free;
+  end;
+end;
+
+Function TTestMultiplyNode_TestCreateInteger : TTestString;
+var
+  FN : TFPMultiplyOperation;
+begin
+  Result:='';
+  FN:=TFPMultiplyOperation.Create(CreateIntNode(4),CreateIntNode(2));
+  try
+    AssertEquals('multiply has correct type',rtInteger,FN.NodeType);
+    AssertEquals('multiply has correct result',8,FN.NodeValue.ResInteger);
+  finally
+    FN.Free;
+  end;
+end;
+
+Function TTestMultiplyNode_TestCreateFloat : TTestString;
+var
+  FN : TFPMultiplyOperation;
+begin
+  Result:='';
+  FN:=TFPMultiplyOperation.Create(CreateFloatNode(2.0),CreateFloatNode(1.23));
+  try
+    AssertEquals('multiply has correct type',rtFloat,FN.NodeType);
+    AssertEquals('multiply has correct result',2.46,FN.NodeValue.ResFloat, 1e-9);
+  finally
+    FN.Free;
+  end;
+end;
+
+Function TTestMultiplyNode_TestCreateDateTime : TTestString;
+var
+  FN : TFPMultiplyOperation;
+  D,T : TDateTime;
+begin
+  Result:='';
+  D:=Date;
+  T:=Time;
+  FN:=TFPMultiplyOperation.Create(CreateDateTimeNode(D+T),CreateDateTimeNode(T));
+  try
+    AssertNodeNotOK('No datetime multiply',FN);
+  finally
+    FN.Free;
+  end;
+end;
+
+Function TTestMultiplyNode_TestCreateString : TTestString;
+var
+  FN : TFPMultiplyOperation;
+begin
+  Result:='';
+  FN:=TFPMultiplyOperation.Create(CreateStringNode('alo'),CreateStringNode('ha'));
+  try
+    AssertNodeNotOK('No string multiply',FN);
+  finally
+    FN.Free;
+  end;
+end;
+
+Function TTestMultiplyNode_TestCreateBoolean : TTestString;
+var
+  FN : TFPMultiplyOperation;
+begin
+  Result:='';
+  FN:=TFPMultiplyOperation.Create(CreateBoolNode(True),CreateBoolNode(False));
+  try
+    AssertNodeNotOK('No boolean multiply',FN);
+  finally
+    FN.Free;
+  end;
+end;
+
+Function TTestMultiplyNode_TestDestroy : TTestString;
+var
+  FN : TFPMultiplyOperation;
+begin
+  Result:='';
+  FDestroyCalled := 0;
+  FN:=TFPMultiplyOperation.Create(TMyDestroyNode.CreateInteger(1),TMyDestroyNode.CreateInteger(1));
+  FN.Free;
+  AssertEquals('Destroy called for left and right nodes',2,FDestroyCalled);
+end;
+
+Function TTestMultiplyNode_TestAsString : TTestString;
+var
+  FN : TFPMultiplyOperation;
+begin
+  Result:='';
+  FN:=TFPMultiplyOperation.Create(CreateIntNode(1),CreateIntNode(2));
+  try
+    AssertEquals('Asstring works ok','1 * 2',FN.AsString);
+  finally
+    FN.Free;
+  end;
+end;
+
+Function TTestPowerNode_TestCreateInteger : TTestString;
+var
+  FN : TFPPowerOperation;
+begin
+  Result:='';
+  FN:=TFPPowerOperation.Create(CreateIntNode(4),CreateIntNode(2));
+  try
+    AssertEquals('Power has correct type',rtfloat,FN.NodeType);
+    AssertEquals('Power has correct result',16.0,FN.NodeValue.ResFloat, 1e-9);
+  finally
+    FN.Free;
+  end;
+end;
+
+Function TTestPowerNode_TestCreateFloat : TTestString;
+var
+  FN : TFPPowerOperation;
+begin
+  Result:='';
+  FN:=TFPPowerOperation.Create(CreateFloatNode(2.0),CreateFloatNode(3.0));
+  try
+    AssertEquals('Power has correct type',rtFloat,FN.NodeType);
+    AssertEquals('Power has correct result',8.0,FN.NodeValue.ResFloat, 1e-9);
+  finally
+    FN.Free;
+  end;
+end;
+
+Function TTestPowerNode_TestCreateDateTime : TTestString;
+var
+  FN : TFPPowerOperation;
+  D,T : TDateTime;
+begin
+  Result:='';
+  D:=Date;
+  T:=Time;
+  FN:=TFPPowerOperation.Create(CreateDateTimeNode(D+T),CreateDateTimeNode(T));
+  try
+    AssertNodeNotOK('No datetime Power',FN);
+  finally
+    FN.Free;
+  end;
+end;
+
+Function TTestPowerNode_TestCreateString : TTestString;
+var
+  FN : TFPPowerOperation;
+begin
+  Result:='';
+  FN:=TFPPowerOperation.Create(CreateStringNode('alo'),CreateStringNode('ha'));
+  try
+    AssertNodeNotOK('No string Power',FN);
+  finally
+    FN.Free;
+  end;
+end;
+
+Function TTestPowerNode_TestCreateBoolean : TTestString;
+var
+  FN : TFPPowerOperation;
+begin
+  Result:='';
+  FN:=TFPPowerOperation.Create(CreateBoolNode(True),CreateBoolNode(False));
+  try
+    AssertNodeNotOK('No boolean Power',FN);
+  finally
+    FN.Free;
+  end;
+end;
+
+Function TTestPowerNode_TestDestroy : TTestString;
+var
+  FN : TFPPowerOperation;
+begin
+  Result:='';
+  FDestroyCalled := 0;
+  FN:=TFPPowerOperation.Create(TMyDestroyNode.CreateInteger(1),TMyDestroyNode.CreateInteger(1));
+  FN.Free;
+  AssertEquals('Destroy called for left and right nodes',2,FDestroyCalled);
+end;
+
+Function TTestPowerNode_TestAsString : TTestString;
+var
+  FN : TFPPowerOperation;
+begin
+  Result:='';
+  FN:=TFPPowerOperation.Create(CreateIntNode(1),CreateIntNode(2));
+  try
+    AssertEquals('Asstring works ok','1^2',FN.AsString);
+  finally
+    FN.Free;
+  end;
+end;
+
+Function TTestDivideNode_TestCreateInteger : TTestString;
+var
+  FN : TFPDivideOperation;
+begin
+  Result:='';
+  FN:=TFPDivideOperation.Create(CreateIntNode(4),CreateIntNode(2));
+  try
+    AssertEquals('Divide has correct type',rtfloat,FN.NodeType);
+    AssertEquals('Divide has correct result',2.0,FN.NodeValue.ResFloat, 1e-9);
+  finally
+    FN.Free;
+  end;
+end;
+
+Function TTestDivideNode_TestCreateFloat : TTestString;
+var
+  FN : TFPDivideOperation;
+begin
+  Result:='';
+  FN:=TFPDivideOperation.Create(CreateFloatNode(9.0),CreateFloatNode(3.0));
+  try
+    AssertEquals('Divide has correct type',rtFloat,FN.NodeType);
+    AssertEquals('Divide has correct result',3.0,FN.NodeValue.ResFloat, 1e-9);
+  finally
+    FN.Free;
+  end;
+end;
+
+Function TTestDivideNode_TestCreateDateTime : TTestString;
+var
+  FN : TFPDivideOperation;
+  D,T : TDateTime;
+begin
+  Result:='';
+  D:=Date;
+  T:=Time;
+  FN:=TFPDivideOperation.Create(CreateDateTimeNode(D+T),CreateDateTimeNode(T));
+  try
+    AssertNodeNotOK('No datetime division',FN);
+  finally
+    FN.Free;
+  end;
+end;
+
+Function TTestDivideNode_TestCreateString : TTestString;
+var
+  FN : TFPDivideOperation;
+begin
+  Result:='';
+  FN:=TFPDivideOperation.Create(CreateStringNode('alo'),CreateStringNode('ha'));
+  try
+    AssertNodeNotOK('No string division',FN);
+  finally
+    FN.Free;
+  end;
+end;
+
+Function TTestDivideNode_TestCreateBoolean : TTestString;
+var
+  FN : TFPDivideOperation;
+begin
+  Result:='';
+  FN:=TFPDivideOperation.Create(CreateBoolNode(True),CreateBoolNode(False));
+  try
+    AssertNodeNotOK('No boolean division',FN);
+  finally
+    FN.Free;
+  end;
+end;
+
+Function TTestDivideNode_TestDestroy : TTestString;
+var
+  FN : TFPDivideOperation;
+begin
+  Result:='';
+  FDestroyCalled := 0;
+  FN:=TFPDivideOperation.Create(TMyDestroyNode.CreateInteger(1),TMyDestroyNode.CreateInteger(1));
+  FN.Free;
+  AssertEquals('Destroy called for left and right nodes',2,FDestroyCalled);
+end;
+
+Function TTestDivideNode_TestAsString : TTestString;
+var
+  FN : TFPDivideOperation;
+begin
+  Result:='';
+  FN:=TFPDivideOperation.Create(CreateIntNode(1),CreateIntNode(2));
+  try
+    AssertEquals('Asstring works ok','1 / 2',FN.AsString);
+  finally
+    FN.Free;
+  end;
+end;
+
+
+procedure RegisterTests(aTop: PSuite);
+var
+  lParentSuite,lSuite : PSuite;
+begin
+  lParentSuite:=AddSuite('TExprParsNodes', @SuiteSetup, @SuiteTearDown, aTop);
+  AddTest('TestDestroyNode', @TestDestroyNode_TestDestroy, 'TExprParsNodes');
+
+  lSuite:=AddSuite('TestConstExprNode', @SuiteSetup, @SuiteTearDown,lParentSuite,True);
+  AddTest('TestConstCreateInteger', @TestConstExprNode_TestCreateInteger, lSuite);
+  AddTest('TestConstCreateFloat', @TestConstExprNode_TestCreateFloat, lSuite);
+  AddTest('TestConstCreateBoolean', @TestConstExprNode_TestCreateBoolean, lSuite);
+  AddTest('TestConstCreateDateTime', @TestConstExprNode_TestCreateDateTime, lSuite);
+  AddTest('TestConstCreateString', @TestConstExprNode_TestCreateString, lSuite);
+
+  lSuite:=AddSuite('TestNegateExprNode', @SuiteSetup, @SuiteTearDown,lParentSuite,True);
+  AddTest('TestNegateCreateInteger', @TestNegateExprNode_TestCreateInteger, lSuite);
+  AddTest('TestNegateCreateFloat', @TestNegateExprNode_TestCreateFloat, lSuite);
+  AddTest('TestNegateCreateOther1', @TestNegateExprNode_TestCreateOther1, lSuite);
+  AddTest('TestNegateCreateOther2', @TestNegateExprNode_TestCreateOther2, lSuite);
+  AddTest('TestNegateDestroy', @TestNegateExprNode_TestDestroy, lSuite);
+
+  lSuite:=AddSuite('TestBinaryAndNode', @SuiteSetup, @SuiteTearDown,lParentSuite,True);
+  AddTest('TestBinaryAndCreateInteger', @TestBinaryAndNode_TestCreateInteger, lSuite);
+  AddTest('TestBinaryAndCreateBoolean', @TestBinaryAndNode_TestCreateBoolean, lSuite);
+  AddTest('TestBinaryAndCreateBooleanInteger', @TestBinaryAndNode_TestCreateBooleanInteger, lSuite);
+  AddTest('TestBinaryAndCreateString', @TestBinaryAndNode_TestCreateString, lSuite);
+  AddTest('TestBinaryAndCreateFloat', @TestBinaryAndNode_TestCreateFloat, lSuite);
+  AddTest('TestBinaryAndCreateDateTime', @TestBinaryAndNode_TestCreateDateTime, lSuite);
+  AddTest('TestBinaryAndDestroy', @TestBinaryAndNode_TestDestroy, lSuite);
+
+  lSuite:=AddSuite('TestNotNode', @SuiteSetup, @SuiteTearDown,lParentSuite,True);
+  AddTest('TestNotCreateInteger', @TestNotNode_TestCreateInteger, lSuite);
+  AddTest('TestNotCreateBoolean', @TestNotNode_TestCreateBoolean, lSuite);
+  AddTest('TestNotCreateString', @TestNotNode_TestCreateString, lSuite);
+  AddTest('TestNotCreateFloat', @TestNotNode_TestCreateFloat, lSuite);
+  AddTest('TestNotCreateDateTime', @TestNotNode_TestCreateDateTime, lSuite);
+  AddTest('TestNotDestroy', @TestNotNode_TestDestroy, lSuite);
+
+  lSuite:=AddSuite('TestBinaryOrNode', @SuiteSetup, @SuiteTearDown,lParentSuite,True);
+  AddTest('TestBinaryOrCreateInteger', @TestBinaryOrNode_TestCreateInteger, lSuite);
+  AddTest('TestBinaryOrCreateBoolean', @TestBinaryOrNode_TestCreateBoolean, lSuite);
+  AddTest('TestBinaryOrCreateBooleanInteger', @TestBinaryOrNode_TestCreateBooleanInteger, lSuite);
+  AddTest('TestBinaryOrCreateString', @TestBinaryOrNode_TestCreateString, lSuite);
+  AddTest('TestBinaryOrCreateFloat', @TestBinaryOrNode_TestCreateFloat, lSuite);
+  AddTest('TestBinaryOrCreateDateTime', @TestBinaryOrNode_TestCreateDateTime, lSuite);
+  AddTest('TestBinaryOrDestroy', @TestBinaryOrNode_TestDestroy, lSuite);
+  AddTest('TestBinaryXorCreateInteger', @TestBinaryXorNode_TestCreateInteger, lSuite);
+  AddTest('TestBinaryXorCreateBoolean', @TestBinaryXorNode_TestCreateBoolean, lSuite);
+  AddTest('TestBinaryXorCreateBooleanInteger', @TestBinaryXorNode_TestCreateBooleanInteger, lSuite);
+  AddTest('TestBinaryXorCreateString', @TestBinaryXorNode_TestCreateString, lSuite);
+  AddTest('TestBinaryXorCreateFloat', @TestBinaryXorNode_TestCreateFloat, lSuite);
+  AddTest('TestBinaryXorCreateDateTime', @TestBinaryXorNode_TestCreateDateTime, lSuite);
+  AddTest('TestBinaryXorDestroy', @TestBinaryXorNode_TestDestroy, lSuite);
+
+  lSuite:=AddSuite('TestEqualNode', @SuiteSetup, @SuiteTearDown,lParentSuite,True);
+  AddTest('TestEqualCreateIntegerEqual', @TestEqualNode_TestCreateIntegerEqual, lSuite);
+  AddTest('TestEqualCreateIntegerUnEqual', @TestEqualNode_TestCreateIntegerUnEqual, lSuite);
+  AddTest('TestEqualCreateFloatEqual', @TestEqualNode_TestCreateFloatEqual, lSuite);
+  AddTest('TestEqualCreateFloatUnEqual', @TestEqualNode_TestCreateFloatUnEqual, lSuite);
+  AddTest('TestEqualCreateStringEqual', @TestEqualNode_TestCreateStringEqual, lSuite);
+  AddTest('TestEqualCreateStringUnEqual', @TestEqualNode_TestCreateStringUnEqual, lSuite);
+  AddTest('TestEqualCreateBooleanEqual', @TestEqualNode_TestCreateBooleanEqual, lSuite);
+  AddTest('TestEqualCreateBooleanUnEqual', @TestEqualNode_TestCreateBooleanUnEqual, lSuite);
+  AddTest('TestEqualCreateDateTimeEqual', @TestEqualNode_TestCreateDateTimeEqual, lSuite);
+  AddTest('TestEqualCreateDateTimeUnEqual', @TestEqualNode_TestCreateDateTimeUnEqual, lSuite);
+  AddTest('TestEqualDestroy', @TestEqualNode_TestDestroy, lSuite);
+  AddTest('TestEqualWrongTypes1', @TestEqualNode_TestWrongTypes1, lSuite);
+  AddTest('TestEqualWrongTypes2', @TestEqualNode_TestWrongTypes2, lSuite);
+  AddTest('TestEqualWrongTypes3', @TestEqualNode_TestWrongTypes3, lSuite);
+  AddTest('TestEqualWrongTypes4', @TestEqualNode_TestWrongTypes4, lSuite);
+  AddTest('TestEqualWrongTypes5', @TestEqualNode_TestWrongTypes5, lSuite);
+  AddTest('TestEqualAsString', @TestEqualNode_TestAsString, lSuite);
+
+  lSuite:=AddSuite('TestUnEqualNode', @SuiteSetup, @SuiteTearDown,lParentSuite,True);
+  AddTest('TestUnEqualCreateIntegerEqual', @TestUnEqualNode_TestCreateIntegerEqual, lSuite);
+  AddTest('TestUnEqualCreateIntegerUnEqual', @TestUnEqualNode_TestCreateIntegerUnEqual, lSuite);
+  AddTest('TestUnEqualCreateFloatEqual', @TestUnEqualNode_TestCreateFloatEqual, lSuite);
+  AddTest('TestUnEqualCreateFloatUnEqual', @TestUnEqualNode_TestCreateFloatUnEqual, lSuite);
+  AddTest('TestUnEqualCreateStringEqual', @TestUnEqualNode_TestCreateStringEqual, lSuite);
+  AddTest('TestUnEqualCreateStringUnEqual', @TestUnEqualNode_TestCreateStringUnEqual, lSuite);
+  AddTest('TestUnEqualCreateBooleanEqual', @TestUnEqualNode_TestCreateBooleanEqual, lSuite);
+  AddTest('TestUnEqualCreateBooleanUnEqual', @TestUnEqualNode_TestCreateBooleanUnEqual, lSuite);
+  AddTest('TestUnEqualCreateDateTimeEqual', @TestUnEqualNode_TestCreateDateTimeEqual, lSuite);
+  AddTest('TestUnEqualCreateDateTimeUnEqual', @TestUnEqualNode_TestCreateDateTimeUnEqual, lSuite);
+  AddTest('TestUnEqualDestroy', @TestUnEqualNode_TestDestroy, lSuite);
+  AddTest('TestUnEqualWrongTypes1', @TestUnEqualNode_TestWrongTypes1, lSuite);
+  AddTest('TestUnEqualWrongTypes2', @TestUnEqualNode_TestWrongTypes2, lSuite);
+  AddTest('TestUnEqualWrongTypes3', @TestUnEqualNode_TestWrongTypes3, lSuite);
+  AddTest('TestUnEqualWrongTypes4', @TestUnEqualNode_TestWrongTypes4, lSuite);
+  AddTest('TestUnEqualWrongTypes5', @TestUnEqualNode_TestWrongTypes5, lSuite);
+  AddTest('TestUnEqualAsString', @TestUnEqualNode_TestAsString, lSuite);
+
+  lSuite:=AddSuite('TestLessThanNode', @SuiteSetup, @SuiteTearDown,lParentSuite,True);
+  AddTest('TestLessThanCreateDateTimeSmaller',@TestLessThanNode_TestCreateDateTimeSmaller, lSuite);
+  AddTest('TestLessThanCreateDateTimeLarger',@TestLessThanNode_TestCreateDateTimeLarger, lSuite);
+  AddTest('TestLessThanCreateStringEqual',@TestLessThanNode_TestCreateStringEqual, lSuite);
+  AddTest('TestLessThanCreateStringSmaller',@TestLessThanNode_TestCreateStringSmaller, lSuite);
+  AddTest('TestLessThanCreateStringLarger',@TestLessThanNode_TestCreateStringLarger, lSuite);
+  AddTest('TestLessThanWrongTypes1',@TestLessThanNode_TestWrongTypes1, lSuite);
+  AddTest('TestLessThanWrongTypes2',@TestLessThanNode_TestWrongTypes2, lSuite);
+  AddTest('TestLessThanWrongTypes3',@TestLessThanNode_TestWrongTypes3, lSuite);
+  AddTest('TestLessThanWrongTypes4',@TestLessThanNode_TestWrongTypes4, lSuite);
+  AddTest('TestLessThanWrongTypes5',@TestLessThanNode_TestWrongTypes5, lSuite);
+  AddTest('TestLessThanNoBoolean1',@TestLessThanNode_TestNoBoolean1, lSuite);
+  AddTest('TestLessThanNoBoolean2',@TestLessThanNode_TestNoBoolean2, lSuite);
+  AddTest('TestLessThanNoBoolean3',@TestLessThanNode_TestNoBoolean3, lSuite);
+  AddTest('TestLessThanAsString',@TestLessThanNode_TestAsString, lSuite);
+
+  lSuite:=AddSuite('TestLessThanEqualNode', @SuiteSetup, @SuiteTearDown,lParentSuite,True);
+  AddTest('TestLessThanEqualCreateDateTimeSmaller',@TestLessThanEqualNode_TestCreateDateTimeSmaller, lSuite);
+  AddTest('TestLessThanEqualCreateDateTimeLarger',@TestLessThanEqualNode_TestCreateDateTimeLarger, lSuite);
+  AddTest('TestLessThanEqualCreateStringEqual',@TestLessThanEqualNode_TestCreateStringEqual, lSuite);
+  AddTest('TestLessThanEqualCreateStringSmaller',@TestLessThanEqualNode_TestCreateStringSmaller, lSuite);
+  AddTest('TestLessThanEqualCreateStringLarger',@TestLessThanEqualNode_TestCreateStringLarger, lSuite);
+  AddTest('TestLessThanEqualWrongTypes1',@TestLessThanEqualNode_TestWrongTypes1, lSuite);
+  AddTest('TestLessThanEqualWrongTypes2',@TestLessThanEqualNode_TestWrongTypes2, lSuite);
+  AddTest('TestLessThanEqualWrongTypes3',@TestLessThanEqualNode_TestWrongTypes3, lSuite);
+  AddTest('TestLessThanEqualWrongTypes4',@TestLessThanEqualNode_TestWrongTypes4, lSuite);
+  AddTest('TestLessThanEqualWrongTypes5',@TestLessThanEqualNode_TestWrongTypes5, lSuite);
+  AddTest('TestLessThanEqualNoBoolean1',@TestLessThanEqualNode_TestNoBoolean1, lSuite);
+  AddTest('TestLessThanEqualNoBoolean2',@TestLessThanEqualNode_TestNoBoolean2, lSuite);
+  AddTest('TestLessThanEqualNoBoolean3',@TestLessThanEqualNode_TestNoBoolean3, lSuite);
+  AddTest('TestLessThanEqualAsString',@TestLessThanEqualNode_TestAsString, lSuite);
+
+  lSuite:=AddSuite('TestLargerThanNode', @SuiteSetup, @SuiteTearDown,lParentSuite,True);
+  AddTest('TestLargerThanCreateDateTimeSmaller',@TestLargerThanNode_TestCreateDateTimeSmaller, lSuite);
+  AddTest('TestLargerThanCreateDateTimeLarger',@TestLargerThanNode_TestCreateDateTimeLarger, lSuite);
+  AddTest('TestLargerThanCreateStringEqual',@TestLargerThanNode_TestCreateStringEqual, lSuite);
+  AddTest('TestLargerThanCreateStringSmaller',@TestLargerThanNode_TestCreateStringSmaller, lSuite);
+  AddTest('TestLargerThanCreateStringLarger',@TestLargerThanNode_TestCreateStringLarger, lSuite);
+  AddTest('TestLargerThanWrongTypes1',@TestLargerThanNode_TestWrongTypes1, lSuite);
+  AddTest('TestLargerThanWrongTypes2',@TestLargerThanNode_TestWrongTypes2, lSuite);
+  AddTest('TestLargerThanWrongTypes3',@TestLargerThanNode_TestWrongTypes3, lSuite);
+  AddTest('TestLargerThanWrongTypes4',@TestLargerThanNode_TestWrongTypes4, lSuite);
+  AddTest('TestLargerThanWrongTypes5',@TestLargerThanNode_TestWrongTypes5, lSuite);
+  AddTest('TestLargerThanNoBoolean1',@TestLargerThanNode_TestNoBoolean1, lSuite);
+  AddTest('TestLargerThanNoBoolean2',@TestLargerThanNode_TestNoBoolean2, lSuite);
+  AddTest('TestLargerThanNoBoolean3',@TestLargerThanNode_TestNoBoolean3, lSuite);
+  AddTest('TestLargerThanAsString',@TestLargerThanNode_TestAsString, lSuite);
+
+  lSuite:=AddSuite('TestLargerThanEqualNode', @SuiteSetup, @SuiteTearDown,lParentSuite,True);
+  AddTest('TestLargerThanEqualCreateDateTimeSmaller',@TestLargerThanEqualNode_TestCreateDateTimeSmaller, lSuite);
+  AddTest('TestLargerThanEqualCreateDateTimeLarger',@TestLargerThanEqualNode_TestCreateDateTimeLarger, lSuite);
+  AddTest('TestLargerThanEqualCreateStringEqual',@TestLargerThanEqualNode_TestCreateStringEqual, lSuite);
+  AddTest('TestLargerThanEqualCreateStringSmaller',@TestLargerThanEqualNode_TestCreateStringSmaller, lSuite);
+  AddTest('TestLargerThanEqualCreateStringLarger',@TestLargerThanEqualNode_TestCreateStringLarger, lSuite);
+  AddTest('TestLargerThanEqualWrongTypes1',@TestLargerThanEqualNode_TestWrongTypes1, lSuite);
+  AddTest('TestLargerThanEqualWrongTypes2',@TestLargerThanEqualNode_TestWrongTypes2, lSuite);
+  AddTest('TestLargerThanEqualWrongTypes3',@TestLargerThanEqualNode_TestWrongTypes3, lSuite);
+  AddTest('TestLargerThanEqualWrongTypes4',@TestLargerThanEqualNode_TestWrongTypes4, lSuite);
+  AddTest('TestLargerThanEqualWrongTypes5',@TestLargerThanEqualNode_TestWrongTypes5, lSuite);
+  AddTest('TestLargerThanEqualNoBoolean1',@TestLargerThanEqualNode_TestNoBoolean1, lSuite);
+  AddTest('TestLargerThanEqualNoBoolean2',@TestLargerThanEqualNode_TestNoBoolean2, lSuite);
+  AddTest('TestLargerThanEqualNoBoolean3',@TestLargerThanEqualNode_TestNoBoolean3, lSuite);
+  AddTest('TestLargerThanEqualAsString',@TestLargerThanEqualNode_TestAsString, lSuite);
+
+  lSuite:=AddSuite('TTestAddNode', @SuiteSetup, @SuiteTearDown,lParentSuite,True);
+  AddTest('TestAddNode_CreateInteger', @TTestAddNode_TestCreateInteger, lSuite);
+  AddTest('TestAddNode_CreateFloat', @TTestAddNode_TestCreateFloat, lSuite);
+  AddTest('TestAddNode_CreateDateTime', @TTestAddNode_TestCreateDateTime, lSuite);
+  AddTest('TestAddNode_CreateString', @TTestAddNode_TestCreateString, lSuite);
+  AddTest('TestAddNode_CreateBoolean', @TTestAddNode_TestCreateBoolean, lSuite);
+  AddTest('TestAddNode_Destroy', @TTestAddNode_TestDestroy, lSuite);
+  AddTest('TestAddNode_AsString', @TTestAddNode_TestAsString, lSuite);
+
+  lSuite:=AddSuite('TTestSubtractNode', @SuiteSetup, @SuiteTearDown,lParentSuite,True);
+  AddTest('TestSubtractNode_CreateInteger', @TTestSubtractNode_TestCreateInteger, lSuite);
+  AddTest('TestSubtractNode_CreateFloat', @TTestSubtractNode_TestCreateFloat, lSuite);
+  AddTest('TestSubtractNode_CreateDateTime', @TTestSubtractNode_TestCreateDateTime, lSuite);
+  AddTest('TestSubtractNode_CreateString', @TTestSubtractNode_TestCreateString, lSuite);
+  AddTest('TestSubtractNode_CreateBoolean', @TTestSubtractNode_TestCreateBoolean, lSuite);
+  AddTest('TestSubtractNode_Destroy', @TTestSubtractNode_TestDestroy, lSuite);
+  AddTest('TestSubtractNode_AsString', @TTestSubtractNode_TestAsString, lSuite);
+
+  lSuite:=AddSuite('TTestMultiplyNode', @SuiteSetup, @SuiteTearDown,lParentSuite,True);
+  AddTest('TestMultiplyNode_CreateInteger', @TTestMultiplyNode_TestCreateInteger, lSuite);
+  AddTest('TestMultiplyNode_CreateFloat', @TTestMultiplyNode_TestCreateFloat, lSuite);
+  AddTest('TestMultiplyNode_CreateDateTime', @TTestMultiplyNode_TestCreateDateTime, lSuite);
+  AddTest('TestMultiplyNode_CreateString', @TTestMultiplyNode_TestCreateString, lSuite);
+  AddTest('TestMultiplyNode_CreateBoolean', @TTestMultiplyNode_TestCreateBoolean, lSuite);
+  AddTest('TestMultiplyNode_Destroy', @TTestMultiplyNode_TestDestroy, lSuite);
+  AddTest('TestMultiplyNode_AsString', @TTestMultiplyNode_TestAsString, lSuite);
+
+  lSuite:=AddSuite('TTestPowerNode', @SuiteSetup, @SuiteTearDown,lParentSuite,True);
+  AddTest('TestPowerNode_CreateInteger', @TTestPowerNode_TestCreateInteger, lSuite);
+  AddTest('TestPowerNode_CreateFloat', @TTestPowerNode_TestCreateFloat, lSuite);
+  AddTest('TestPowerNode_CreateDateTime', @TTestPowerNode_TestCreateDateTime, lSuite);
+  AddTest('TestPowerNode_CreateString', @TTestPowerNode_TestCreateString, lSuite);
+  AddTest('TestPowerNode_CreateBoolean', @TTestPowerNode_TestCreateBoolean, lSuite);
+  AddTest('TestPowerNode_Destroy', @TTestPowerNode_TestDestroy, lSuite);
+  AddTest('TestPowerNode_AsString', @TTestPowerNode_TestAsString, lSuite);
+
+  lSuite:=AddSuite('TTestDivideNode', @SuiteSetup, @SuiteTearDown,lParentSuite,True);
+  AddTest('TestDivideNode_CreateInteger', @TTestDivideNode_TestCreateInteger, lSuite);
+  AddTest('TestDivideNode_CreateFloat', @TTestDivideNode_TestCreateFloat, lSuite);
+  AddTest('TestDivideNode_CreateDateTime', @TTestDivideNode_TestCreateDateTime, lSuite);
+  AddTest('TestDivideNode_CreateString', @TTestDivideNode_TestCreateString, lSuite);
+  AddTest('TestDivideNode_CreateBoolean', @TTestDivideNode_TestCreateBoolean, lSuite);
+  AddTest('TestDivideNode_Destroy', @TTestDivideNode_TestDestroy, lSuite);
+  AddTest('TestDivideNode_AsString', @TTestDivideNode_TestAsString, lSuite);
+
+end;
+
+end.

+ 847 - 0
packages/fcl-base/tests/utcexprparsops.pp

@@ -0,0 +1,847 @@
+unit utcexprparsops;
+
+{$mode objfpc}
+{$h+}
+interface
+
+uses
+  Classes, SysUtils, math, punit, fpexprpars;
+
+procedure RegisterTests(aTop : PSuite);
+
+implementation
+
+uses typinfo;
+
+Type
+  TMyDestroyNode = Class(TFPConstExpression)
+  Public
+    Destructor Destroy; override;
+  end;
+
+Var
+  FCheckNode : TFPExprNode;
+  FDestroyCalled : Integer;
+
+procedure DoCheck;
+begin
+  if Assigned(FCheckNode) then
+    FCheckNode.Check;
+end;
+
+procedure AssertNodeType(Msg: String; AClass: TClass;  ANode: TFPExprNode);
+begin
+  AssertNotNull(Msg+': Not null',ANode);
+  AssertEquals(Msg+': Class OK',AClass,ANode.ClassType);
+end;
+
+procedure AssertEquals(Msg: String; AResultType: TResultType;  ANode: TFPExprNode); overload;
+begin
+  AssertNotNull(Msg+': Node not null',ANode);
+  AssertEquals(Msg,ResultTypeName(AResultType),ResultTypeName(Anode.NodeType));
+end;
+
+procedure AssertEquals(Msg: String; AExpected, AActual: TResultType); overload;
+begin
+  AssertEquals(Msg,ResultTypeName(AExpected),ResultTypeName(AActual));
+end;
+
+function CreateIntNode(AInteger: Integer): TFPExprNode;
+begin
+  Result:=TFPConstExpression.CreateInteger(AInteger);
+end;
+
+function CreateFloatNode(AFloat: TExprFloat): TFPExprNode;
+begin
+  Result:=TFPConstExpression.CreateFloat(AFloat);
+end;
+
+function CreateStringNode(Astring: String): TFPExprNode;
+begin
+  Result:=TFPConstExpression.CreateString(AString);
+end;
+
+function CreateDateTimeNode(ADateTime: TDateTime): TFPExprNode;
+begin
+  Result:=TFPConstExpression.CreateDateTime(ADateTime);
+end;
+
+function CreateBoolNode(ABoolean: Boolean): TFPExprNode;
+begin
+  Result:=TFPConstExpression.CreateBoolean(ABoolean);
+end;
+
+procedure AssertNodeOK(FN: TFPExprNode);
+Var
+  B : Boolean;
+  Msg : String;
+begin
+  AssertNotNull('Node to test OK',FN);
+  B:=False;
+  try
+    FN.Check;
+    B:=True;
+  except
+    On E : Exception do
+      Msg:=E.Message;
+  end;
+  If Not B then
+    Fail(Format('Node %s not OK: %s',[FN.ClassName,Msg]));
+end;
+
+procedure AssertNodeNotOK(const MSg : String; FN: TFPExprNode);
+begin
+  FCheckNode:=FN;
+  AssertException(Msg,EExprParser,@DoCheck);
+end;
+
+destructor TMyDestroyNode.Destroy;
+begin
+  Inc(FDestroyCalled);
+  inherited Destroy;
+end;
+
+function SuiteSetup: TTestString;
+begin
+  Result := '';
+  FCheckNode := Nil;
+  FDestroyCalled:=0;
+end;
+
+function SuiteTearDown: TTestString;
+begin
+  Result := '';
+end;
+
+Function TestIfOperation_TestCreateInteger : TTestString;
+var
+  FN : TIfOperation;
+begin
+  Result:='';
+  FN:=TIfOperation.Create(CreateBoolNode(True),CreateIntNode(1),CreateIntNode(2));
+  try
+    AssertNodeOK(FN);
+    AssertEquals('Correct node type',rtInteger,FN.NodeType);
+    AssertEquals('Correct result',1,FN.NodeValue.ResInteger);
+  finally
+    FN.Free;
+  end;
+  FN:=TIfOperation.Create(CreateBoolNode(False),CreateIntNode(1),CreateIntNode(2));
+  try
+    AssertNodeOK(FN);
+    AssertEquals('Correct node type',rtInteger,FN.NodeType);
+    AssertEquals('Correct result',2,FN.NodeValue.ResInteger);
+  finally
+    FN.Free;
+  end;
+end;
+
+Function TestIfOperation_TestCreateBoolean : TTestString;
+var
+  FN : TIfOperation;
+begin
+  Result:='';
+  FN:=TIfOperation.Create(CreateBoolNode(True),CreateBoolNode(True),CreateBoolNode(False));
+  try
+    AssertNodeOK(FN);
+    AssertEquals('Correct node type',rtBoolean,FN.NodeType);
+    AssertEquals('Correct result',True,FN.NodeValue.ResBoolean);
+  finally
+    FN.Free;
+  end;
+end;
+
+Function TestIfOperation_TestCreateBoolean2 : TTestString;
+var
+  FN : TIfOperation;
+begin
+  Result:='';
+  FN:=TIfOperation.Create(CreateBoolNode(False),CreateBoolNode(True),CreateBoolNode(False));
+  try
+    AssertNodeOK(FN);
+    AssertEquals('Correct node type',rtBoolean,FN.NodeType);
+    AssertEquals('Correct result',False,FN.NodeValue.ResBoolean);
+  finally
+    FN.Free;
+  end;
+end;
+
+Function TestIfOperation_TestCreateString : TTestString;
+var
+  FN : TIfOperation;
+begin
+  Result:='';
+  FN:=TIfOperation.Create(CreateBoolNode(True),CreateStringNode('a'),CreateStringNode('b'));
+  try
+    AssertNodeOK(FN);
+    AssertEquals('Correct node type',rtString,FN.NodeType);
+    AssertEquals('Correct result','a',FN.NodeValue.ResString);
+  finally
+    FN.Free;
+  end;
+  FN:=TIfOperation.Create(CreateBoolNode(False),CreateStringNode('a'),CreateStringNode('b'));
+  try
+    AssertNodeOK(FN);
+    AssertEquals('Correct node type',rtString,FN.NodeType);
+    AssertEquals('Correct result','b',FN.NodeValue.ResString);
+  finally
+    FN.Free;
+  end;
+end;
+
+Function TestIfOperation_TestCreateFloat : TTestString;
+var
+  FN : TIfOperation;
+begin
+  Result:='';
+  FN:=TIfOperation.Create(CreateBoolNode(True),CreateFloatNode(1.23),CreateFloatNode(2.34));
+  try
+    AssertNodeOK(FN);
+    AssertEquals('Correct node type',rtFloat,FN.NodeType);
+    AssertEquals('Correct result',1.23,FN.NodeValue.ResFloat);
+  finally
+    FN.Free;
+  end;
+  FN:=TIfOperation.Create(CreateBoolNode(False),CreateFloatNode(1.23),CreateFloatNode(2.34));
+  try
+    AssertNodeOK(FN);
+    AssertEquals('Correct node type',rtFloat,FN.NodeType);
+    AssertEquals('Correct result',2.34,FN.NodeValue.ResFloat);
+  finally
+    FN.Free;
+  end;
+end;
+
+Function TestIfOperation_TestCreateDateTime : TTestString;
+var
+  FN : TIfOperation;
+  D1,D2 : TDateTime;
+begin
+  Result:='';
+  D1:=Now;
+  D2:=D1-1;
+  FN:=TIfOperation.Create(CreateBoolNode(True),CreateDateTimeNode(D1),CreateDateTimeNode(D2));
+  try
+    AssertNodeOK(FN);
+    AssertEquals('Correct node type',rtDateTime,FN.NodeType);
+    AssertEquals('Correct result',D1,FN.NodeValue.ResDateTime);
+  finally
+    FN.Free;
+  end;
+  FN:=TIfOperation.Create(CreateBoolNode(False),CreateDateTimeNode(D1),CreateDateTimeNode(D2));
+  try
+    AssertNodeOK(FN);
+    AssertEquals('Correct node type',rtDateTime,FN.NodeType);
+    AssertEquals('Correct result',D2,FN.NodeValue.ResDateTime);
+  finally
+    FN.Free;
+  end;
+end;
+
+Function TestIfOperation_TestCreateBooleanInteger : TTestString;
+var
+  FN : TIfOperation;
+begin
+  Result:='';
+  FN:=TIfOperation.Create(CreateBoolNode(True),CreateBoolNode(True),CreateIntNode(2));
+  try
+    AssertNodeNotOK('No type promotion for boolean',FN);
+  finally
+    FN.Free;
+  end;
+end;
+
+Function TestIfOperation_TestCreateBooleanInteger2 : TTestString;
+var
+  FN : TIfOperation;
+begin
+  Result:='';
+  FN:=TIfOperation.Create(CreateBoolNode(True),CreateIntNode(2),CreateBoolNode(True));
+  try
+    AssertNodeNotOK('No type promotion for boolean',FN);
+  finally
+    FN.Free;
+  end;
+end;
+
+Function TestIfOperation_TestCreateBooleanString : TTestString;
+var
+  FN : TIfOperation;
+begin
+  Result:='';
+  FN:=TIfOperation.Create(CreateBoolNode(True),CreateBoolNode(True),CreateStringNode('b'));
+  try
+    AssertNodeNotOK('No type promotion for boolean',FN);
+  finally
+    FN.Free;
+  end;
+end;
+
+Function TestIfOperation_TestCreateBooleanString2 : TTestString;
+var
+  FN : TIfOperation;
+begin
+  Result:='';
+  FN:=TIfOperation.Create(CreateBoolNode(True),CreateStringNode('b'),CreateBoolNode(True));
+  try
+    AssertNodeNotOK('No type promotion for boolean',FN);
+  finally
+    FN.Free;
+  end;
+end;
+
+Function TestIfOperation_TestCreateBooleanDateTime : TTestString;
+var
+  FN : TIfOperation;
+begin
+  Result:='';
+  FN:=TIfOperation.Create(CreateBoolNode(True),CreateBoolNode(True),CreateDateTimeNode(Now));
+  try
+    AssertNodeNotOK('No type promotion for boolean',FN);
+  finally
+    FN.Free;
+  end;
+end;
+
+Function TestIfOperation_TestCreateBooleanDateTime2 : TTestString;
+var
+  FN : TIfOperation;
+begin
+  Result:='';
+  FN:=TIfOperation.Create(CreateBoolNode(True),CreateDateTimeNode(Now),CreateBoolNode(True));
+  try
+    AssertNodeNotOK('No type promotion for boolean',FN);
+  finally
+    FN.Free;
+  end;
+end;
+
+Function TestIfOperation_TestDestroy : TTestString;
+var
+  FN : TIfOperation;
+begin
+  Result:='';
+  FDestroyCalled := 0;
+  FN:=TIfOperation.Create(TMyDestroyNode.CreateInteger(1),TMyDestroyNode.CreateInteger(1),TMyDestroyNode.CreateInteger(1));
+  FN.Free;
+  AssertEquals('Destroy called for all nodes',3,FDestroyCalled);
+end;
+
+function CreateArgs(  Args: array of const): TExprArgumentArray;
+
+Var
+  I : Integer;
+
+begin
+  Result:=Default(TExprArgumentArray);
+  SetLength(Result,High(Args)-Low(Args)+1);
+  For I:=Low(Args) to High(Args) do
+    Result[I]:=Args[i].VObject as TFPExprNode;
+end;
+
+
+Function TestCaseOperation_TestCreateOne : TTestString;
+var
+  FN : TCaseOperation;
+begin
+  Result:='';
+  FN:=TCaseOperation.Create(CreateArgs([CreateBoolNode(False)]));
+  try
+    AssertNodeNotOK('Too little arguments',FN);
+  finally
+    FN.Free;
+  end;
+end;
+
+Function TestCaseOperation_TestCreateTwo : TTestString;
+var
+  FN : TCaseOperation;
+begin
+  Result:='';
+  FN:=TCaseOperation.Create(CreateArgs([CreateBoolNode(False),CreateBoolNode(False)]));
+  try
+    AssertNodeNotOK('Too little arguments',FN);
+  finally
+    FN.Free;
+  end;
+end;
+
+Function TestCaseOperation_TestCreateThree : TTestString;
+var
+  FN : TCaseOperation;
+begin
+  Result:='';
+  FN:=TCaseOperation.Create(CreateArgs([CreateBoolNode(False),CreateBoolNode(False),CreateBoolNode(False)]));
+  try
+    AssertNodeNotOK('Too little arguments',FN);
+  finally
+    FN.Free;
+  end;
+end;
+
+Function TestCaseOperation_TestCreateOdd : TTestString;
+var
+  FN : TCaseOperation;
+begin
+  Result:='';
+  FN:=TCaseOperation.Create(CreateArgs([CreateBoolNode(False),CreateBoolNode(False),
+                                          CreateBoolNode(False),CreateBoolNode(False),
+                                          CreateBoolNode(False)]));
+  try
+    AssertNodeNotOK('Odd number of arguments',FN);
+  finally
+    FN.Free;
+  end;
+end;
+
+Function TestCaseOperation_TestCreateNoExpression : TTestString;
+var
+  FN : TCaseOperation;
+begin
+  Result:='';
+  FN:=TCaseOperation.Create(CreateArgs([CreateBoolNode(False),
+                                          CreateBoolNode(False),
+                                          TFPBinaryOrOperation.Create(CreateBoolNode(False),CreateBoolNode(False)),
+                                          CreateBoolNode(False)]));
+  try
+    AssertNodeNotOK('Label is not a constant expression',FN);
+  finally
+    FN.Free;
+  end;
+end;
+
+Function TestCaseOperation_TestCreateWrongLabel : TTestString;
+var
+  FN : TCaseOperation;
+begin
+  Result:='';
+  FN:=TCaseOperation.Create(CreateArgs([CreateIntNode(1),CreateBoolNode(False),
+                                        CreateIntNode(1),CreateBoolNode(False),
+                                        CreateBoolNode(True),CreateBoolNode(False)]));
+  try
+    AssertNodeNotOK('Wrong label type',FN);
+  finally
+    FN.Free;
+  end;
+end;
+
+Function TestCaseOperation_TestCreateWrongValue : TTestString;
+var
+  FN : TCaseOperation;
+begin
+  Result:='';
+  FN:=TCaseOperation.Create(CreateArgs([CreateIntNode(1),CreateBoolNode(False),
+                                          CreateIntNode(1),CreateBoolNode(False),
+                                          CreateIntNode(2),CreateIntNode(1)]));
+  try
+    AssertNodeNotOK('Wrong value',FN);
+  finally
+    FN.Free;
+  end;
+end;
+
+Function TestCaseOperation_TestIntegerTag : TTestString;
+var
+  FN : TCaseOperation;
+begin
+  Result:='';
+  FN:=TCaseOperation.Create(CreateArgs([CreateIntNode(1),CreateStringNode('many'),
+                                          CreateIntNode(1),CreateStringNode('one'),
+                                          CreateIntNode(2),CreateStringNode('two')]));
+  try
+    AssertNodeOK(FN);
+    AssertEquals('Correct node type',rtString,FN.NodeType);
+    AssertEquals('Correct result','one',FN.NodeValue.ResString);
+  finally
+    FN.Free;
+  end;
+end;
+
+Function TestCaseOperation_TestIntegerTagDefault : TTestString;
+var
+  FN : TCaseOperation;
+begin
+  Result:='';
+  FN:=TCaseOperation.Create(CreateArgs([CreateIntNode(3),CreateStringNode('many'),
+                                        CreateIntNode(1),CreateStringNode('one'),
+                                        CreateIntNode(2),CreateStringNode('two')]));
+  try
+    AssertNodeOK(FN);
+    AssertEquals('Correct node type',rtString,FN.NodeType);
+    AssertEquals('Correct result','many',FN.NodeValue.ResString);
+  finally
+    FN.Free;
+  end;
+end;
+
+Function TestCaseOperation_TestStringTag : TTestString;
+var
+  FN : TCaseOperation;
+begin
+  Result:='';
+  FN:=TCaseOperation.Create(CreateArgs([CreateIntNode(3),CreateStringNode('many'),
+                                        CreateIntNode(1),CreateStringNode('one'),
+                                        CreateIntNode(2),CreateStringNode('two')]));
+  try
+    AssertNodeOK(FN);
+    AssertEquals('Correct node type',rtString,FN.NodeType);
+    AssertEquals('Correct result','many',FN.NodeValue.ResString);
+  finally
+    FN.Free;
+  end;
+end;
+
+Function TestCaseOperation_TestStringTagDefault : TTestString;
+var
+  FN : TCaseOperation;
+begin
+  Result:='';
+  FN:=TCaseOperation.Create(CreateArgs([CreateStringNode('many'),CreateIntNode(3),
+                                        CreateStringNode('one'),CreateIntNode(1),
+                                        CreateStringNode('two'),CreateIntNode(2)]));
+  try
+    AssertNodeOK(FN);
+    AssertEquals('Correct node type',rtInteger,FN.NodeType);
+    AssertEquals('Correct result',3,FN.NodeValue.ResInteger);
+  finally
+    FN.Free;
+  end;
+end;
+
+Function TestCaseOperation_TestFloatTag : TTestString;
+var
+  FN : TCaseOperation;
+begin
+  Result:='';
+  FN:=TCaseOperation.Create(CreateArgs([CreateFloatNode(1.0),CreateStringNode('many'),
+                                        CreateFloatNode(1.0),CreateStringNode('one'),
+                                        CreateFloatNode(2.0),CreateStringNode('two')]));
+  try
+    AssertNodeOK(FN);
+    AssertEquals('Correct node type',rtString,FN.NodeType);
+    AssertEquals('Correct result','one',FN.NodeValue.ResString);
+  finally
+    FN.Free;
+  end;
+end;
+
+Function TestCaseOperation_TestFloatTagDefault : TTestString;
+var
+  FN : TCaseOperation;
+begin
+  Result:='';
+  FN:=TCaseOperation.Create(CreateArgs([CreateFloatNode(1.0),CreateStringNode('many'),
+                                          CreateFloatNode(1.0),CreateStringNode('one'),
+                                          CreateFloatNode(2.0),CreateStringNode('two')]));
+  try
+    AssertNodeOK(FN);
+    AssertEquals('Correct node type',rtString,FN.NodeType);
+    AssertEquals('Correct result','one',FN.NodeValue.ResString);
+  finally
+    FN.Free;
+  end;
+end;
+
+Function TestCaseOperation_TestBooleanTag : TTestString;
+var
+  FN : TCaseOperation;
+begin
+  Result:='';
+  FN:=TCaseOperation.Create(CreateArgs([CreateBoolNode(True),CreateStringNode('unknown'),
+                                        CreateBoolNode(True),CreateStringNode('one'),
+                                        CreateBoolNode(False),CreateStringNode('two')]));
+  try
+    AssertNodeOK(FN);
+    AssertEquals('Correct node type',rtString,FN.NodeType);
+    AssertEquals('Correct result','one',FN.NodeValue.ResString);
+  finally
+    FN.Free;
+  end;
+end;
+
+Function TestCaseOperation_TestBooleanTagDefault : TTestString;
+var
+  FN : TCaseOperation;
+begin
+  Result:='';
+  FN:=TCaseOperation.Create(CreateArgs([CreateBoolNode(True),CreateStringNode('unknown'),
+                                        CreateBoolNode(False),CreateStringNode('two')]));
+  try
+    AssertNodeOK(FN);
+    AssertEquals('Correct node type',rtString,FN.NodeType);
+    AssertEquals('Correct result','unknown',FN.NodeValue.ResString);
+  finally
+    FN.Free;
+  end;
+end;
+
+Function TestCaseOperation_TestDateTimeTag : TTestString;
+var
+  FN : TCaseOperation;
+begin
+  Result:='';
+  FN:=TCaseOperation.Create(CreateArgs([CreateDateTimeNode(Date),CreateStringNode('later'),
+                                        CreateDateTimeNode(Date),CreateStringNode('today'),
+                                        CreateDateTimeNode(Date+1),CreateStringNode('tomorrow')]));
+  try
+    AssertNodeOK(FN);
+    AssertEquals('Correct node type',rtString,FN.NodeType);
+    AssertEquals('Correct result','today',FN.NodeValue.ResString);
+  finally
+    FN.Free;
+  end;
+end;
+
+Function TestCaseOperation_TestDateTimeTagDefault : TTestString;
+var
+  FN : TCaseOperation;
+begin
+  Result:='';
+  FN:=TCaseOperation.Create(CreateArgs([CreateDateTimeNode(Date),CreateStringNode('later'),
+                                          CreateDateTimeNode(Date),CreateStringNode('today'),
+                                          CreateDateTimeNode(Date+1),CreateStringNode('tomorrow')]));
+  try
+    AssertNodeOK(FN);
+    AssertEquals('Correct node type',rtString,FN.NodeType);
+    AssertEquals('Correct result','today',FN.NodeValue.ResString);
+  finally
+    FN.Free;
+  end;
+end;
+
+Function TestCaseOperation_TestIntegerValue : TTestString;
+var
+  FN : TCaseOperation;
+begin
+  Result:='';
+  FN:=TCaseOperation.Create(CreateArgs([CreateIntNode(1),CreateIntNode(0),
+                                          CreateIntNode(1),CreateIntNode(-1),
+                                          CreateIntNode(2),CreateIntNode(-2)]));
+  try
+    AssertNodeOK(FN);
+    AssertEquals('Correct node type',rtInteger,FN.NodeType);
+    AssertEquals('Correct result',-1,FN.NodeValue.ResInteger);  finally
+    FN.Free;
+  end;
+end;
+
+Function TestCaseOperation_TestIntegerValueDefault : TTestString;
+var
+  FN : TCaseOperation;
+begin
+  Result:='';
+  FN:=TCaseOperation.Create(CreateArgs([CreateIntNode(3),CreateIntNode(0),
+                                        CreateIntNode(1),CreateIntNode(-1),
+                                        CreateIntNode(2),CreateIntNode(-2)]));
+  try
+    AssertNodeOK(FN);
+    AssertEquals('Correct node type',rtInteger,FN.NodeType);
+    AssertEquals('Correct result',0,FN.NodeValue.ResInteger);
+  finally
+    FN.Free;
+  end;
+end;
+
+Function TestCaseOperation_TestStringValue : TTestString;
+var
+  FN : TCaseOperation;
+begin
+  Result:='';
+  FN:=TCaseOperation.Create(CreateArgs([CreateIntNode(1),CreateStringNode('many'),
+                                        CreateIntNode(1),CreateStringNode('one'),
+                                        CreateIntNode(2),CreateStringNode('two')]));
+  try
+    AssertNodeOK(FN);
+    AssertEquals('Correct node type',rtString,FN.NodeType);
+    AssertEquals('Correct result','one',FN.NodeValue.ResString);
+  finally
+    FN.Free;
+  end;
+end;
+
+Function TestCaseOperation_TestStringValueDefault : TTestString;
+var
+  FN : TCaseOperation;
+begin
+  Result:='';
+  FN:=TCaseOperation.Create(CreateArgs([CreateIntNode(3),CreateStringNode('many'),
+                                        CreateIntNode(1),CreateStringNode('one'),
+                                        CreateIntNode(2),CreateStringNode('two')]));
+  try
+    AssertNodeOK(FN);
+    AssertEquals('Correct node type',rtString,FN.NodeType);
+    AssertEquals('Correct result','many',FN.NodeValue.ResString);
+  finally
+    FN.Free;
+  end;
+end;
+
+Function TestCaseOperation_TestFloatValue : TTestString;
+var
+  FN : TCaseOperation;
+begin
+  Result:='';
+  FN:=TCaseOperation.Create(CreateArgs([CreateIntNode(1),CreateFloatNode(0.0),
+                                        CreateIntNode(1),CreateFloatNode(2.0),
+                                        CreateIntNode(2),CreateFloatNode(1.0)]));
+  try
+    AssertNodeOK(FN);
+    AssertEquals('Correct node type',rtFloat,FN.NodeType);
+    AssertEquals('Correct result',2.0,FN.NodeValue.ResFloat);
+  finally
+    FN.Free;
+  end;
+end;
+
+Function TestCaseOperation_TestFloatValueDefault : TTestString;
+var
+  FN : TCaseOperation;
+begin
+  Result:='';
+  FN:=TCaseOperation.Create(CreateArgs([CreateIntNode(3),CreateFloatNode(0.0),
+                                        CreateIntNode(1),CreateFloatNode(2.0),
+                                        CreateIntNode(2),CreateFloatNode(1.0)]));
+  try
+    AssertNodeOK(FN);
+    AssertEquals('Correct node type',rtFloat,FN.NodeType);
+    AssertEquals('Correct result',0.0,FN.NodeValue.ResFloat);
+  finally
+    FN.Free;
+  end;
+end;
+
+Function TestCaseOperation_TestBooleanValue : TTestString;
+var
+  FN : TCaseOperation;
+begin
+  Result:='';
+  FN:=TCaseOperation.Create(CreateArgs([CreateIntNode(1),CreateBoolNode(False),
+                                        CreateIntNode(1),CreateBoolNode(True),
+                                        CreateIntNode(2),CreateBoolNode(False)]));
+  try
+    AssertNodeOK(FN);
+    AssertEquals('Correct node type',rtBoolean,FN.NodeType);
+    AssertEquals('Correct result',True,FN.NodeValue.ResBoolean);
+  finally
+    FN.Free;
+  end;
+end;
+
+Function TestCaseOperation_TestBooleanValueDefault : TTestString;
+var
+  FN : TCaseOperation;
+begin
+  Result:='';
+  FN:=TCaseOperation.Create(CreateArgs([CreateIntNode(3),CreateBoolNode(False),
+                                        CreateIntNode(1),CreateBoolNode(True),
+                                        CreateIntNode(2),CreateBoolNode(False)]));
+  try
+    AssertNodeOK(FN);
+    AssertEquals('Correct node type',rtBoolean,FN.NodeType);
+    AssertEquals('Correct result',False,FN.NodeValue.ResBoolean);
+  finally
+    FN.Free;
+  end;
+end;
+
+Function TestCaseOperation_TestDateTimeValue : TTestString;
+var
+  FN : TCaseOperation;
+begin
+  Result:='';
+  FN:=TCaseOperation.Create(CreateArgs([CreateIntNode(1),CreateDateTimeNode(Date+1),
+                                        CreateIntNode(1),CreateDateTimeNode(Date),
+                                        CreateIntNode(2),CreateDateTimeNode(Date-1)]));
+  try
+    AssertNodeOK(FN);
+    AssertEquals('Correct node type',rtDateTime,FN.NodeType);
+    AssertEquals('Correct result',Date,FN.NodeValue.ResDateTime);
+  finally
+    FN.Free;
+  end;
+end;
+
+Function TestCaseOperation_TestDateTimeValueDefault : TTestString;
+var
+  FN : TCaseOperation;
+begin
+  Result:='';
+  FN:=TCaseOperation.Create(CreateArgs([CreateIntNode(3),CreateDateTimeNode(Date+1),
+                                        CreateIntNode(1),CreateDateTimeNode(Date),
+                                        CreateIntNode(2),CreateDateTimeNode(Date-1)]));
+  try
+    AssertNodeOK(FN);
+    AssertEquals('Correct node type',rtDateTime,FN.NodeType);
+    AssertEquals('Correct result',Date+1,FN.NodeValue.ResDateTime);
+  finally
+    FN.Free;
+  end;
+end;
+
+Function TestCaseOperation_TestDestroy : TTestString;
+var
+  FN : TCaseOperation;
+begin
+  Result:='';
+  FN:=TCaseOperation.Create(CreateArgs([TMyDestroyNode.CreateInteger(1),
+                                        TMyDestroyNode.CreateInteger(1),
+                                        TMyDestroyNode.CreateInteger(2),
+                                        TMyDestroyNode.CreateInteger(3)]));
+  FreeAndNil(FN);
+  AssertEquals('Destroy called for operand',4,FDestroyCalled)
+end;
+
+
+procedure RegisterTests(aTop: PSuite);
+var
+  lSuite,lParent : PSuite;
+begin
+  lParent:=AddSuite('ExprParserOps',@SuiteSetup, @SuiteTearDown, aTop);
+  lSuite:=AddSuite('TIfOperation', @SuiteSetup, @SuiteTearDown,lParent,True);
+  AddTest('TestCreateInteger', @TestIfOperation_TestCreateInteger, lSuite);
+  AddTest('TestCreateBoolean', @TestIfOperation_TestCreateBoolean, lSuite);
+  AddTest('TestCreateBoolean2', @TestIfOperation_TestCreateBoolean2, lSuite);
+  AddTest('TestCreateString', @TestIfOperation_TestCreateString, lSuite);
+  AddTest('TestCreateFloat', @TestIfOperation_TestCreateFloat, lSuite);
+  AddTest('TestCreateDateTime', @TestIfOperation_TestCreateDateTime, lSuite);
+  AddTest('TestCreateBooleanInteger', @TestIfOperation_TestCreateBooleanInteger, lSuite);
+  AddTest('TestCreateBooleanInteger2', @TestIfOperation_TestCreateBooleanInteger2, lSuite);
+  AddTest('TestCreateBooleanString', @TestIfOperation_TestCreateBooleanString, lSuite);
+  AddTest('TestCreateBooleanString2', @TestIfOperation_TestCreateBooleanString2, lSuite);
+  AddTest('TestCreateBooleanDateTime', @TestIfOperation_TestCreateBooleanDateTime, lSuite);
+  AddTest('TestCreateBooleanDateTime2', @TestIfOperation_TestCreateBooleanDateTime2, lSuite);
+  AddTest('TestDestroy', @TestIfOperation_TestDestroy, lSuite);
+
+  lSuite:=AddSuite('TCaseOperationTests', @SuiteSetup, @SuiteTearDown,lParent,true);
+  AddTest('TestCreateOne', @TestCaseOperation_TestCreateOne, lSuite);
+  AddTest('TestCreateTwo', @TestCaseOperation_TestCreateTwo, lSuite);
+  AddTest('TestCreateThree', @TestCaseOperation_TestCreateThree, lSuite);
+  AddTest('TestCreateOdd', @TestCaseOperation_TestCreateOdd, lSuite);
+  AddTest('TestCreateNoExpression', @TestCaseOperation_TestCreateNoExpression, lSuite);
+  AddTest('TestCreateWrongLabel', @TestCaseOperation_TestCreateWrongLabel, lSuite);
+  AddTest('TestCreateWrongValue', @TestCaseOperation_TestCreateWrongValue, lSuite);
+  AddTest('TestIntegerTag', @TestCaseOperation_TestIntegerTag, lSuite);
+  AddTest('TestIntegerTagDefault', @TestCaseOperation_TestIntegerTagDefault, lSuite);
+  AddTest('TestStringTag', @TestCaseOperation_TestStringTag, lSuite);
+  AddTest('TestStringTagDefault', @TestCaseOperation_TestStringTagDefault, lSuite);
+  AddTest('TestFloatTag', @TestCaseOperation_TestFloatTag, lSuite);
+  AddTest('TestFloatTagDefault', @TestCaseOperation_TestFloatTagDefault, lSuite);
+  AddTest('TestBooleanTag', @TestCaseOperation_TestBooleanTag, lSuite);
+  AddTest('TestBooleanTagDefault', @TestCaseOperation_TestBooleanTagDefault, lSuite);
+  AddTest('TestDateTimeTag', @TestCaseOperation_TestDateTimeTag, lSuite);
+  AddTest('TestDateTimeTagDefault', @TestCaseOperation_TestDateTimeTagDefault, lSuite);
+  AddTest('TestIntegerValue', @TestCaseOperation_TestIntegerValue, lSuite);
+  AddTest('TestIntegerValueDefault', @TestCaseOperation_TestIntegerValueDefault, lSuite);
+  AddTest('TestStringValue', @TestCaseOperation_TestStringValue, lSuite);
+  AddTest('TestStringValueDefault', @TestCaseOperation_TestStringValueDefault, lSuite);
+  AddTest('TestFloatValue', @TestCaseOperation_TestFloatValue, lSuite);
+  AddTest('TestFloatValueDefault', @TestCaseOperation_TestFloatValueDefault, lSuite);
+  AddTest('TestBooleanValue', @TestCaseOperation_TestBooleanValue, lSuite);
+  AddTest('TestBooleanValueDefault', @TestCaseOperation_TestBooleanValueDefault, lSuite);
+  AddTest('TestDateTimeValue', @TestCaseOperation_TestDateTimeValue, lSuite);
+  AddTest('TestDateTimeValueDefault', @TestCaseOperation_TestDateTimeValueDefault, lSuite);
+  AddTest('TestDestroy', @TestCaseOperation_TestDestroy, lSuite);
+
+end;
+
+end.

+ 127 - 0
packages/fcl-base/tests/utcexprparsparser.pp

@@ -0,0 +1,127 @@
+unit utcExprParsParser;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, punit, math, fpexprpars;
+
+procedure RegisterTests;
+
+implementation
+
+uses typinfo;
+
+type
+  TMyFPExpressionParser = class(TFPExpressionParser)
+  public
+    property ExprNode;
+    property Scanner;
+    property Dirty;
+  end;
+
+var
+  FP: TMyFPExpressionParser;
+  FTestExpr: String;
+
+procedure AssertLeftRight(N: TFPExprNode; LeftClass, RightClass: TClass);
+begin
+  AssertNotNull('Node should not be nil', N);
+  AssertEquals('Node should be a binary operation', True, N is TFPBinaryOperation);
+  if N is TFPBinaryOperation then
+  begin
+    AssertEquals('Left node class', LeftClass, TFPBinaryOperation(N).Left.ClassType);
+    AssertEquals('Right node class', RightClass, TFPBinaryOperation(N).Right.ClassType);
+  end;
+end;
+
+procedure AssertOperand(N: TFPExprNode; OperandClass: TClass);
+begin
+  AssertNotNull('Node should not be nil', N);
+  AssertEquals('Node should be a unary operation', True, N is TFPUnaryOperator);
+  if N is TFPUnaryOperator then
+    AssertEquals('Operand node class', OperandClass, TFPUnaryOperator(N).Operand.ClassType);
+end;
+
+procedure AssertEqualsResultType(Msg: String; AExpected, AActual: TResultType);
+begin
+  AssertEquals(Msg, ResultTypeName(AExpected), ResultTypeName(AActual));
+end;
+
+procedure AssertResultType(RT: TResultType);
+begin
+  AssertEqualsResultType('Result type', RT, FP.ExprNode.NodeType);
+end;
+
+procedure AssertResult(F: TExprFloat);
+begin
+  AssertEquals('Float result', F, FP.AsFloat, 1E-9);
+end;
+
+procedure AssertCurrencyResult(C: Currency);
+begin
+  AssertEquals('Currency result', C, FP.AsCurrency, 1E-4);
+end;
+
+procedure AssertResult(I: Int64);
+begin
+  AssertEquals('Integer result', I, FP.AsInteger);
+end;
+
+procedure AssertResult(S: String);
+begin
+  AssertEquals('String result', S, FP.AsString);
+end;
+
+procedure AssertResult(B: Boolean);
+begin
+  AssertEquals('Boolean result', B, FP.AsBoolean);
+end;
+
+procedure AssertDateTimeResult(D: TDateTime);
+begin
+  AssertEquals('DateTime result', D, FP.AsDateTime);
+end;
+
+function Parser_Setup: string;
+begin
+  FP := TMyFPExpressionParser.Create(nil);
+end;
+
+function Parser_TearDown : string;
+begin
+  FreeAndNil(FP);
+end;
+
+procedure TestParser(AExpr: String);
+begin
+  FP.Expression := AExpr;
+end;
+
+function TestParserExpressions_TestCreate: TTestString;
+begin
+  Result := '';
+  AssertNotNull('Parser created', FP);
+end;
+
+function TestParserExpressions_TestNumberValues: TTestString;
+begin
+  Result := '';
+  TestParser('123');
+  AssertResult(123);
+  TestParser('123.456');
+  AssertResult(123.456);
+end;
+
+// ... and so on for all the other test cases ...
+
+procedure RegisterTests;
+begin
+  AddSuite('TParserExpressionsTests', @Parser_Setup, @Parser_TearDown);
+  AddTest('TestCreate', @TestParserExpressions_TestCreate, 'TParserExpressionsTests');
+  AddTest('TestNumberValues', @TestParserExpressions_TestNumberValues, 'TParserExpressionsTests');
+  // ... and so on for all the other tests ...
+end;
+
+end.

+ 243 - 0
packages/fcl-base/tests/utcexprparsscanner.pp

@@ -0,0 +1,243 @@
+unit utcExprParsScanner;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, punit, math, fpexprpars;
+
+procedure RegisterTests(aTop : PSuite);
+
+implementation
+
+uses typinfo;
+
+var
+  FP: TFPExpressionScanner;
+  FInvalidString: String;
+
+function TestExpressionScanner_SetUp : string;
+begin
+  Result:='';
+  FP := TFPExpressionScanner.Create;
+
+end;
+
+function TestExpressionScanner_TearDown : string;
+begin
+  Result:='';
+  FreeAndNil(FP);
+end;
+
+procedure AssertEqualsToken(Msg: String; AExpected, AActual: TTokenType);
+var
+  S1, S2: String;
+begin
+  S1 := TokenName(AExpected);
+  S2 := GetEnumName(TypeInfo(TTokenType), Ord(AActual));
+  AssertEquals(Msg, S1, S2);
+end;
+
+procedure TestString(const AString: String; AToken: TTokenType);
+begin
+  FP.Source := AString;
+  AssertEqualsToken('String "' + AString + '" results in token ' + TokenName(AToken), AToken, FP.GetToken);
+  if not (FP.TokenType in [ttString, ttEOF]) then
+    AssertEquals('String "' + AString + '" results in token string ' + TokenName(AToken), AString, FP.Token)
+  else if FP.TokenType = ttString then
+    AssertEquals('String "' + AString + '" results in token string ' + TokenName(AToken),
+      StringReplace(AString, '''''', '''', [rfReplaceAll]),
+      '''' + FP.Token + '''');
+end;
+
+function TestExpressionScanner_TestCreate: TTestString;
+begin
+  Result := '';
+  AssertEquals('Empty source', '', FP.Source);
+  AssertEquals('Pos is zero', 0, FP.Pos);
+  AssertEquals('CurrentChar is zero', #0, FP.CurrentChar);
+  AssertEqualsToken('Current token type is EOF', ttEOF, FP.TokenType);
+  AssertEquals('Current token is empty', '', FP.Token);
+end;
+
+function TestExpressionScanner_TestSetSource: TTestString;
+begin
+  Result := '';
+  FP.Source := 'Abc';
+  FP.Source := '';
+  AssertEquals('Empty source', '', FP.Source);
+  AssertEquals('Pos is zero', 0, FP.Pos);
+  AssertEquals('CurrentChar is zero', #0, FP.CurrentChar);
+  AssertEqualsToken('Current token type is EOF', ttEOF, FP.TokenType);
+  AssertEquals('Current token is empty', '', FP.Token);
+end;
+
+function TestExpressionScanner_TestWhiteSpace: TTestString;
+begin
+  Result := '';
+  TestString('  ', ttEOF);
+end;
+
+function TestExpressionScanner_TestTokens: TTestString;
+const
+  TestStrings: array[TTokenType] of String =
+    ('+', '-', '<', '>', '=', '/',
+    'mod', '*', '(', ')', '<=',
+    '>=', '<>', '1', '''abc''', 'abc',
+    ',', 'and', 'or', 'xor', 'true', 'false', 'not',
+    'if', 'case', '^', '');
+var
+  t: TTokenType;
+begin
+  Result := '';
+  for t := Low(TTokenType) to High(TTokenType) do
+    TestString(TestStrings[t], t);
+end;
+
+procedure DoInvalidNumber(AString: String);
+begin
+  FInvalidString := AString;
+  raise EExprScanner.Create('Invalid number');
+end;
+
+var
+  TestProcToRun: TTestRunProc;
+
+function RunTestProc: TTestString;
+begin
+  Result := '';
+  if Assigned(TestProcToRun) then
+    TestProcToRun;
+end;
+
+procedure DoTestInvalidNumberGG;
+begin
+  DoInvalidNumber('$GG');
+end;
+
+procedure DoTestInvalidNumber88;
+begin
+  DoInvalidNumber('&88');
+end;
+
+procedure DoTestInvalidNumber22;
+begin
+  DoInvalidNumber('%22');
+end;
+
+procedure DoTestInvalidNumber11;
+begin
+  DoInvalidNumber('1..1');
+end;
+
+procedure DoTestInvalidNumber1E;
+begin
+  DoInvalidNumber('1.E--1');
+end;
+
+function TestExpressionScanner_TestNumber: TTestString;
+begin
+  Result := '';
+  TestString('123', ttNumber);
+  TestString('$FF', ttNumber);
+  TestString('&77', ttNumber);
+  TestString('%11111111', ttNumber);
+  TestString('123.4', ttNumber);
+  TestString('123.E4', ttNumber);
+  TestString('1.E4', ttNumber);
+  TestString('1e-2', ttNumber);
+  TestProcToRun := @DoTestInvalidNumberGG;
+  AssertException('Invalid number "$GG"', EExprScanner, @RunTestProc);
+  TestProcToRun := @DoTestInvalidNumber88;
+  AssertException('Invalid number "&88"', EExprScanner, @RunTestProc);
+  TestProcToRun := @DoTestInvalidNumber22;
+  AssertException('Invalid number "%22"', EExprScanner, @RunTestProc);
+  TestProcToRun := @DoTestInvalidNumber11;
+  AssertException('Invalid number "1..1"', EExprScanner, @RunTestProc);
+  TestProcToRun := @DoTestInvalidNumber1E;
+  AssertException('Invalid number "1.E--1"', EExprScanner, @RunTestProc);
+end;
+
+procedure DoTestInvalidCharTilde;
+begin
+  DoInvalidNumber('~');
+end;
+
+procedure DoTestInvalidCharHash;
+begin
+  DoInvalidNumber('#');
+end;
+
+procedure DoTestInvalidCharDollar;
+begin
+  DoInvalidNumber('$');
+end;
+
+function TestExpressionScanner_TestInvalidCharacter: TTestString;
+begin
+  Result := '';
+  TestProcToRun := @DoTestInvalidCharTilde;
+  AssertException('Invalid character "~"', EExprScanner, @RunTestProc);
+  TestProcToRun := @DoTestInvalidCharHash;
+  AssertException('Invalid character "#"', EExprScanner, @RunTestProc);
+  TestProcToRun := @DoTestInvalidCharDollar;
+  AssertException('Invalid character "$"', EExprScanner, @RunTestProc);
+end;
+
+procedure DoTestUnterminatedString;
+begin
+  DoInvalidNumber('''abc');
+end;
+
+function TestExpressionScanner_TestUnterminatedString: TTestString;
+begin
+  Result := '';
+  TestProcToRun := @DoTestUnterminatedString;
+  AssertException('Unterminated string', EExprScanner, @RunTestProc);
+end;
+
+function TestExpressionScanner_TestQuotesInString: TTestString;
+begin
+  Result := '';
+  TestString('''That''''s it''', ttString);
+  TestString('''''''s it''', ttString);
+  TestString('''s it''''''', ttString);
+end;
+
+procedure TestIdentifier(const ASource, ATokenName: String);
+begin
+  FP.Source := ASource;
+  AssertEqualsToken('Token type', ttIdentifier, FP.GetToken);
+  AssertEquals('Token name', ATokenName, FP.Token);
+end;
+
+function TestExpressionScanner_TestIdentifiers: TTestString;
+begin
+  Result := '';
+  TestIdentifier('a', 'a');
+  TestIdentifier(' a', 'a');
+  TestIdentifier('a ', 'a');
+  TestIdentifier('a^b', 'a');
+  TestIdentifier('a-b', 'a');
+  TestIdentifier('a.b', 'a.b');
+  TestIdentifier('"a b"', 'a b');
+  TestIdentifier('c."a b"', 'c.a b');
+  TestIdentifier('c."ab"', 'c.ab');
+end;
+
+procedure RegisterTests(aTop : PSuite);
+begin
+  AddSuite('TExpressionScannerTests', @TestExpressionScanner_SetUp, @TestExpressionScanner_TearDown, aTop, True);
+  AddTest('TestCreate', @TestExpressionScanner_TestCreate, 'TExpressionScannerTests');
+  AddTest('TestSetSource', @TestExpressionScanner_TestSetSource, 'TExpressionScannerTests');
+  AddTest('TestWhiteSpace', @TestExpressionScanner_TestWhiteSpace, 'TExpressionScannerTests');
+  AddTest('TestTokens', @TestExpressionScanner_TestTokens, 'TExpressionScannerTests');
+  AddTest('TestNumber', @TestExpressionScanner_TestNumber, 'TExpressionScannerTests');
+  AddTest('TestInvalidCharacter', @TestExpressionScanner_TestInvalidCharacter, 'TExpressionScannerTests');
+  AddTest('TestUnterminatedString', @TestExpressionScanner_TestUnterminatedString, 'TExpressionScannerTests');
+  AddTest('TestQuotesInString', @TestExpressionScanner_TestQuotesInString, 'TExpressionScannerTests');
+  AddTest('TestIdentifiers', @TestExpressionScanner_TestIdentifiers, 'TExpressionScannerTests');
+end;
+
+end.

+ 228 - 0
packages/fcl-base/tests/utcfphashobjectlist.pp

@@ -0,0 +1,228 @@
+unit utcFPHashObjectList;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, contnrs, punit;
+
+procedure RegisterTests;
+
+implementation
+
+type
+  TMyObject = class(TObject)
+    IsFreed: ^Boolean;
+    destructor Destroy; override;
+  end;
+
+destructor TMyObject.Destroy;
+begin
+  if Assigned(IsFreed) then
+    IsFreed^ := True;
+  inherited Destroy;
+end;
+
+Function TFPHashObjectList_TestCreate : TTestString;
+var
+  L: TFPHashObjectList;
+begin
+  Result:='';
+  L := TFPHashObjectList.Create;
+  try
+    AssertNotNull('List should be created', L);
+    AssertEquals('Count should be 0 on creation', 0, L.Count);
+    AssertTrue('OwnsObjects should be true by default', L.OwnsObjects);
+  finally
+    L.Free;
+  end;
+end;
+
+Function TFPHashObjectList_TestAdd : TTestString;
+var
+  L: TFPHashObjectList;
+  O1, O2: TObject;
+begin
+  Result:='';
+  L := TFPHashObjectList.Create(False);
+  try
+    O1 := TObject.Create;
+    O2 := TObject.Create;
+    L.Add('O1', O1);
+    AssertEquals('Count should be 1 after adding one object', 1, L.Count);
+    AssertSame('First item should be O1', O1, L.Items[0]);
+    L.Add('O2', O2);
+    AssertEquals('Count should be 2 after adding a second object', 2, L.Count);
+    AssertSame('Second item should be O2', O2, L.Items[1]);
+  finally
+    L.Free;
+    O1.Free;
+    O2.Free;
+  end;
+end;
+
+Function TFPHashObjectList_TestDelete : TTestString;
+var
+  L: TFPHashObjectList;
+  O1, O2: TObject;
+begin
+  Result:='';
+  L := TFPHashObjectList.Create(False);
+  try
+    O1 := TObject.Create;
+    O2 := TObject.Create;
+    L.Add('O1', O1);
+    L.Add('O2', O2);
+    L.Delete(0);
+    AssertEquals('Count should be 1 after deleting an object', 1, L.Count);
+    AssertSame('First item should now be O2', O2, L.Items[0]);
+  finally
+    L.Free;
+    O1.Free;
+    O2.Free;
+  end;
+end;
+
+Function TFPHashObjectList_TestClear : TTestString;
+var
+  L: TFPHashObjectList;
+  O1, O2: TObject;
+begin
+  Result:='';
+  L := TFPHashObjectList.Create(False);
+  try
+    O1 := TObject.Create;
+    O2 := TObject.Create;
+    L.Add('O1', O1);
+    L.Add('O2', O2);
+    L.Clear;
+    AssertEquals('Count should be 0 after clearing the list', 0, L.Count);
+  finally
+    L.Free;
+    O1.Free;
+    O2.Free;
+  end;
+end;
+
+Function TFPHashObjectList_TestIndexOf : TTestString;
+var
+  L: TFPHashObjectList;
+  O1, O2, O3: TObject;
+begin
+  Result:='';
+  L := TFPHashObjectList.Create(False);
+  O3 := TObject.Create;
+  try
+    O1 := TObject.Create;
+    O2 := TObject.Create;
+    L.Add('O1', O1);
+    L.Add('O2', O2);
+    AssertEquals('Index of O1 should be 0', 0, L.IndexOf(O1));
+    AssertEquals('Index of O2 should be 1', 1, L.IndexOf(O2));
+    AssertEquals('Index of a non-existent object should be -1', -1, L.IndexOf(O3));
+  finally
+    L.Free;
+    O1.Free;
+    O2.Free;
+    O3.Free;
+  end;
+end;
+
+Function TFPHashObjectList_TestRemove : TTestString;
+var
+  L: TFPHashObjectList;
+  O1, O2: TObject;
+begin
+  Result:='';
+  L := TFPHashObjectList.Create(False);
+  try
+    O1 := TObject.Create;
+    O2 := TObject.Create;
+    L.Add('O1', O1);
+    L.Add('O2', O2);
+    L.Remove(O1);
+    AssertEquals('Count should be 1 after removing an object', 1, L.Count);
+    AssertSame('First item should now be O2', O2, L.Items[0]);
+  finally
+    L.Free;
+    O1.Free;
+    O2.Free;
+  end;
+end;
+
+Function TFPHashObjectList_TestOwnsObjects : TTestString;
+var
+  L: TFPHashObjectList;
+  O1: TMyObject;
+  Freed: Boolean;
+begin
+  Result:='';
+  L := TFPHashObjectList.Create(True);
+  Freed := False;
+  O1 := TMyObject.Create;
+  O1.IsFreed := @Freed;
+  L.Add('O1', O1);
+  L.Free; // This should free O1 as well
+  AssertTrue('Object should be freed when OwnsObjects is true and list is freed', Freed);
+end;
+
+Function TFPHashObjectList_TestFind : TTestString;
+var
+  L: TFPHashObjectList;
+  O1, O2: TObject;
+begin
+  Result:='';
+  L := TFPHashObjectList.Create(False);
+  try
+    O1 := TObject.Create;
+    O2 := TObject.Create;
+    L.Add('O1', O1);
+    L.Add('O2', O2);
+    AssertSame('Find should return O1', O1, L.Find('O1'));
+    AssertSame('Find should return O2', O2, L.Find('O2'));
+    AssertEquals('Find for a non-existent object should return nil', nil, L.Find('O3'));
+  finally
+    L.Free;
+    O1.Free;
+    O2.Free;
+  end;
+end;
+
+Function TFPHashObjectList_TestFindIndexOf : TTestString;
+var
+  L: TFPHashObjectList;
+  O1, O2: TObject;
+begin
+  Result:='';
+  L := TFPHashObjectList.Create(False);
+  try
+    O1 := TObject.Create;
+    O2 := TObject.Create;
+    L.Add('O1', O1);
+    L.Add('O2', O2);
+    AssertEquals('FindIndexOf for O1 should be 0', 0, L.FindIndexOf('O1'));
+    AssertEquals('FindIndexOf for O2 should be 1', 1, L.FindIndexOf('O2'));
+    AssertEquals('FindIndexOf for a non-existent object should be -1', -1, L.FindIndexOf('O3'));
+  finally
+    L.Free;
+    O1.Free;
+    O2.Free;
+  end;
+end;
+
+procedure RegisterTests;
+begin
+  AddSuite('TFPHashObjectListTests');
+  AddTest('TestCreate', @TFPHashObjectList_TestCreate, 'TFPHashObjectListTests');
+  AddTest('TestAdd', @TFPHashObjectList_TestAdd, 'TFPHashObjectListTests');
+  AddTest('TestDelete', @TFPHashObjectList_TestDelete, 'TFPHashObjectListTests');
+  AddTest('TestClear', @TFPHashObjectList_TestClear, 'TFPHashObjectListTests');
+  AddTest('TestIndexOf', @TFPHashObjectList_TestIndexOf, 'TFPHashObjectListTests');
+  AddTest('TestRemove', @TFPHashObjectList_TestRemove, 'TFPHashObjectListTests');
+  AddTest('TestOwnsObjects', @TFPHashObjectList_TestOwnsObjects, 'TFPHashObjectListTests');
+  AddTest('TestFind', @TFPHashObjectList_TestFind, 'TFPHashObjectListTests');
+  AddTest('TestFindIndexOf', @TFPHashObjectList_TestFindIndexOf, 'TFPHashObjectListTests');
+end;
+
+end.

+ 191 - 0
packages/fcl-base/tests/utcfpobjecthashtable.pp

@@ -0,0 +1,191 @@
+unit utcFPObjectHashTable;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, contnrs, punit;
+
+procedure RegisterTests;
+
+implementation
+
+type
+  TMyObject = class(TObject)
+    IsFreed: ^Boolean;
+    destructor Destroy; override;
+  end;
+
+destructor TMyObject.Destroy;
+begin
+  if Assigned(IsFreed) then
+    IsFreed^ := True;
+  inherited Destroy;
+end;
+
+Function TFPObjectHashTable_TestCreate : TTestString;
+var
+  HT: TFPObjectHashTable;
+begin
+  Result:='';
+  HT := TFPObjectHashTable.Create;
+  try
+    AssertNotNull('Hash table should be created', HT);
+    AssertEquals('Count should be 0 on creation', 0, HT.Count);
+    AssertTrue('IsEmpty should be true on creation', HT.IsEmpty);
+    AssertTrue('OwnsObjects should be true by default', HT.OwnsObjects);
+  finally
+    HT.Free;
+  end;
+end;
+
+Function TFPObjectHashTable_TestAdd : TTestString;
+var
+  HT: TFPObjectHashTable;
+  O1, O2: TObject;
+begin
+  Result:='';
+  HT := TFPObjectHashTable.Create(False);
+  try
+    O1 := TObject.Create;
+    O2 := TObject.Create;
+    HT.Add('Key1', O1);
+    AssertEquals('Count should be 1 after adding one item', 1, HT.Count);
+    AssertFalse('IsEmpty should be false after adding an item', HT.IsEmpty);
+    AssertSame('Items property should return correct value', O1, HT.Items['Key1']);
+
+    HT.Add('Key2', O2);
+    AssertEquals('Count should be 2 after adding a second item', 2, HT.Count);
+    AssertSame('Items property should return correct value for second item', O2, HT.Items['Key2']);
+  finally
+    HT.Free;
+    O1.Free;
+    O2.Free;
+  end;
+end;
+
+Function TFPObjectHashTable_TestDelete : TTestString;
+var
+  HT: TFPObjectHashTable;
+  O1, O2: TObject;
+begin
+  Result:='';
+  HT := TFPObjectHashTable.Create(False);
+  try
+    O1 := TObject.Create;
+    O2 := TObject.Create;
+    HT.Add('Key1', O1);
+    HT.Add('Key2', O2);
+    HT.Delete('Key1');
+    AssertEquals('Count should be 1 after deleting an item', 1, HT.Count);
+    AssertNull('Accessing deleted key should return nil', HT.Items['Key1']);
+    AssertSame('Other item should still exist', O2, HT.Items['Key2']);
+  finally
+    HT.Free;
+    O1.Free;
+    O2.Free;
+  end;
+end;
+
+Function TFPObjectHashTable_TestClear : TTestString;
+var
+  HT: TFPObjectHashTable;
+  O1, O2: TObject;
+begin
+  Result:='';
+  HT := TFPObjectHashTable.Create(False);
+  try
+    O1 := TObject.Create;
+    O2 := TObject.Create;
+    HT.Add('Key1', O1);
+    HT.Add('Key2', O2);
+    HT.Clear;
+    AssertEquals('Count should be 0 after clearing', 0, HT.Count);
+    AssertTrue('IsEmpty should be true after clearing', HT.IsEmpty);
+  finally
+    HT.Free;
+    O1.Free;
+    O2.Free;
+  end;
+end;
+
+Function TFPObjectHashTable_TestItemsProperty : TTestString;
+var
+  HT: TFPObjectHashTable;
+  O1, O2: TObject;
+begin
+  Result:='';
+  HT := TFPObjectHashTable.Create(False);
+  try
+    O1 := TObject.Create;
+    O2 := TObject.Create;
+    HT.Items['Key1'] := O1;
+    AssertEquals('Count should be 1 after setting item', 1, HT.Count);
+    AssertSame('Items property should return correct value', O1, HT.Items['Key1']);
+    HT.Items['Key1'] := O2;
+    AssertEquals('Count should still be 1 after updating item', 1, HT.Count);
+    AssertSame('Items property should return updated value', O2, HT.Items['Key1']);
+  finally
+    HT.Free;
+    O1.Free;
+    O2.Free;
+  end;
+end;
+
+Function TFPObjectHashTable_TestFind : TTestString;
+var
+  HT: TFPObjectHashTable;
+  O1: TObject;
+  Node: THTCustomNode;
+begin
+  Result:='';
+  HT := TFPObjectHashTable.Create(False);
+  try
+    O1 := TObject.Create;
+    HT.Add('Key1', O1);
+    Node := HT.Find('Key1');
+    AssertNotNull('Find should return a node for an existing key', Node);
+    if Node <> nil then
+    begin
+      AssertEquals('Node should have the correct key', 'Key1', Node.Key);
+      AssertSame('Node data should be correct', O1, THTObjectNode(Node).Data);
+    end;
+
+    Node := HT.Find('NonExistentKey');
+    AssertNull('Find should return nil for a non-existent key', Node);
+  finally
+    HT.Free;
+    O1.Free;
+  end;
+end;
+
+Function TFPObjectHashTable_TestOwnsObjects : TTestString;
+var
+  HT: TFPObjectHashTable;
+  O1: TMyObject;
+  Freed: Boolean;
+begin
+  Result:='';
+  HT := TFPObjectHashTable.Create(True);
+  Freed := False;
+  O1 := TMyObject.Create;
+  O1.IsFreed := @Freed;
+  HT.Add('Key1', O1);
+  HT.Free; // This should free O1 as well
+  AssertTrue('Object should be freed when OwnsObjects is true and hash table is freed', Freed);
+end;
+
+procedure RegisterTests;
+begin
+  AddSuite('TFPObjectHashTableTests');
+  AddTest('TestCreate', @TFPObjectHashTable_TestCreate, 'TFPObjectHashTableTests');
+  AddTest('TestAdd', @TFPObjectHashTable_TestAdd, 'TFPObjectHashTableTests');
+  AddTest('TestDelete', @TFPObjectHashTable_TestDelete, 'TFPObjectHashTableTests');
+  AddTest('TestClear', @TFPObjectHashTable_TestClear, 'TFPObjectHashTableTests');
+  AddTest('TestItemsProperty', @TFPObjectHashTable_TestItemsProperty, 'TFPObjectHashTableTests');
+  AddTest('TestFind', @TFPObjectHashTable_TestFind, 'TFPObjectHashTableTests');
+  AddTest('TestOwnsObjects', @TFPObjectHashTable_TestOwnsObjects, 'TFPObjectHashTableTests');
+end;
+
+end.

+ 185 - 0
packages/fcl-base/tests/utcfpobjectlist.pp

@@ -0,0 +1,185 @@
+unit utcfpobjectlist;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, contnrs, punit;
+
+procedure RegisterTests;
+
+implementation
+
+type
+  TMyObject = class(TObject)
+    IsFreed: ^Boolean;
+    destructor Destroy; override;
+  end;
+
+destructor TMyObject.Destroy;
+begin
+  if Assigned(IsFreed) then
+    IsFreed^ := True;
+  inherited Destroy;
+end;
+
+Function TFPObjectList_TestCreate : TTestString;
+var
+  L: TFPObjectList;
+begin
+  Result:='';
+  L := TFPObjectList.Create;
+  try
+    AssertNotNull('List should be created', L);
+    AssertEquals('Count should be 0 on creation', 0, L.Count);
+    AssertTrue('OwnsObjects should be true by default', L.OwnsObjects);
+  finally
+    L.Free;
+  end;
+end;
+
+Function TFPObjectList_TestAdd : TTestString;
+var
+  L: TFPObjectList;
+  O1, O2: TObject;
+begin
+  Result:='';
+  L := TFPObjectList.Create(False);
+  try
+    O1 := TObject.Create;
+    O2 := TObject.Create;
+    L.Add(O1);
+    AssertEquals('Count should be 1 after adding one object', 1, L.Count);
+    AssertSame('First item should be O1', O1, L.Items[0]);
+    L.Add(O2);
+    AssertEquals('Count should be 2 after adding a second object', 2, L.Count);
+    AssertSame('Second item should be O2', O2, L.Items[1]);
+  finally
+    L.Free;
+    O1.Free;
+    O2.Free;
+  end;
+end;
+
+Function TFPObjectList_TestDelete : TTestString;
+var
+  L: TFPObjectList;
+  O1, O2: TObject;
+begin
+  Result:='';
+  L := TFPObjectList.Create(False);
+  try
+    O1 := TObject.Create;
+    O2 := TObject.Create;
+    L.Add(O1);
+    L.Add(O2);
+    L.Delete(0);
+    AssertEquals('Count should be 1 after deleting an object', 1, L.Count);
+    AssertSame('First item should now be O2', O2, L.Items[0]);
+  finally
+    L.Free;
+    O1.Free;
+    O2.Free;
+  end;
+end;
+
+Function TFPObjectList_TestClear : TTestString;
+var
+  L: TFPObjectList;
+  O1, O2: TObject;
+begin
+  Result:='';
+  L := TFPObjectList.Create(False);
+  try
+    O1 := TObject.Create;
+    O2 := TObject.Create;
+    L.Add(O1);
+    L.Add(O2);
+    L.Clear;
+    AssertEquals('Count should be 0 after clearing the list', 0, L.Count);
+  finally
+    L.Free;
+    O1.Free;
+    O2.Free;
+  end;
+end;
+
+Function TFPObjectList_TestIndexOf : TTestString;
+var
+  L: TFPObjectList;
+  O1, O2, O3: TObject;
+begin
+  Result:='';
+  L := TFPObjectList.Create(False);
+  O3 := TObject.Create;
+  try
+    O1 := TObject.Create;
+    O2 := TObject.Create;
+    L.Add(O1);
+    L.Add(O2);
+    AssertEquals('Index of O1 should be 0', 0, L.IndexOf(O1));
+    AssertEquals('Index of O2 should be 1', 1, L.IndexOf(O2));
+    AssertEquals('Index of a non-existent object should be -1', -1, L.IndexOf(O3));
+  finally
+    L.Free;
+    O1.Free;
+    O2.Free;
+    O3.Free;
+  end;
+end;
+
+Function TFPObjectList_TestRemove : TTestString;
+var
+  L: TFPObjectList;
+  O1, O2: TObject;
+begin
+  Result:='';
+  L := TFPObjectList.Create(False);
+  try
+    O1 := TObject.Create;
+    O2 := TObject.Create;
+    try
+      L.Add(O1);
+      L.Add(O2);
+      L.Remove(O1);
+      AssertEquals('Count should be 1 after removing an object', 1, L.Count);
+      AssertSame('First item should now be O2', O2, L.Items[0]);
+    finally
+      O1.Free;
+      O2.Free;
+    end;
+  finally
+    L.Free;
+  end;
+end;
+
+Function TFPObjectList_TestOwnsObjects : TTestString;
+var
+  L: TFPObjectList;
+  O1: TMyObject;
+  Freed: Boolean;
+begin
+  Result:='';
+  L := TFPObjectList.Create(True);
+  Freed := False;
+  O1 := TMyObject.Create;
+  O1.IsFreed := @Freed;
+  L.Add(O1);
+  L.Free; // This should free O1 as well
+  AssertTrue('Object should be freed when OwnsObjects is true and list is freed', Freed);
+end;
+
+procedure RegisterTests;
+begin
+  AddSuite('TFPObjectListTests');
+  AddTest('TestCreate', @TFPObjectList_TestCreate, 'TFPObjectListTests');
+  AddTest('TestAdd', @TFPObjectList_TestAdd, 'TFPObjectListTests');
+  AddTest('TestDelete', @TFPObjectList_TestDelete, 'TFPObjectListTests');
+  AddTest('TestClear', @TFPObjectList_TestClear, 'TFPObjectListTests');
+  AddTest('TestIndexOf', @TFPObjectList_TestIndexOf, 'TFPObjectListTests');
+  AddTest('TestRemove', @TFPObjectList_TestRemove, 'TFPObjectListTests');
+  AddTest('TestOwnsObjects', @TFPObjectList_TestOwnsObjects, 'TFPObjectListTests');
+end;
+
+end.

+ 134 - 0
packages/fcl-base/tests/utcfpstringhashtable.pp

@@ -0,0 +1,134 @@
+unit utcFPStringHashTable;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, contnrs, punit;
+
+procedure RegisterTests;
+
+implementation
+
+Function TFPStringHashTable_TestCreate : TTestString;
+var
+  HT: TFPStringHashTable;
+begin
+  Result:='';
+  HT := TFPStringHashTable.Create;
+  try
+    AssertNotNull('Hash table should be created', HT);
+    AssertEquals('Count should be 0 on creation', 0, HT.Count);
+    AssertTrue('IsEmpty should be true on creation', HT.IsEmpty);
+  finally
+    HT.Free;
+  end;
+end;
+
+Function TFPStringHashTable_TestAdd : TTestString;
+var
+  HT: TFPStringHashTable;
+begin
+  Result:='';
+  HT := TFPStringHashTable.Create;
+  try
+    HT.Add('Key1', 'Value1');
+    AssertEquals('Count should be 1 after adding one item', 1, HT.Count);
+    AssertFalse('IsEmpty should be false after adding an item', HT.IsEmpty);
+    AssertEquals('Items property should return correct value', 'Value1', HT.Items['Key1']);
+
+    HT.Add('Key2', 'Value2');
+    AssertEquals('Count should be 2 after adding a second item', 2, HT.Count);
+    AssertEquals('Items property should return correct value for second item', 'Value2', HT.Items['Key2']);
+  finally
+    HT.Free;
+  end;
+end;
+
+Function TFPStringHashTable_TestDelete : TTestString;
+var
+  HT: TFPStringHashTable;
+begin
+  Result:='';
+  HT := TFPStringHashTable.Create;
+  try
+    HT.Add('Key1', 'Value1');
+    HT.Add('Key2', 'Value2');
+    HT.Delete('Key1');
+    AssertEquals('Count should be 1 after deleting an item', 1, HT.Count);
+    AssertEquals('Accessing deleted key should return empty string', '', HT.Items['Key1']);
+    AssertEquals('Other item should still exist', 'Value2', HT.Items['Key2']);
+  finally
+    HT.Free;
+  end;
+end;
+
+Function TFPStringHashTable_TestClear : TTestString;
+var
+  HT: TFPStringHashTable;
+begin
+  Result:='';
+  HT := TFPStringHashTable.Create;
+  try
+    HT.Add('Key1', 'Value1');
+    HT.Add('Key2', 'Value2');
+    HT.Clear;
+    AssertEquals('Count should be 0 after clearing', 0, HT.Count);
+    AssertTrue('IsEmpty should be true after clearing', HT.IsEmpty);
+  finally
+    HT.Free;
+  end;
+end;
+
+Function TFPStringHashTable_TestItemsProperty : TTestString;
+var
+  HT: TFPStringHashTable;
+begin
+  Result:='';
+  HT := TFPStringHashTable.Create;
+  try
+    HT.Items['Key1'] := 'Value1';
+    AssertEquals('Count should be 1 after setting item', 1, HT.Count);
+    AssertEquals('Items property should return correct value', 'Value1', HT.Items['Key1']);
+    HT.Items['Key1'] := 'NewValue1';
+    AssertEquals('Count should still be 1 after updating item', 1, HT.Count);
+    AssertEquals('Items property should return updated value', 'NewValue1', HT.Items['Key1']);
+  finally
+    HT.Free;
+  end;
+end;
+
+Function TFPStringHashTable_TestFind : TTestString;
+var
+  HT: TFPStringHashTable;
+  Node: THTCustomNode;
+begin
+  Result:='';
+  HT := TFPStringHashTable.Create;
+  try
+    HT.Add('Key1', 'Value1');
+    Node := HT.Find('Key1');
+    AssertNotNull('Find should return a node for an existing key', Node);
+    if Node <> nil then
+      AssertEquals('Node should have the correct key', 'Key1', Node.Key);
+
+    Node := HT.Find('NonExistentKey');
+    AssertNull('Find should return nil for a non-existent key', Node);
+  finally
+    HT.Free;
+  end;
+end;
+
+procedure RegisterTests;
+begin
+  AddSuite('TFPStringHashTableTests');
+  AddTest('TestCreate', @TFPStringHashTable_TestCreate, 'TFPStringHashTableTests');
+  AddTest('TestAdd', @TFPStringHashTable_TestAdd, 'TFPStringHashTableTests');
+  AddTest('TestDelete', @TFPStringHashTable_TestDelete, 'TFPStringHashTableTests');
+  AddTest('TestClear', @TFPStringHashTable_TestClear, 'TFPStringHashTableTests');
+  AddTest('TestItemsProperty', @TFPStringHashTable_TestItemsProperty, 'TFPStringHashTableTests');
+  AddTest('TestFind', @TFPStringHashTable_TestFind, 'TFPStringHashTableTests');
+end;
+
+end.

+ 206 - 0
packages/fcl-base/tests/utcfptemplate.pp

@@ -0,0 +1,206 @@
+unit utcFPTemplate;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, punit, fpTemplate;
+
+procedure RegisterTests;
+
+implementation
+
+type
+  TTestCallbacks = class(TObject)
+  public
+    procedure TestAllowTagParamsBasics_replacetag(Sender : TObject; Const TagString : String; TagParams:TStringList; Out ReplaceText : String);
+    procedure TestAllowTagParamsFunctionLike_replacetag(Sender : TObject; Const TagString : String; TagParams:TStringList; Out ReplaceText : String);
+    procedure TestAllowTagParamsDelphiStyle_replacetag(Sender : TObject; Const TagString : String; TagParams:TStringList; Out ReplaceText : String);
+  end;
+
+var
+  Callbacks: TTestCallbacks;
+
+function SuiteSetup: TTestString;
+begin
+  Result := '';
+  Callbacks := TTestCallbacks.Create;
+end;
+
+function SuiteTearDown: TTestString;
+begin
+  Result := '';
+  Callbacks.Free;
+end;
+
+procedure TTestCallbacks.TestAllowTagParamsBasics_replacetag(
+  Sender: TObject; const TagString: String; TagParams: TStringList; out
+  ReplaceText: String);
+begin
+  if TagString='test' then
+    begin
+    AssertEquals('Callback basics: Param count', 1, TagParams.Count);
+    AssertEquals('Callback basics: Param name', 'param1', TagParams.Names[0]);
+    AssertEquals('Callback basics: Param value', 'test ', TagParams.ValueFromIndex[0]);
+    ReplaceText := 'template'
+    end
+  else if TagString='dream' then ReplaceText := 'think';
+end;
+
+procedure TTestCallbacks.TestAllowTagParamsFunctionLike_replacetag(
+  Sender: TObject; const TagString: String; TagParams: TStringList; out
+  ReplaceText: String);
+begin
+  if TagString='uppercase' then
+    begin
+    AssertEquals('Callback function-like: Param count', 1, TagParams.Count);
+    ReplaceText:=UpperCase(TagParams[0]);
+    end;
+end;
+
+procedure TTestCallbacks.TestAllowTagParamsDelphiStyle_replacetag(
+  Sender: TObject; const TagString: String; TagParams: TStringList; out
+  ReplaceText: String);
+begin
+  AssertEquals('Callback delphi-style: Param count', 2, TagParams.Count);
+  AssertEquals('Callback delphi-style: Param 1 name', 'param1', TagParams.Names[0]);
+  AssertEquals('Callback delphi-style: Param 1 value', 'first param', TagParams.ValueFromIndex[0]);
+  AssertEquals('Callback delphi-style: Param 2 name', 'param2', TagParams.Names[1]);
+  AssertEquals('Callback delphi-style: Param 2 value', 'second param', TagParams.ValueFromIndex[1]);
+  ReplaceText := 'Delphi parameter'
+end;
+
+Function TFPtemplate_TestBasics : TTestString;
+var
+  templ: TTemplateParser;
+begin
+  Result:='';
+  templ := TTemplateParser.Create;
+  try
+    templ.Values['dream'] := 'think';
+    templ.Values['test'] := 'template';
+    AssertEquals('TestBasics simple replace', 'This is the simplest template I could think of.',
+                 templ.ParseString('This is the simplest {test} I could {dream} of.'));
+
+    templ.recursive := true;
+    templ.Values['val2'] := 'template';
+    templ.Values['test'] := '{val2} test';
+    AssertEquals('TestBasics recursive replace', 'This is the simplest template test I could think of.',
+               templ.ParseString('This is the simplest {test} I could {dream} of.'));
+
+  finally
+    templ.free;
+  end;
+end;
+
+Function TFPtemplate_TestBasicDelimiters : TTestString;
+var
+  templ: TTemplateParser;
+begin
+  Result:='';
+  templ := TTemplateParser.Create;
+  try
+    templ.StartDelimiter:='[-';
+    templ.EndDelimiter:=')';
+    templ.Values['dream'] := 'think';
+    templ.Values['test'] := 'template';
+    AssertEquals('TestBasicDelimiters custom 1', 'This is [the] simplest template I could think (of).',
+                 templ.ParseString('This is [the] simplest [-test) I could [-dream) (of).'));
+
+
+    templ.StartDelimiter:='(';
+    templ.EndDelimiter:='-)';
+    templ.Values['dream'] := 'think';
+    templ.Values['test'] := 'template';
+    AssertEquals('TestBasicDelimiters custom 2', 'This is [the] simplest template I could think of:-).',
+                 templ.ParseString('This is [the] simplest (test-) I could (dream-) of:-).'));
+
+
+  finally
+    templ.free;
+  end;
+end;
+
+Function TFPtemplate_TestAllowTagParamsBasics : TTestString;
+var
+  templ: TTemplateParser;
+begin
+  Result:='';
+  templ := TTemplateParser.Create;
+  try
+    templ.AllowTagParams := true;
+    templ.OnReplaceTag := @Callbacks.TestAllowTagParamsBasics_replacetag;
+    AssertEquals('TestAllowTagParamsBasics 1', 'This is the simplest template I could think of.',
+                 templ.ParseString('This is the simplest {test [- param1=test -]} I could {dream} of.'));
+
+    AssertEquals('TestAllowTagParamsBasics 2', 'This is the simplest template I could think of.',
+                 templ.ParseString('This is the simplest {test[- param1=test -]} I could {dream} of.'));
+
+    templ.ParamValueSeparator:=':';
+    AssertEquals('TestAllowTagParamsBasics 3', 'This is the simplest template I could think of.',
+                 templ.ParseString('This is the simplest {test [- param1:test -]} I could {dream} of.'));
+
+    AssertEquals('TestAllowTagParamsBasics 4', 'This is the simplest template I could think of.',
+                 templ.ParseString('This is the simplest {test [-param1:test -]} I could {dream} of.'));
+
+    AssertEquals('TestAllowTagParamsBasics 5', 'This is the simplest template I could think of.',
+                 templ.ParseString('This is the simplest {test  [-param1:test -]} I could {dream} of.'));
+
+  finally
+    templ.free;
+  end;
+end;
+
+Function TFPtemplate_TestAllowTagParamsFunctionLike : TTestString;
+var
+  templ: TTemplateParser;
+begin
+  Result:='';
+  templ := TTemplateParser.Create;
+  try
+    templ.AllowTagParams := true;
+    templ.ParamStartDelimiter:='(';
+    templ.ParamEndDelimiter:=')';
+    templ.OnReplaceTag := @Callbacks.TestAllowTagParamsFunctionLike_replacetag;
+
+    AssertEquals('TestAllowTagParamsFunctionLike', 'THIS should be uppercased.',
+                 templ.ParseString('{uppercase(This)} should be uppercased.'));
+  finally
+    templ.free;
+  end;
+end;
+
+Function TFPtemplate_TestAllowTagParamsDelphiStyle : TTestString;
+var
+  templ: TTemplateParser;
+begin
+  Result:='';
+  templ := TTemplateParser.Create;
+  try
+    templ.AllowTagParams := true;
+    templ.StartDelimiter:='<#';
+    templ.EndDelimiter:='>';
+    templ.ParamStartDelimiter:=' ';
+    templ.ParamEndDelimiter:='"';
+    templ.ParamValueSeparator:='="';
+    templ.OnReplaceTag := @Callbacks.TestAllowTagParamsDelphiStyle_replacetag;
+
+    AssertEquals('TestAllowTagParamsDelphiStyle', 'Test for a Delphi parameter.',
+                 templ.ParseString('Test for a <#DelphiTag param1="first param" param2="second param">.'));
+  finally
+    templ.free;
+  end;
+end;
+
+procedure RegisterTests;
+begin
+  AddSuite('TFPtemplateTests', @SuiteSetup, @SuiteTearDown);
+  AddTest('TestBasics', @TFPtemplate_TestBasics, 'TFPtemplateTests');
+  AddTest('TestBasicDelimiters', @TFPtemplate_TestBasicDelimiters, 'TFPtemplateTests');
+  AddTest('TestAllowTagParamsBasics', @TFPtemplate_TestAllowTagParamsBasics, 'TFPtemplateTests');
+  AddTest('TestAllowTagParamsFunctionLike', @TFPtemplate_TestAllowTagParamsFunctionLike, 'TFPtemplateTests');
+  AddTest('TestAllowTagParamsDelphiStyle', @TFPtemplate_TestAllowTagParamsDelphiStyle, 'TFPtemplateTests');
+end;
+
+end.

+ 113 - 0
packages/fcl-base/tests/utcinifile.pp

@@ -0,0 +1,113 @@
+unit utcIniFile;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, punit, inifiles;
+
+procedure RegisterTests;
+
+implementation
+
+var
+  Fini: TCustomIniFile;
+
+function Setup: TTestString;
+begin
+  Result := '';
+  if Assigned(Fini) then
+    Fini.Free;
+  Fini := nil;
+  if FileExists('tmp.ini') then
+    DeleteFile('tmp.ini');
+  try
+    Fini := TMemIniFile.Create('tmp.ini');
+  except
+    on E: Exception do
+      Result := 'Setup failed: ' + E.Message;
+  end;
+end;
+
+function TearDown: TTestString;
+begin
+  Result := '';
+  if Assigned(Fini) then
+    Fini.Free;
+  Fini := nil;
+  if FileExists('tmp.ini') then
+    DeleteFile('tmp.ini');
+end;
+
+function TIniFile_TestWriteBoolean: TTestString;
+begin
+  Result := '';
+  AssertNotNull('Ini object should be created', Fini);
+  if not Assigned(Fini) then Exit;
+
+  Fini.WriteBool('a','b',true);
+  AssertEquals('Default true','1',Fini.ReadString('a','b',''));
+  Fini.WriteBool('a','b',False);
+  AssertEquals('Default false','0',Fini.ReadString('a','b',''));
+  Fini.Options:=Fini.Options+[ifoWriteStringBoolean];
+  Fini.WriteBool('a','b',true);
+  AssertEquals('Default string true','true',Fini.ReadString('a','b',''));
+  Fini.WriteBool('a','b',false);
+  AssertEquals('Default string false','false',Fini.ReadString('a','b',''));
+  Fini.SetBoolStringValues(true,['t','true']);
+  Fini.WriteBool('a','b',true);
+  AssertEquals('True from string array','t',Fini.ReadString('a','b',''));
+  Fini.SetBoolStringValues(false,['f','false']);
+  Fini.WriteBool('a','b',false);
+  AssertEquals('False from string array','f',Fini.ReadString('a','b',''));
+end;
+
+function TIniFile_TestReadBoolean: TTestString;
+begin
+  Result := '';
+  AssertNotNull('Ini object should be created', Fini);
+  if not Assigned(Fini) then Exit;
+
+  Fini.WriteString('a','b','1');
+  AssertEquals('Default true',true,Fini.ReadBool('a','b',False));
+  Fini.WriteString('a','b','0');
+  AssertEquals('Default false',false,Fini.ReadBool('a','b',True));
+  Fini.WriteString('a','b','');
+  AssertEquals('Empty returns Default ',true,Fini.ReadBool('a','b',true));
+  Fini.SetBoolStringValues(true,['t','true']);
+  Fini.WriteString('a','b','t');
+  AssertEquals('First string match',true,Fini.ReadBool('a','b',false));
+  Fini.WriteString('a','b','true');
+  AssertEquals('Second string match',true,Fini.ReadBool('a','b',false));
+  Fini.WriteString('a','b','d');
+  AssertEquals('No string match, default',true,Fini.ReadBool('a','b',true));
+  Fini.SetBoolStringValues(true,[]);
+  Fini.SetBoolStringValues(false,['f','false']);
+  Fini.WriteString('a','b','f');
+  AssertEquals('First string match false',false,Fini.ReadBool('a','b',true));
+  Fini.WriteString('a','b','false');
+  AssertEquals('Second string match false',false,Fini.ReadBool('a','b',true));
+  Fini.WriteString('a','b','d');
+  AssertEquals('No string match, default false',false,Fini.ReadBool('a','b',false));
+  Fini.SetBoolStringValues(true,['t','true']);
+  AssertEquals('No string match, default false 2',false,Fini.ReadBool('a','b',false));
+  Fini.SetBoolStringValues(true,[]);
+  Fini.SetBoolStringValues(False,[]);
+  Fini.Options:=Fini.Options+[ifoWriteStringBoolean];
+  Fini.WriteString('a','b','true');
+  AssertEquals('ifoWriteStringBoolean, true string ',True,Fini.ReadBool('a','b',false));
+  Fini.WriteString('a','b','false');
+  AssertEquals('ifoWriteStringBoolean, false string',false,Fini.ReadBool('a','b',true));
+  Fini.WriteString('a','b','soso');
+  AssertEquals('ifoWriteStringBoolean, No string match, default',True,Fini.ReadBool('a','b',true));
+end;
+
+procedure RegisterTests;
+begin
+  AddSuite('TIniFileTests', @Setup, @TearDown, Nil, True);
+  AddTest('TestWriteBoolean', @TIniFile_TestWriteBoolean, 'TIniFileTests');
+  AddTest('TestReadBoolean', @TIniFile_TestReadBoolean, 'TIniFileTests');
+end;
+
+end.

+ 250 - 0
packages/fcl-base/tests/utcinterlocked.pp

@@ -0,0 +1,250 @@
+unit utcinterlocked;
+
+{$mode Objfpc}
+
+interface
+
+uses punit;
+
+Procedure RegisterTests;
+
+implementation
+
+uses
+  SysUtils, SyncObjs, Classes;
+
+function testlongint : TTestString;
+
+var
+  i32: Longint;
+  New32, Old32: Longint;
+  changed : Boolean;
+
+begin
+  Result:='';
+
+  {* test all kinds of Longint usage *}
+  i32 := 12;
+  New32 := TInterlocked.Increment(i32);
+  if New32 <> 13 then Exit('Error 1');
+  if i32 <> 13 then Exit('Error 2');
+
+  New32 := TInterlocked.Decrement(i32);
+  if New32 <> 12 then Exit('Error 3');
+  if i32 <> 12 then Exit('Error 4');
+
+  New32 := TInterlocked.Add(i32, 12);
+  if New32 <> 24 then Exit('Error 5');
+  if i32 <> 24 then Exit('Error 6');
+
+  Old32 := TInterlocked.CompareExchange(i32, 36, 24);
+  if Old32 <> 24 then Exit('Error 7');
+  if i32 <> 36 then Exit('Error 8');
+
+  Old32 := TInterlocked.CompareExchange(i32, 48, 36, Changed);
+  if Old32 <> 36 then Exit('Error 9');
+  if Changed <> True then Exit('Error 10');
+  if i32 <> 48 then Exit('Error 11');
+
+  Old32 := TInterlocked.CompareExchange(i32, 123, 96, Changed);
+  if Old32 <> 48 then Exit('Error 12');
+  if Changed <> False then Exit('Error 13');
+  if i32 <> 48 then Exit('Error 14');
+
+  Old32 := TInterlocked.Exchange(i32, 96);
+  if Old32 <> 48 then Exit('Error 15');
+  if i32 <> 96 then Exit('Error 15');
+end;
+
+Function TestSingle : TTestString;
+
+var
+  s1, s2, sOld: Single;
+begin
+  Result:='';
+  {* test all kinds of Single usage *}
+  s1 := Single(3.14);
+  s2 := Single(6.28);
+  sOld := TInterlocked.CompareExchange(s1, s2, s1);
+  if sOld <> Single(3.14) then Exit('Error 53');
+  if s1 = Single(3.14) then Exit('Error 54');
+  if s1 <> s2 then Exit('Error 55');
+
+  sOld := TInterlocked.CompareExchange(s1, sOld, s2);
+  if sOld <> Single(6.28) then Exit('Error 56');
+  if s1 <> Single(3.14) then Exit('Error 57');
+  if s1 = s2 then Exit('Error 58');
+
+  sOld := TInterlocked.Exchange(s2, s1);
+  if sOld <> Single(6.28) then Exit('Error 59');
+  if s1 <> Single(3.14) then Exit('Error 60');
+  if s1 <> s2 then Exit('Error 61');
+end;
+
+{$ifdef cpu64}
+function testint64 : TTestString;
+var
+  i64: Int64;
+  New64, Old64: Int64;
+begin
+
+  {* test all kinds of Int64 usage *}
+  i64 := 12;
+  New64 := TInterlocked.Increment(i64);
+  if New64 <> 13 then Exit('Error 20');
+  if i64 <> 13 then Exit('Error 21');
+
+  New64 := TInterlocked.Decrement(i64);
+  if New64 <> 12 then Exit('Error 22');
+  if i64 <> 12 then Exit('Error 23');
+
+  New64 := TInterlocked.Add(i64, 12);
+  if New64 <> 24 then Exit('Error 24');
+  if i64 <> 24 then Exit('Error 25');
+
+  Old64 := TInterlocked.CompareExchange(i64, 36, 24);
+  if Old64 <> 24 then Exit('Error 26');
+  if i64 <> 36 then Exit('Error 27');
+
+  Old64 := TInterlocked.Exchange(i64, 48);
+  if Old64 <> 36 then Exit('Error 28');
+  if i64 <> 48 then Exit('Error 29');
+
+  Old64 := TInterlocked.Read(i64);
+  if Old64 <> 48 then Exit('Error 30');
+  if i64 <> 48 then Exit('Error 31');
+end;
+
+Function TestDouble : TTestString;
+
+var
+  d1, d2, dOld: Double;
+begin
+  Result:='';
+  {* test all kinds of Double usage *}
+  d1 := Double(3.14);
+  d2 := Double(6.28);
+  dOld := TInterlocked.CompareExchange(d1, d2, d1);
+  if dOld <> Double(3.14) then Exit('Error 44');
+  if d1 = Double(3.14) then Exit('Error 45');
+  if d1 <> d2 then Exit('Error 46');
+
+  d1 := dOld;
+  dOld := TInterlocked.Exchange(d1, d2);
+  if dOld <> Double(3.14) then Exit('Error 47');
+  if d1 <> Double(6.28) then Exit('Error 48');
+  if d1 <> d2 then Exit('Error 49');
+
+  dOld := TInterlocked.CompareExchange(d1, dOld, d2);
+  if dOld <> Double(6.28) then Exit('Error 50');
+  if d1 <> Double(3.14) then Exit('Error 51');
+  if d1 = d2 then Exit('Error 52');
+end;
+
+{$endif}
+
+function TestObject : TTeststring;
+var
+  list1, list2, oldlist: TStringList;
+begin
+  Result:='';
+  {* test all kinds of TObject and generic class usage *}
+  List2:=nil;
+  list1 := TStringList.Create;
+  try
+    list2 := TStringList.Create;
+    list1.Add('A');
+    list2.Add('B');
+    list2.Add('C');
+
+    { TObject }
+    oldlist := TStringList(TInterlocked.CompareExchange(TObject(list1), TObject(list2), TObject(list1)));
+    if list1 <> list2 then Exit('Error 32');
+    if oldlist.Count = list1.Count then Exit('Error 33');
+    if oldlist.Count = list2.Count then Exit('Error 34');
+
+    oldlist := TStringList(TInterlocked.Exchange(TObject(list1), TObject(oldlist)));
+    if oldlist <> list2 then Exit('Error 35');
+    if list1.Count <> 1 then Exit('Error 36');
+    if list2.Count <> 2 then Exit('Error 37');
+  finally
+    list1.Free;
+    list2.Free;
+  end;
+end;
+
+function TestGeneric : TTeststring;
+
+var
+  list1, list2, oldlist: TStringList;
+begin
+  Result:='';
+  List2:=nil;
+  list1 := TStringList.Create;
+  try
+    list2 := TStringList.Create;
+    list1.Add('A');
+    list2.Add('B');
+    list2.Add('C');
+    { generic class }
+    oldlist := TInterlocked.specialize CompareExchange<TStringList>(list1, list2, list1);
+    if list1 <> list2 then Exit('Error 38');
+    if oldlist.Count = list1.Count then Exit('Error 39');
+    if oldlist.Count = list2.Count then Exit('Error 40');
+
+    oldlist := TInterlocked.specialize Exchange<TStringList>(list1, oldlist);
+    if oldlist <> list2 then Exit('Error 41');
+    if list1.Count <> 1 then Exit('Error 42');
+    if list2.Count <> 2 then Exit('Error 43');
+  finally
+    list1.Free;
+    list2.Free;
+  end;
+end;
+
+Function TestBitTestAndClear : TTestString;
+var
+    i32: Longint;
+    New32, Old32: Longint;
+    i64: Int64;
+    New64, Old64: Int64;
+    Changed, OldBitValue: Boolean;
+    list1, list2, oldlist: TStringList;
+    d1, d2, dOld: Double;
+    s1, s2, sOld: Single;
+begin
+  {* test BitTestAndClear usage *}
+  i32 := 96;
+  OldBitValue := TInterlocked.BitTestAndClear(i32, 6);
+  if OldBitValue <> True then Exit('Error 62');
+  if i32 <> 32 then Exit('Error 63');
+  OldBitValue := TInterlocked.BitTestAndClear(i32, 6);
+  if OldBitValue <> False then Exit('Error 64');
+  if i32 <> 32 then Exit('Error 65');
+
+  {* test BitTestAndSet usage *}
+  OldBitValue := TInterlocked.BitTestAndSet(i32, 6);
+  if OldBitValue <> False then Exit('Error 66');
+  if i32 <> 96 then Exit('Error 67');
+  OldBitValue := TInterlocked.BitTestAndSet(i32, 6);
+  if OldBitValue <> True then Exit('Error 68');
+  if i32 <> 96 then Exit('Error 69');
+end;
+
+Procedure RegisterTests;
+var
+  lSuite : PSuite;
+begin
+  lSuite:=AddSuite('TInterlocked');
+  AddTest('Longint',@TestLongint,lSuite);
+  {$IFDEF CPU64}
+  AddTest('Int64',@TestInt64,lSuite);
+  AddTest('Double',@TestDouble,lSuite);
+  {$ENDIF}
+  AddTest('Single',@TestSingle,lSuite);
+  AddTest('Object',@TestObject,lSuite);
+  AddTest('Generic',@TestGeneric,lSuite);
+  AddTest('BitTestAndClear',@TestBitTestAndClear,lSuite);
+end;
+
+end.

+ 12 - 13
packages/fcl-base/tests/utclzw.pas

@@ -1,20 +1,13 @@
-unit utclzw;
+unit utcLZW;
 
 {$mode ObjFPC}{$H+}
 
 interface
 
 uses
-  Classes, SysUtils, fpcunit, testregistry, lzwstream;
+  Classes, SysUtils, punit, lzwstream;
 
-Type
-
-  { TTestLZW }
-
-  TTestLZW = CLass(TTestCase)
-  Published
-    Procedure TestFileC;
-  end;
+Procedure RegisterTests;
 
 implementation
 
@@ -24,7 +17,7 @@ implementation
 {$i filed.inc}
 
 
-procedure TTestLZW.TestFileC;
+function TestFileC : TTestString;
 
 Var
   Z : TLZWDecompressionStream;
@@ -33,6 +26,7 @@ Var
   I,R : Integer;
 
 begin
+  result:='';
   D:=Nil;
   Z:=Nil;
   C:=TBytesStream.Create([]);
@@ -57,7 +51,12 @@ begin
 
 end;
 
-initialization
-  RegisterTest(TTestLZW);
+procedure RegisterTests;
+
+begin
+  AddSuite('TTestLZW');
+  AddTest('TestFileC', @TestFileC, 'TTestLZW');
+end;
+
 end.
 

+ 40 - 0
packages/fcl-base/tests/utcmaskutils.pp

@@ -0,0 +1,40 @@
+unit utcMaskUtils;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, punit, maskutils;
+
+procedure RegisterTests;
+
+implementation
+
+function TMaskUtils_Test1: TTestString;
+begin
+  Result := '';
+  AssertEquals('Test1', 'H1H357-K808K-44616-YK8720', FormatMaskText('!>cccccc\-ccccc\-ccccc\-cccccc;0;*', 'H1H357K808K44616YK8720'));
+end;
+
+function TMaskUtils_Test2: TTestString;
+begin
+  Result := '';
+  AssertEquals('Test2', '555.   .   .   ', FormatMaskText('999.999.999.999', '555555'));
+end;
+
+function TMaskUtils_Test3: TTestString;
+begin
+  Result := '';
+  AssertEquals('Test3', '555.   .   .   ', FormatMaskText('999.999.999.999;1;_', '555555'));
+end;
+
+procedure RegisterTests;
+begin
+  AddSuite('TMaskUtilsTests');
+  AddTest('Test1', @TMaskUtils_Test1, 'TMaskUtilsTests');
+  AddTest('Test2', @TMaskUtils_Test2, 'TMaskUtilsTests');
+  AddTest('Test3', @TMaskUtils_Test3, 'TMaskUtilsTests');
+end;
+
+end.

+ 233 - 0
packages/fcl-base/tests/utcobjectlist.pp

@@ -0,0 +1,233 @@
+unit utcObjectList;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, contnrs, punit;
+
+procedure RegisterTests;
+
+implementation
+
+type
+  TMyObject = class(TObject)
+    IsFreed: ^Boolean;
+    destructor Destroy; override;
+  end;
+
+destructor TMyObject.Destroy;
+begin
+  if Assigned(IsFreed) then
+    IsFreed^ := True;
+  inherited Destroy;
+end;
+
+Function TObjectList_TestCreate : TTestString;
+var
+  L: TObjectList;
+begin
+  Result:='';
+  L := TObjectList.Create;
+  try
+    AssertNotNull('List should be created', L);
+    AssertEquals('Count should be 0 on creation', 0, L.Count);
+    AssertTrue('OwnsObjects should be true by default', L.OwnsObjects);
+  finally
+    L.Free;
+  end;
+end;
+
+Function TObjectList_TestAdd : TTestString;
+var
+  L: TObjectList;
+  O1, O2: TObject;
+begin
+  Result:='';
+  L := TObjectList.Create(False);
+  try
+    O1 := TObject.Create;
+    O2 := TObject.Create;
+    L.Add(O1);
+    AssertEquals('Count should be 1 after adding one object', 1, L.Count);
+    AssertSame('First item should be O1', O1, L.Items[0]);
+    L.Add(O2);
+    AssertEquals('Count should be 2 after adding a second object', 2, L.Count);
+    AssertSame('Second item should be O2', O2, L.Items[1]);
+  finally
+    L.Free;
+    O1.Free;
+    O2.Free;
+  end;
+end;
+
+Function TObjectList_TestExtract : TTestString;
+var
+  L: TObjectList;
+  O1, O2, Extracted: TObject;
+begin
+  Result:='';
+  L := TObjectList.Create(False);
+  try
+    O1 := TObject.Create;
+    O2 := TObject.Create;
+    L.Add(O1);
+    L.Add(O2);
+    Extracted := L.Extract(O1);
+    AssertSame('Extracted object should be O1', O1, Extracted);
+    AssertEquals('Count should be 1 after extracting an object', 1, L.Count);
+    AssertSame('First item should now be O2', O2, L.Items[0]);
+  finally
+    L.Free;
+    O1.Free;
+    O2.Free;
+  end;
+end;
+
+Function TObjectList_TestRemove : TTestString;
+var
+  L: TObjectList;
+  O1, O2: TObject;
+begin
+  Result:='';
+  L := TObjectList.Create(False);
+  try
+    O1 := TObject.Create;
+    O2 := TObject.Create;
+    L.Add(O1);
+    L.Add(O2);
+    L.Remove(O1);
+    AssertEquals('Count should be 1 after removing an object', 1, L.Count);
+    AssertSame('First item should now be O2', O2, L.Items[0]);
+  finally
+    L.Free;
+    O2.Free;
+  end;
+end;
+
+Function TObjectList_TestIndexOf : TTestString;
+var
+  L: TObjectList;
+  O1, O2, O3: TObject;
+begin
+  Result:='';
+  L := TObjectList.Create(False);
+  O3 := TObject.Create;
+  try
+    O1 := TObject.Create;
+    O2 := TObject.Create;
+    L.Add(O1);
+    L.Add(O2);
+    AssertEquals('Index of O1 should be 0', 0, L.IndexOf(O1));
+    AssertEquals('Index of O2 should be 1', 1, L.IndexOf(O2));
+    AssertEquals('Index of a non-existent object should be -1', -1, L.IndexOf(O3));
+  finally
+    L.Free;
+    O1.Free;
+    O2.Free;
+    O3.Free;
+  end;
+end;
+
+Function TObjectList_TestFindInstanceOf : TTestString;
+var
+  L: TObjectList;
+  O1: TObject;
+  C1: TMyObject;
+begin
+  Result:='';
+  L := TObjectList.Create(False);
+  try
+    O1 := TObject.Create;
+    C1 := TMyObject.Create;
+    L.Add(O1);
+    L.Add(C1);
+    AssertEquals('Find TObject exact', 0, L.FindInstanceOf(TObject, True, 0));
+    AssertEquals('Find TMyObject exact', 1, L.FindInstanceOf(TMyObject, True, 0));
+    AssertEquals('Find TObject inexact', 0, L.FindInstanceOf(TObject, False, 0));
+    AssertEquals('Find TMyObject inexact from start', 1, L.FindInstanceOf(TMyObject, False, 0));
+  finally
+    L.Free;
+    O1.Free;
+    C1.Free;
+  end;
+end;
+
+Function TObjectList_TestInsert : TTestString;
+var
+  L: TObjectList;
+  O1, O2, O3: TObject;
+begin
+  Result:='';
+  L := TObjectList.Create(False);
+  try
+    O1 := TObject.Create;
+    O2 := TObject.Create;
+    O3 := TObject.Create;
+    L.Add(O1);
+    L.Add(O2);
+    L.Insert(1, O3);
+    AssertEquals('Count should be 3 after inserting an object', 3, L.Count);
+    AssertSame('Item at index 1 should be O3', O3, L.Items[1]);
+    AssertSame('Item at index 2 should be O2', O2, L.Items[2]);
+  finally
+    L.Free;
+    O1.Free;
+    O2.Free;
+    O3.Free;
+  end;
+end;
+
+Function TObjectList_TestFirstLast : TTestString;
+var
+  L: TObjectList;
+  O1, O2: TObject;
+begin
+  Result:='';
+  L := TObjectList.Create(False);
+  try
+    O1 := TObject.Create;
+    O2 := TObject.Create;
+    L.Add(O1);
+    L.Add(O2);
+    AssertSame('First object should be O1', O1, L.First);
+    AssertSame('Last object should be O2', O2, L.Last);
+  finally
+    L.Free;
+    O1.Free;
+    O2.Free;
+  end;
+end;
+
+Function TObjectList_TestOwnsObjects : TTestString;
+var
+  L: TObjectList;
+  O1: TMyObject;
+  Freed: Boolean;
+begin
+  Result:='';
+  L := TObjectList.Create(True);
+  Freed := False;
+  O1 := TMyObject.Create;
+  O1.IsFreed := @Freed;
+  L.Add(O1);
+  L.Free; // This should free O1 as well
+  AssertTrue('Object should be freed when OwnsObjects is true and list is freed', Freed);
+end;
+
+procedure RegisterTests;
+begin
+  AddSuite('TObjectListTests');
+  AddTest('TestCreate', @TObjectList_TestCreate, 'TObjectListTests');
+  AddTest('TestAdd', @TObjectList_TestAdd, 'TObjectListTests');
+  AddTest('TestExtract', @TObjectList_TestExtract, 'TObjectListTests');
+  AddTest('TestRemove', @TObjectList_TestRemove, 'TObjectListTests');
+  AddTest('TestIndexOf', @TObjectList_TestIndexOf, 'TObjectListTests');
+  AddTest('TestFindInstanceOf', @TObjectList_TestFindInstanceOf, 'TObjectListTests');
+  AddTest('TestInsert', @TObjectList_TestInsert, 'TObjectListTests');
+  AddTest('TestFirstLast', @TObjectList_TestFirstLast, 'TObjectListTests');
+  AddTest('TestOwnsObjects', @TObjectList_TestOwnsObjects, 'TObjectListTests');
+end;
+
+end.

+ 116 - 0
packages/fcl-base/tests/utcobjectqueue.pp

@@ -0,0 +1,116 @@
+unit utcObjectQueue;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, contnrs, punit;
+
+procedure RegisterTests;
+
+implementation
+
+Function TObjectQueue_TestCreate : TTestString;
+var
+  Q: TObjectQueue;
+begin
+  Result:='';
+  Q := TObjectQueue.Create;
+  try
+    AssertNotNull('Queue should be created', Q);
+    AssertEquals('Count should be 0 on creation', 0, Q.Count);
+  finally
+    Q.Free;
+  end;
+end;
+
+Function TObjectQueue_TestPush : TTestString;
+var
+  Q: TObjectQueue;
+  O1, O2, Res: TObject;
+begin
+  Result:='';
+  Q := TObjectQueue.Create;
+  try
+    O1 := TObject.Create;
+    O2 := TObject.Create;
+    Res := Q.Push(O1);
+    AssertSame('Push should return the pushed object', O1, Res);
+    AssertEquals('Count should be 1', 1, Q.Count);
+    AssertSame('Peek should return the pushed object', O1, Q.Peek);
+    Res := Q.Push(O2);
+    AssertSame('Push should return the pushed object', O2, Res);
+    AssertEquals('Count should be 2', 2, Q.Count);
+    AssertSame('Peek should return the first pushed object', O1, Q.Peek);
+  finally
+    Q.Free;
+    O1.Free;
+    O2.Free;
+  end;
+end;
+
+Function TObjectQueue_TestPop : TTestString;
+var
+  Q: TObjectQueue;
+  O1, O2, Res: TObject;
+begin
+  Result:='';
+  Q := TObjectQueue.Create;
+  try
+    O1 := TObject.Create;
+    O2 := TObject.Create;
+    Q.Push(O1);
+    Q.Push(O2);
+    Res := Q.Pop;
+    AssertSame('Pop should return the first pushed object (FIFO)', O1, Res);
+    AssertEquals('Count should be 1', 1, Q.Count);
+    Res := Q.Pop;
+    AssertSame('Pop should return the second pushed object', O2, Res);
+    AssertEquals('Count should be 0', 0, Q.Count);
+    Res := Q.Pop;
+    AssertEquals('Pop on an empty queue should return nil', nil, Res);
+  finally
+    Q.Free;
+    O1.Free;
+    O2.Free;
+  end;
+end;
+
+Function TObjectQueue_TestPeek : TTestString;
+var
+  Q: TObjectQueue;
+  O1, O2: TObject;
+begin
+  Result:='';
+  Q := TObjectQueue.Create;
+  try
+    O1 := TObject.Create;
+    O2 := TObject.Create;
+    Q.Push(O1);
+    AssertSame('Peek should return the pushed object', O1, Q.Peek);
+    AssertEquals('Count should still be 1 after Peek', 1, Q.Count);
+    Q.Push(O2);
+    AssertSame('Peek should return the first pushed object', O1, Q.Peek);
+    AssertEquals('Count should still be 2 after Peek', 2, Q.Count);
+    Q.Pop;
+    AssertSame('Peek should return the remaining object', O2, Q.Peek);
+    Q.Pop;
+    AssertEquals('Peek on an empty queue should return nil', nil, Q.Peek);
+  finally
+    Q.Free;
+    O1.Free;
+    O2.Free;
+  end;
+end;
+
+procedure RegisterTests;
+begin
+  AddSuite('TObjectQueueTests');
+  AddTest('TestCreate', @TObjectQueue_TestCreate, 'TObjectQueueTests');
+  AddTest('TestPush', @TObjectQueue_TestPush, 'TObjectQueueTests');
+  AddTest('TestPop', @TObjectQueue_TestPop, 'TObjectQueueTests');
+  AddTest('TestPeek', @TObjectQueue_TestPeek, 'TObjectQueueTests');
+end;
+
+end.

+ 116 - 0
packages/fcl-base/tests/utcobjectstack.pp

@@ -0,0 +1,116 @@
+unit utcObjectStack;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, contnrs, punit;
+
+procedure RegisterTests;
+
+implementation
+
+Function TObjectStack_TestCreate : TTestString;
+var
+  S: TObjectStack;
+begin
+  Result:='';
+  S := TObjectStack.Create;
+  try
+    AssertNotNull('Stack should be created', S);
+    AssertEquals('Count should be 0 on creation', 0, S.Count);
+  finally
+    S.Free;
+  end;
+end;
+
+Function TObjectStack_TestPush : TTestString;
+var
+  S: TObjectStack;
+  O1, O2, Res: TObject;
+begin
+  Result:='';
+  S := TObjectStack.Create;
+  try
+    O1 := TObject.Create;
+    O2 := TObject.Create;
+    Res := S.Push(O1);
+    AssertSame('Push should return the pushed object', O1, Res);
+    AssertEquals('Count should be 1', 1, S.Count);
+    AssertSame('Peek should return the pushed object', O1, S.Peek);
+    Res := S.Push(O2);
+    AssertSame('Push should return the pushed object', O2, Res);
+    AssertEquals('Count should be 2', 2, S.Count);
+    AssertSame('Peek should return the last pushed object', O2, S.Peek);
+  finally
+    S.Free;
+    O1.Free;
+    O2.Free;
+  end;
+end;
+
+Function TObjectStack_TestPop : TTestString;
+var
+  S: TObjectStack;
+  O1, O2, Res: TObject;
+begin
+  Result:='';
+  S := TObjectStack.Create;
+  try
+    O1 := TObject.Create;
+    O2 := TObject.Create;
+    S.Push(O1);
+    S.Push(O2);
+    Res := S.Pop;
+    AssertSame('Pop should return the last pushed object (LIFO)', O2, Res);
+    AssertEquals('Count should be 1', 1, S.Count);
+    Res := S.Pop;
+    AssertSame('Pop should return the first pushed object', O1, Res);
+    AssertEquals('Count should be 0', 0, S.Count);
+    Res := S.Pop;
+    AssertEquals('Pop on an empty stack should return nil', nil, Res);
+  finally
+    S.Free;
+    O1.Free;
+    O2.Free;
+  end;
+end;
+
+Function TObjectStack_TestPeek : TTestString;
+var
+  S: TObjectStack;
+  O1, O2: TObject;
+begin
+  Result:='';
+  S := TObjectStack.Create;
+  try
+    O1 := TObject.Create;
+    O2 := TObject.Create;
+    S.Push(O1);
+    AssertSame('Peek should return the pushed object', O1, S.Peek);
+    AssertEquals('Count should still be 1 after Peek', 1, S.Count);
+    S.Push(O2);
+    AssertSame('Peek should return the last pushed object', O2, S.Peek);
+    AssertEquals('Count should still be 2 after Peek', 2, S.Count);
+    S.Pop;
+    AssertSame('Peek should return the remaining object', O1, S.Peek);
+    S.Pop;
+    AssertEquals('Peek on an empty stack should return nil', nil, S.Peek);
+  finally
+    S.Free;
+    O1.Free;
+    O2.Free;
+  end;
+end;
+
+procedure RegisterTests;
+begin
+  AddSuite('TObjectStackTests');
+  AddTest('TestCreate', @TObjectStack_TestCreate, 'TObjectStackTests');
+  AddTest('TestPush', @TObjectStack_TestPush, 'TObjectStackTests');
+  AddTest('TestPop', @TObjectStack_TestPop, 'TObjectStackTests');
+  AddTest('TestPeek', @TObjectStack_TestPeek, 'TObjectStackTests');
+end;
+
+end.

+ 163 - 0
packages/fcl-base/tests/utcorderedlist.pp

@@ -0,0 +1,163 @@
+unit utcOrderedList;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, contnrs, punit;
+
+procedure RegisterTests;
+
+implementation
+
+type
+  TConcreteOrderedList = class(TOrderedList)
+  protected
+    procedure PushItem(AItem: Pointer); override;
+  end;
+
+procedure TConcreteOrderedList.PushItem(AItem: Pointer);
+begin
+  List.Add(AItem);
+end;
+
+Function TOrderedList_TestCreate : TTestString;
+var
+  L: TConcreteOrderedList;
+begin
+  Result:='';
+  L := TConcreteOrderedList.Create;
+  try
+    AssertNotNull('List should be created', L);
+    AssertEquals('Count should be 0 on creation', 0, L.Count);
+  finally
+    L.Free;
+  end;
+end;
+
+Function TOrderedList_TestCount : TTestString;
+var
+  L: TConcreteOrderedList;
+  P: Pointer;
+begin
+  Result:='';
+  L := TConcreteOrderedList.Create;
+  try
+    AssertEquals('Count should be 0 initially', 0, L.Count);
+    P := Pointer(1);
+    L.Push(P);
+    AssertEquals('Count should be 1 after pushing one item', 1, L.Count);
+    P := Pointer(2);
+    L.Push(P);
+    AssertEquals('Count should be 2 after pushing another item', 2, L.Count);
+    L.Pop;
+    AssertEquals('Count should be 1 after popping an item', 1, L.Count);
+  finally
+    L.Free;
+  end;
+end;
+
+Function TOrderedList_TestAtLeast : TTestString;
+var
+  L: TConcreteOrderedList;
+  P: Pointer;
+begin
+  Result:='';
+  L := TConcreteOrderedList.Create;
+  try
+    AssertTrue('AtLeast(0) should be true for an empty list', L.AtLeast(0));
+    AssertFalse('AtLeast(1) should be false for an empty list', L.AtLeast(1));
+    P := Pointer(1);
+    L.Push(P);
+    AssertTrue('AtLeast(1) should be true for a list with one item', L.AtLeast(1));
+  finally
+    L.Free;
+  end;
+end;
+
+Function TOrderedList_TestPush : TTestString;
+var
+  L: TConcreteOrderedList;
+  P1, P2, Res: Pointer;
+begin
+  Result:='';
+  L := TConcreteOrderedList.Create;
+  try
+    P1 := Pointer(1);
+    P2 := Pointer(2);
+    Res := L.Push(P1);
+    AssertEquals('Push should return the pushed item', P1, Res);
+    AssertEquals('Count should be 1', 1, L.Count);
+    AssertEquals('Peek should return the pushed item', P1, L.Peek);
+    Res := L.Push(P2);
+    AssertEquals('Push should return the pushed item', P2, Res);
+    AssertEquals('Count should be 2', 2, L.Count);
+    AssertEquals('Peek should return the last pushed item', P2, L.Peek);
+  finally
+    L.Free;
+  end;
+end;
+
+Function TOrderedList_TestPop : TTestString;
+var
+  L: TConcreteOrderedList;
+  P1, P2, Res: Pointer;
+begin
+  Result:='';
+  L := TConcreteOrderedList.Create;
+  try
+    P1 := Pointer(1);
+    P2 := Pointer(2);
+    L.Push(P1);
+    L.Push(P2);
+    Res := L.Pop;
+    AssertEquals('Pop should return the last pushed item', P2, Res);
+    AssertEquals('Count should be 1', 1, L.Count);
+    Res := L.Pop;
+    AssertEquals('Pop should return the first pushed item', P1, Res);
+    AssertEquals('Count should be 0', 0, L.Count);
+    Res := L.Pop;
+    AssertEquals('Pop on an empty list should return nil', nil, Res);
+  finally
+    L.Free;
+  end;
+end;
+
+Function TOrderedList_TestPeek : TTestString;
+var
+  L: TConcreteOrderedList;
+  P1, P2: Pointer;
+begin
+  Result:='';
+  L := TConcreteOrderedList.Create;
+  try
+    P1 := Pointer(1);
+    P2 := Pointer(2);
+    L.Push(P1);
+    AssertEquals('Peek should return the pushed item', P1, L.Peek);
+    AssertEquals('Count should still be 1 after Peek', 1, L.Count);
+    L.Push(P2);
+    AssertEquals('Peek should return the last pushed item', P2, L.Peek);
+    AssertEquals('Count should still be 2 after Peek', 2, L.Count);
+    L.Pop;
+    AssertEquals('Peek should return the remaining item', P1, L.Peek);
+    L.Pop;
+    AssertEquals('Peek on an empty list should return nil', nil, L.Peek);
+  finally
+    L.Free;
+  end;
+end;
+
+procedure RegisterTests;
+begin
+  AddSuite('TOrderedListTests');
+  AddTest('TestCreate', @TOrderedList_TestCreate, 'TOrderedListTests');
+  AddTest('TestCount', @TOrderedList_TestCount, 'TOrderedListTests');
+  AddTest('TestAtLeast', @TOrderedList_TestAtLeast, 'TOrderedListTests');
+  AddTest('TestPush', @TOrderedList_TestPush, 'TOrderedListTests');
+  AddTest('TestPop', @TOrderedList_TestPop, 'TOrderedListTests');
+  AddTest('TestPeek', @TOrderedList_TestPeek, 'TOrderedListTests');
+end;
+
+end.

+ 110 - 0
packages/fcl-base/tests/utcqueue.pp

@@ -0,0 +1,110 @@
+unit utcQueue;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, contnrs, punit;
+
+procedure RegisterTests;
+
+implementation
+
+Function TQueue_TestCreate : TTestString;
+var
+  Q: TQueue;
+begin
+  Result:='';
+  Q := TQueue.Create;
+  try
+    AssertNotNull('Queue should be created', Q);
+    AssertEquals('Count should be 0 on creation', 0, Q.Count);
+  finally
+    Q.Free;
+  end;
+end;
+
+Function TQueue_TestPush : TTestString;
+var
+  Q: TQueue;
+  P1, P2, Res: Pointer;
+begin
+  Result:='';
+  Q := TQueue.Create;
+  try
+    P1 := Pointer(1);
+    P2 := Pointer(2);
+    Res := Q.Push(P1);
+    AssertEquals('Push should return the pushed item', P1, Res);
+    AssertEquals('Count should be 1', 1, Q.Count);
+    AssertEquals('Peek should return the pushed item', P1, Q.Peek);
+    Res := Q.Push(P2);
+    AssertEquals('Push should return the pushed item', P2, Res);
+    AssertEquals('Count should be 2', 2, Q.Count);
+    AssertEquals('Peek should return the first pushed item', P1, Q.Peek);
+  finally
+    Q.Free;
+  end;
+end;
+
+Function TQueue_TestPop : TTestString;
+var
+  Q: TQueue;
+  P1, P2, Res: Pointer;
+begin
+  Result:='';
+  Q := TQueue.Create;
+  try
+    P1 := Pointer(1);
+    P2 := Pointer(2);
+    Q.Push(P1);
+    Q.Push(P2);
+    Res := Q.Pop;
+    AssertEquals('Pop should return the first pushed item (FIFO)', P1, Res);
+    AssertEquals('Count should be 1', 1, Q.Count);
+    Res := Q.Pop;
+    AssertEquals('Pop should return the second pushed item', P2, Res);
+    AssertEquals('Count should be 0', 0, Q.Count);
+    Res := Q.Pop;
+    AssertEquals('Pop on an empty queue should return nil', nil, Res);
+  finally
+    Q.Free;
+  end;
+end;
+
+Function TQueue_TestPeek : TTestString;
+var
+  Q: TQueue;
+  P1, P2: Pointer;
+begin
+  Result:='';
+  Q := TQueue.Create;
+  try
+    P1 := Pointer(1);
+    P2 := Pointer(2);
+    Q.Push(P1);
+    AssertEquals('Peek should return the pushed item', P1, Q.Peek);
+    AssertEquals('Count should still be 1 after Peek', 1, Q.Count);
+    Q.Push(P2);
+    AssertEquals('Peek should return the first pushed item', P1, Q.Peek);
+    AssertEquals('Count should still be 2 after Peek', 2, Q.Count);
+    Q.Pop;
+    AssertEquals('Peek should return the remaining item', P2, Q.Peek);
+    Q.Pop;
+    AssertEquals('Peek on an empty queue should return nil', nil, Q.Peek);
+  finally
+    Q.Free;
+  end;
+end;
+
+procedure RegisterTests;
+begin
+  AddSuite('TQueueTests');
+  AddTest('TestCreate', @TQueue_TestCreate, 'TQueueTests');
+  AddTest('TestPush', @TQueue_TestPush, 'TQueueTests');
+  AddTest('TestPop', @TQueue_TestPop, 'TQueueTests');
+  AddTest('TestPeek', @TQueue_TestPeek, 'TQueueTests');
+end;
+
+end.

+ 110 - 0
packages/fcl-base/tests/utcstack.pp

@@ -0,0 +1,110 @@
+unit utcStack;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, contnrs, punit;
+
+procedure RegisterTests;
+
+implementation
+
+Function TStack_TestCreate : TTestString;
+var
+  S: TStack;
+begin
+  Result:='';
+  S := TStack.Create;
+  try
+    AssertNotNull('Stack should be created', S);
+    AssertEquals('Count should be 0 on creation', 0, S.Count);
+  finally
+    S.Free;
+  end;
+end;
+
+Function TStack_TestPush : TTestString;
+var
+  S: TStack;
+  P1, P2, Res: Pointer;
+begin
+  Result:='';
+  S := TStack.Create;
+  try
+    P1 := Pointer(1);
+    P2 := Pointer(2);
+    Res := S.Push(P1);
+    AssertEquals('Push should return the pushed item', P1, Res);
+    AssertEquals('Count should be 1', 1, S.Count);
+    AssertEquals('Peek should return the pushed item', P1, S.Peek);
+    Res := S.Push(P2);
+    AssertEquals('Push should return the pushed item', P2, Res);
+    AssertEquals('Count should be 2', 2, S.Count);
+    AssertEquals('Peek should return the last pushed item', P2, S.Peek);
+  finally
+    S.Free;
+  end;
+end;
+
+Function TStack_TestPop : TTestString;
+var
+  S: TStack;
+  P1, P2, Res: Pointer;
+begin
+  Result:='';
+  S := TStack.Create;
+  try
+    P1 := Pointer(1);
+    P2 := Pointer(2);
+    S.Push(P1);
+    S.Push(P2);
+    Res := S.Pop;
+    AssertEquals('Pop should return the last pushed item (LIFO)', P2, Res);
+    AssertEquals('Count should be 1', 1, S.Count);
+    Res := S.Pop;
+    AssertEquals('Pop should return the first pushed item', P1, Res);
+    AssertEquals('Count should be 0', 0, S.Count);
+    Res := S.Pop;
+    AssertEquals('Pop on an empty stack should return nil', nil, Res);
+  finally
+    S.Free;
+  end;
+end;
+
+Function TStack_TestPeek : TTestString;
+var
+  S: TStack;
+  P1, P2: Pointer;
+begin
+  Result:='';
+  S := TStack.Create;
+  try
+    P1 := Pointer(1);
+    P2 := Pointer(2);
+    S.Push(P1);
+    AssertEquals('Peek should return the pushed item', P1, S.Peek);
+    AssertEquals('Count should still be 1 after Peek', 1, S.Count);
+    S.Push(P2);
+    AssertEquals('Peek should return the last pushed item', P2, S.Peek);
+    AssertEquals('Count should still be 2 after Peek', 2, S.Count);
+    S.Pop;
+    AssertEquals('Peek should return the remaining item', P1, S.Peek);
+    S.Pop;
+    AssertEquals('Peek on an empty stack should return nil', nil, S.Peek);
+  finally
+    S.Free;
+  end;
+end;
+
+procedure RegisterTests;
+begin
+  AddSuite('TStackTests');
+  AddTest('TestCreate', @TStack_TestCreate, 'TStackTests');
+  AddTest('TestPush', @TStack_TestPush, 'TStackTests');
+  AddTest('TestPop', @TStack_TestPop, 'TStackTests');
+  AddTest('TestPeek', @TStack_TestPeek, 'TStackTests');
+end;
+
+end.

+ 0 - 288
packages/fcl-base/tests/utdirwatch.pas

@@ -1,288 +0,0 @@
-unit utdirwatch;
-
-{$mode objfpc}{$H+}
-
-interface
-
-uses
-  Classes, SysUtils, fpcunit, testutils, testregistry, dirwatch;
-
-type
-  TChangedEntry = record
-    Dir : TWatchDirectoryEntry;
-    Events : TWatchFileEvents;
-    FN : String;
-  end;
-  TChangedEntryArray = Array of TChangedEntry;
-
-  { TTestDirWatch }
-
-  TTestDirWatch= class(TTestCase)
-  private
-    FDirWatch: TDirwatch;
-    FTestDir: string;
-    FChanged: TChangedEntryArray;
-    FCheckCount : Integer;
-    FMaxLoopCount : Integer;
-    FDoCheckOne : TNotifyEvent;
-    procedure AssertChange(const Msg: String; aIndex: Integer; aEntry: TWatchDirectoryEntry; aEvents: TWatchFileEvents; const aFileName : string = '');
-    procedure CleanDirs(aDir: String);
-    procedure DoAppendFile(const aName: string);
-    procedure DoChange(Sender: TObject; const aEvent: TFileChangeEvent);
-    procedure DoCheck(sender: TObject; var aContinue: Boolean);
-    procedure DoCreateFile(const aName: string);
-    procedure DoDeleteFile(const aName: string);
-    procedure HandleCreateFile(Sender: TObject);
-  protected
-    procedure SetUp; override;
-    procedure TearDown; override;
-    property dirwatch : TDirwatch read FDirWatch;
-    Property TestDir : string Read FTestDir;
-    property CheckCount : Integer Read FCheckCount;
-    property MaxLoopCount : Integer Read FMaxLoopCount Write FMaxLoopCount;
-  Public
-    class procedure AssertEquals(const Msg: String; aExpected, aActual: TWatchFileEvents); overload;
-  published
-    procedure TestHookUp;
-    procedure TestAddFile;
-    procedure TestAppendFile;
-    procedure TestDeleteFile;
-    procedure TestLoopNoThread;
-    procedure TestLoopThread;
-    procedure TestAddFileBaseDir;
-  end;
-
-implementation
-
-uses typinfo, inifiles;
-
-var
-  BaseDir : String;
-
-procedure TTestDirWatch.CleanDirs(aDir: String);
-
-Var
-  Info : TSearchRec;
-  lDir,lFull : String;
-
-begin
-  lDir:=IncludeTrailingPathDelimiter(aDir);
-  If FIndFirst(lDir+AllFilesMask,sysutils.faDirectory,Info)=0 then
-    try
-      Repeat
-        lFull:=lDir+Info.Name;
-        if (Info.Attr and faDirectory)<>0 then
-          begin
-          if not ((Info.Name='.') or (Info.Name='..')) then
-            begin
-            CleanDirs(lFull);
-            if not RemoveDir(lFull) then
-              Fail('Failed to remove directory %s',[lFull])
-            end;
-          end
-        else if not DeleteFIle(lFull) then
-          Fail('Failed to remove file %s',[lFull])
-      until FIndNext(Info)<>0;
-    finally
-      FindClose(Info);
-    end;
-end;
-
-procedure TTestDirWatch.DoChange(Sender: TObject; const aEvent: TFileChangeEvent);
-var
-  Len : Integer;
-begin
-  len:=Length(FChanged);
-  SetLength(FChanged,Len+1);
-  FChanged[Len].Dir:=aEvent.Entry;
-  FChanged[Len].Events:=aEvent.Events;
-  FChanged[Len].FN:=aEvent.FileName;
-end;
-
-procedure TTestDirWatch.DoCheck(sender: TObject; var aContinue: Boolean);
-begin
-  aContinue:=CheckCount<MaxLoopCount;
-  if (FCheckCount=0) then
-    if Assigned(FDoCheckOne) then
-       FDoCheckOne(Self);
-  inc(FCheckCount);
-end;
-
-procedure TTestDirWatch.TestHookUp;
-begin
-  AssertNotNull('Have watch',Dirwatch);
-  AssertEquals('No watches',0,Dirwatch.Watches.Count);
-  AssertTrue('Have test dir',TestDir<>'');
-  AssertTrue('test dir exists',DirectoryExists(TestDir));
-  AssertEquals('No max check count',0,FMaxLoopCount);
-  AssertEquals('No check count',0,FCheckCount);
-  AssertTrue('No docheckone',FDoCheckOne=nil);
-end;
-
-procedure TTestDirWatch.DoAppendFile(const aName : string);
-
-var
-  FD : THandle;
-begin
-  FD:=FileOpen(TestDir+aName,fmOpenWrite);
-  try
-    FileSeek(FD,0,fsFromEnd);
-    if FileWrite(FD,aName[1],Length(aName))=-1 then
-      Writeln(GetLastOSError);
-  finally
-    FileClose(FD);
-  end;
-end;
-
-procedure TTestDirWatch.DoCreateFile(const aName : string);
-
-var
-  L: TStrings;
-begin
-  L:=TStringList.Create;
-  try
-    L.Add(aName);
-    L.SaveToFile(TestDir+aName);
-  finally
-    L.Free;
-  end;
-end;
-
-procedure TTestDirWatch.DoDeleteFile(const aName: string);
-
-begin
-  If not DeleteFile(TestDir+aName) then
-    Fail('Failed to delete file '+TestDir+aName);
-end;
-
-procedure TTestDirWatch.HandleCreateFile(Sender: TObject);
-begin
-  DoCreateFile('name.txt');
-end;
-
-class procedure TTestDirWatch.AssertEquals(const Msg: String; aExpected,aActual : TWatchFileEvents);
-
-begin
-  AssertEquals(Msg,SetToString(PTypeInfo(TypeInfo(TWatchFileEvents)),Longint(aExpected),False),
-                   SetToString(PTypeInfo(TypeInfo(TWatchFileEvents)),Longint(aActual),False));
-end;
-
-procedure TTestDirWatch.AssertChange(const Msg: String; aIndex: Integer; aEntry: TWatchDirectoryEntry; aEvents: TWatchFileEvents;
-  const aFileName: string);
-var
-  M : String;
-begin
-  M:=Msg+Format(' [%d]: ',[aIndex]);
-  AssertTrue(M+'correct index',aIndex<Length(FChanged));
-  AssertSame(M+'correct dir entry',aEntry,FChanged[aIndex].Dir);
-  AssertEquals(M+'correct changes',aEvents,FChanged[aIndex].Events);
-  if aFileName<>'' then
-    AssertEquals(M+'correct fileName',aFileName,FChanged[aIndex].FN);
-end;
-
-procedure TTestDirWatch.TestAddFile;
-begin
-  FDirwatch.AddWatch(TestDir,[feCreate]);
-  FDirWatch.InitWatch;
-  DoCreateFile('name.txt');
-  AssertEquals(1,FDirWatch.Check);
-  AssertChange('Create',0,FDirWatch.Watches[0],[feCreate],'name.txt');
-end;
-
-procedure TTestDirWatch.TestAppendFile;
-begin
-  FDirwatch.AddWatch(TestDir,[feModify]);
-  DoCreateFile('name.txt');
-  FDirWatch.InitWatch;
-  DoAppendFile('name.txt');
-  AssertEquals('Change detected',1,FDirWatch.Check);
-  AssertChange('Change detected',0,FDirWatch.Watches[0],[feModify],'name.txt');
-end;
-
-
-procedure TTestDirWatch.TestDeleteFile;
-begin
-  FDirwatch.AddWatch(TestDir,[feDelete]);
-  DoCreateFile('name.txt');
-  FDirWatch.InitWatch;
-  DoDeleteFile('name.txt');
-  AssertEquals('Change detected',1,FDirWatch.Check);
-  AssertChange('Change detected',0,FDirWatch.Watches[0],[feDelete],'name.txt');
-end;
-
-procedure TTestDirWatch.TestLoopNoThread;
-begin
-  FDirwatch.AddWatch(TestDir,[feCreate]);
-  FDirwatch.OnCheck:=@DoCheck;
-  FDoCheckOne:=@HandleCreateFile;
-  MaxLoopCount:=2;
-  FDirWatch.StartLoop;
-  AssertChange('Change detected',0,FDirWatch.Watches[0],[feCreate],'name.txt');
-end;
-
-procedure TTestDirWatch.TestLoopThread;
-var
-  I : Integer;
-begin
-  FDirwatch.AddWatch(TestDir,[feCreate]);
-  FDirwatch.Threaded:=True;
-  FDirWatch.StartLoop;
-  Sleep(50);
-  DoCreateFile('name.txt');
-  I:=0;
-  Repeat
-    Sleep(10);
-    CheckSynchronize;
-    inc(i);
-  until (I>=50) or (length(FChanged)>0);
-  AssertChange('Change detected',0,FDirWatch.Watches[0],[feCreate],'name.txt');
-end;
-
-procedure TTestDirWatch.TestAddFileBaseDir;
-begin
-  FDirwatch.BaseDir:=TestDir;
-  AssertTrue('Create Subdir ',ForceDirectories(TestDir+'sub'));
-  FDirwatch.AddWatch('',[feCreate]);
-  FDirWatch.InitWatch;
-  DoCreateFile('sub/name.txt');
-  AssertEquals('Subdirs not watched',0,FDirWatch.Check);
-end;
-
-procedure TTestDirWatch.SetUp;
-begin
-  FDirWatch:=TDirwatch.Create(Nil);
-  FTestDir:=IncludeTrailingPathDelimiter(BaseDir);
-  ForceDirectories(TestDir);
-  FDirWatch.OnChange:=@DoChange;
-  FMaxLoopCount:=0;
-  FCheckCount:=0;
-  FDoCheckOne:=Nil;
-end;
-
-procedure TTestDirWatch.TearDown;
-begin
-  CleanDirs(TestDir);
-  FDirWatch.Free;
-end;
-
-procedure GetBaseDir;
-
-var
-  FN : string;
-begin
-  BaseDir:=IncludeTrailingPathDelimiter(GetTempDir)+'Dirwatch'+PathDelim;
-  FN:=ExtractFilePath(ParamStr(0))+'config.ini';
-  If FileExists(FN) then
-    With TMemIniFile.Create(FN) do
-      try
-        BaseDir:=ReadString('dirwatch','basedir',BaseDir);
-      finally
-        Free;
-      end;
-end;
-
-initialization
-  GetBaseDir;
-  RegisterTest(TTestDirWatch);
-end.
-