* Testsuite in punit format

git-svn-id: trunk@43425 -

.gitattributes

@@ -11649,6 +11649,57 @@ rtl/symbian/uiq.pas svneol=native#text/plain
 rtl/symbian/uiqclasses.pas svneol=native#text/plain
 rtl/symbian/uiqinc/qikapplication.inc svneol=native#text/plain
 rtl/symbian/uiqinc/qikapplicationoo.inc svneol=native#text/plain
+rtl/test/docompile.sh svneol=native#text/plain
+rtl/test/punit.cfg svneol=native#text/plain
+rtl/test/punit.pp svneol=native#text/plain
+rtl/test/testpunit.pp svneol=native#text/plain
+rtl/test/testpunit2.pp svneol=native#text/plain
+rtl/test/testpunit3.pp svneol=native#text/plain
+rtl/test/testrtl.lpi svneol=native#text/plain
+rtl/test/testrtl.pp svneol=native#text/plain
+rtl/test/tohelper.inc svneol=native#text/plain
+rtl/test/unittest.cfg svneol=native#text/plain
+rtl/test/utastrcmp.pp svneol=native#text/plain
+rtl/test/utbytesof.pp svneol=native#text/plain
+rtl/test/utclasses.pp svneol=native#text/plain
+rtl/test/utdfexp.pp svneol=native#text/plain
+rtl/test/utdirex.pp svneol=native#text/plain
+rtl/test/utdos.pp svneol=native#text/plain
+rtl/test/utencoding.pp svneol=native#text/plain
+rtl/test/utencodingerr.pp svneol=native#text/plain
+rtl/test/utenv.pp svneol=native#text/plain
+rtl/test/utexec.pp svneol=native#text/plain
+rtl/test/utexpfncase.pp svneol=native#text/plain
+rtl/test/utextractquote.pp svneol=native#text/plain
+rtl/test/utfattr.pp svneol=native#text/plain
+rtl/test/utfexpand.pp svneol=native#text/plain
+rtl/test/utffirst.pp svneol=native#text/plain
+rtl/test/utfile.pp svneol=native#text/plain
+rtl/test/utfile1.pp svneol=native#text/plain
+rtl/test/utfile2.pp svneol=native#text/plain
+rtl/test/utfilename.pp svneol=native#text/plain
+rtl/test/utfloattostr.pp svneol=native#text/plain
+rtl/test/utformat.pp svneol=native#text/plain
+rtl/test/utfsearch.pp svneol=native#text/plain
+rtl/test/utmath.pp svneol=native#text/plain
+rtl/test/utrtl.pp svneol=native#text/plain
+rtl/test/utrwsync.pp svneol=native#text/plain
+rtl/test/utscanf.pp svneol=native#text/plain
+rtl/test/utstrcmp.pp svneol=native#text/plain
+rtl/test/utstrcopy.pp svneol=native#text/plain
+rtl/test/utstringbuild.pp svneol=native#text/plain
+rtl/test/utstringhelp.pp svneol=native#text/plain
+rtl/test/utstrings1.pp svneol=native#text/plain
+rtl/test/utstrtobool.pp svneol=native#text/plain
+rtl/test/utstrtotime.pp svneol=native#text/plain
+rtl/test/utsyshelpers.pp svneol=native#text/plain
+rtl/test/utsysutils.pp svneol=native#text/plain
+rtl/test/uttypinfo.pp svneol=native#text/plain
+rtl/test/utunifile.pp svneol=native#text/plain
+rtl/test/utuplow.pp svneol=native#text/plain
+rtl/test/utustringbuild.pp svneol=native#text/plain
+rtl/test/utverify.pp svneol=native#text/plain
+rtl/test/utwstrcmp.pp svneol=native#text/plain
 rtl/ucmaps/8859-1.txt svneol=native#text/plain
 rtl/ucmaps/8859-10.txt svneol=native#text/plain
 rtl/ucmaps/8859-11.txt svneol=native#text/plain

rtl/test/docompile.sh

@@ -0,0 +1,2 @@
+#!/bin/sh
+exec fpc @unittest.cfg  testrtl.pp $*

rtl/test/punit.cfg

@@ -0,0 +1 @@
+nosync=true

rtl/test/punit.pp

@@ -0,0 +1,3120 @@
+{
+    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
+{ $DEFINE USEUNICODE} // define this if you want to use unicode.
+
+unit punit;
+
+interface
+Type
+{$IFDEF USEUNICODE}
+   TTestString = UnicodeString;
+{$ELSE}
+   TTestString = AnsiString;
+{$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 runn.
+  TTestRun = Function : TTestString;
+
+  // A single test
+  TTestOption = (toInactive);
+  TTestOptions = Set of TTestOption;
+  PTest = ^TTest;
+  TTest = Record
+    Run : TTestRun;           // Function to execute when test is run.
+    Name : ShortString;       // 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. Executed once at end of suite (regardless of errors)
+    Name : Shortstring;       // 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 : AnsiString;
+  Public
+    Constructor Create(Const AMessage : AnsiString);
+    Function ToString : AnsiString; 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 : ShortString; ASetup : TTestSetup = nil; ATearDown : TTestTearDown = Nil; AParent : PSuite = nil) : PSuite;
+Function AddSuite(Const AName : ShortString; 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 : ShortString) : Integer;
+// Return the 0-based index of the nested suite names AName (case sensitive). -1 if not found.
+Function GetSuiteIndex(ASuite : PSuite; Const AName : ShortString) : 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 : ShortString; 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 : ShortString; ARun : TTestRun; Const ASuiteName : ShortString = '') : PTest;
+// Same as above, only the suite is explitly given. It may not be nil.
+Function AddTest(Const ATestName : ShortString; ARUn : TTestRun; 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 : ShortString) : 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 : ShortString) : 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 : ShortString) : PTest;
+// Return the test named ATestName in ASuite. Returns Nil if not found.
+Function GetTest(Const ASuite : PSuite; Const ATestName : ShortString) : 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 : ShortString) : 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 : ShortString; Const ATestName: ShortString) : TTestError;
+// Run test ATestName from Suite ASuite. ASuite need not be registered. Results can be viewed in GetCurrentRun.
+Function RunTest(ASuite : PSuite; Const ATestName : ShortString) : 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 : 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) :  ShortString;
+
+{ ---------------------------------------------------------------------
+  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 : ShortString;
+// 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 : ShortString) : ShortString;
+
+implementation
+
+Const
+  SExpected = 'Expected';
+  SActual = 'Actual';
+//  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: ShortString; 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: ShortString): 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: ShortString): Integer;
+
+begin
+  if ASuite=Nil then
+    Result:=0
+  else
+    Result:=GetSuiteIndex(PSuiteList(@ASuite^.Suites),AName);
+end;
+
+function GetSuiteIndex(const AName: ShortString): 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 : ShortString) : PSuite;
+
+Var
+  I,P : Integer;
+  N : ShortString;
+  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 : ShortString; 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: ShortString; ASetup: TTestSetup;
+  ATearDown: TTestTearDown; AParent: PSuite): 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:=[];
+    Result^.Tests.Count:=0;
+    Result^.ParentSuite:=AParent;
+    CheckGrowTests(Result^.Tests);
+    Inc(L^.Count);
+    end;
+  end;
+
+{ ---------------------------------------------------------------------
+  Test management
+  ---------------------------------------------------------------------}
+
+function AddTest(const ATestName: ShortString; ARUn: TTestRun;
+  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:=[];
+        Result^.Run:=ARun;
+        List^.Items[List^.Count]:=Result;
+        Inc(List^.Count);
+        end;
+      end;
+    end;
+end;
+
+// Easy access function
+function AddTest(const ATestName: ShortString; ARun: TTestRun;
+  const ASuiteName: ShortString): PTest;
+
+Var
+  S : PSuite;
+  SN : ShortString;
+
+begin
+  Result:=Nil;
+  SetTestError(teOK);
+  SN:=ASuiteName;
+  if (SN='') then
+    SN:=DefaultSuiteName;
+  S:=GetSuite(SN);
+  if (S=Nil) and (ASuiteName<>'') then
+    SetTestError(teNoSuite)
+  else
+    begin
+    If (S=Nil) then
+      S:=AddSuite(SN,Nil,Nil);
+    If (S<>Nil) then
+      Result:=AddTest(ATestName,ARun,S);
+    end;
+end;
+
+Function GetTestIndex(Const ASuiteIndex: Integer; Const ATestName: ShortString): Integer;
+begin
+  Result:=GetTestIndex(GetSuite(ASuiteIndex),ATestName);
+end;
+
+function GetTestIndex(const ASuiteName: TTestString;
+  const ATestName: ShortString): Integer;
+begin
+  Result:=GetTestIndex(GetSuite(ASuiteName),ATestName);
+end;
+
+function GetTestIndex(const ASuite: PSuite; const ATestName: ShortString
+  ): 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: ShortString
+  ): 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: ShortString
+  ): PTest;
+begin
+  Result:=GetTest(GetSuite(ASuiteName),ATestName);
+end;
+
+function GetTest(const ASuite: PSuite; const ATestName: ShortString): PTest;
+
+Var
+  I,P : Integer;
+  N : ShortString;
+  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 : TTestString; Quote : Boolean = False) : TTestString;
+
+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 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: UnicodeString): Boolean;
+begin
+  Result:=AssertTrue(AMessage+'. '+ExpectMessage(AExpected,AActual,True),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) : ShortString;
+
+  begin
+    If Assigned(AClass) then
+      Result:=AClass.ClassName
+    else
+      Result:='Nil'
+  end;
+
+Var
+  SE,SA : ShortString;
+
+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) : ShortString;
+
+  begin
+    If Assigned(ACLass) then
+      Result:=AClass.ClassName
+    else
+      Result:='Nil'
+  end;
+
+Var
+  SE,SA : ShortString;
+
+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) : ShortString;
+
+  begin
+    If Assigned(ACLass) then
+      Result:=AClass.ClassName
+    else
+      Result:='Nil'
+  end;
+
+Var
+  SE,SA : ShortString;
+
+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,'',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
+Function RunTestHandler(R : TTestRun) : String;
+
+Var
+  EC : TClass;
+  EM : TTestString;
+
+
+begin
+  Result:='';
+  EC:=Nil;
+  EM:='';
+  try
+    Result:=R();
+  except
+    On E : TObject do
+      begin
+      EC:=E.ClassType;
+      EM:=E.TOString;
+      end;
+  end;
+  // 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^.Run); // 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: ShortString): 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: ShortString): TTestError;
+begin
+  Result:=RunTest(ASuite,GetTest(ASuite,ATestName));
+end;
+
+function RunTest(const ASuiteName: ShortString; const ATestName: ShortString
+  ): 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;
+  CurrentRunMode : TSysRunVerbosity;
+  SysSuite : PSuite;
+  SysOutputFileName : ShortString;
+  SysTestName : ShortString;
+  SysSuiteName : ShortString;
+  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): ShortString;
+
+Var
+  S : ShortString;
+
+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:
+       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 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 SetupSysHandlers;
+
+begin
+{$i-}
+  Close(FSys);
+{$i+}
+  Assign(FSys,'');
+{$i-}
+  Rewrite(FSys);
+  if (IOResult<>0) then
+    CurrentRunMode:=rvQuiet;
+{$i+}
+  CurrentRunmode:=rvNormal;
+  // 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(FSys);
+{$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: ShortString) : 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
+    Assign(FSys,SysOutputFileName);
+    {$i-}
+    Rewrite(FSys);
+    if (IOResult<>0) then
+      CurrentRunMode:=rvQuiet;
+    {$i+}
+    end;
+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: AnsiString);
+begin
+  FMessage:=AMessage;
+end;
+
+Function EFail.ToString: AnsiString;
+begin
+  Result:=FMessage;
+end;
+
+function GetSysTestOS: ShortString;
+
+begin
+  GetSysTestOS := lowercase({$I %FPCTARGETOS%});
+end;
+
+function SysGetSetting(const AName: ShortString): ShortString;
+
+  Procedure Trim(Var S : ShortString);
+
+  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 : String;
+
+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
+  SetupTestRegistry;
+  SetupSysHandlers;
+
+finalization
+
+  TearDownSysHandlers;
+  TearDownTestRegistry;
+  ResetRun(CurrentRun);
+end.
+

rtl/test/testpunit.pp

@@ -0,0 +1,16 @@
+{$mode objfpc}
+
+program testpunit;
+
+uses punit;
+
+Function DoTest : AnsiString;
+
+begin
+  Result:='test failed';
+end;
+
+begin
+  RunTest(@DoTest);
+end.
+

rtl/test/testpunit2.pp

@@ -0,0 +1,565 @@
+{$mode objfpc}
+
+program testpunit2;
+
+uses punit;
+
+Type
+  EError = Class(TObject);
+
+Function DoTest1 : AnsiString;
+
+Begin
+  Result:='';
+  Result:='Error in test';
+end;
+
+Function DoTest2 : AnsiString;
+
+Begin
+  // Test OK if RequirePassed=False, but Unimplemented if RequirePassed=True !
+//  AssertPassed('');
+  Result:='';
+end;
+
+Function DoTest3 : AnsiString;
+
+Begin
+  Result:='';
+  Fail('Must fail: Failed throug fail');
+  Result:='';// This is ignored
+end;
+
+Function DoTest4 : AnsiString;
+
+Begin
+  Result:='';
+  FailExit('Must fail: Failed throug fail exception');
+  Result:='Nono';// This is not reached.
+end;
+
+Function DoTest5 : AnsiString;
+
+Begin
+  Result:='';
+  Fail('Must fail: Failed throug fail');
+  Result:='Failed through default';// This is ignored
+end;
+
+Function DoTest6: AnsiString;
+
+Begin
+  Result:='';
+  // Will be marked as passed.
+  AssertTrue('Some message',True);
+  Result:='';
+end;
+
+Function DoTest7: AnsiString;
+
+Begin
+  Result:='';
+  // Will be marked as Failed.
+  if Not AssertTrue('Must fail: AssertTrue with false',False) then
+    exit;
+end;
+Function DoTest9: AnsiString;
+
+Begin
+  Result:='';
+  // Will be marked as Failed.
+  if Not AssertEquals('Must fail: Strings equal','Expected result string','Actual result string') then
+    exit;
+end;
+
+Function DoTest10: AnsiString;
+
+Var
+  O1,O2 : Integer;
+
+Begin
+  Result:='';
+  O1:=1;
+  O2:=2;
+  // Will be marked as Failed.
+  if Not AssertEquals('Must fail: Integers equal',O1,O2) then
+    exit;
+end;
+
+Function DoTest11: AnsiString;
+
+Var
+  O1,O2 : Smallint;
+
+Begin
+  Result:='';
+  O1:=1;
+  O2:=2;
+  // Will be marked as Failed.
+  if Not AssertEquals('Must fail: Smallint equal',O1,O2) then
+    exit;
+end;
+
+Function DoTest12: AnsiString;
+
+Var
+  O1,O2 : Longint;
+
+Begin
+  Result:='';
+  O1:=1;
+  O2:=2;
+  // Will be marked as Failed.
+  if Not AssertEquals('Must fail: Longint equal',O1,O2) then
+    exit;
+end;
+
+Function DoTest13: AnsiString;
+
+Var
+  O1,O2 : Byte;
+
+Begin
+  Result:='';
+  O1:=1;
+  O2:=2;
+  // Will be marked as Failed.
+  if Not AssertEquals('Must fail: Bytes equal',O1,O2) then
+    exit;
+end;
+
+Function DoTest14: AnsiString;
+
+Var
+  O1,O2 : Shortint;
+
+Begin
+  Result:='';
+  O1:=1;
+  O2:=2;
+  // Will be marked as Failed.
+  if Not AssertEquals('Must fail: Shortints equal',O1,O2) then
+    exit;
+end;
+
+Function DoTest15: AnsiString;
+
+Var
+  O1,O2 : Cardinal;
+
+Begin
+  Result:='';
+  O1:=1;
+  O2:=2;
+  // Will be marked as Failed.
+  if Not AssertEquals('Must fail: Cardinals equal',O1,O2) then
+    exit;
+end;
+
+Function DoTest16: AnsiString;
+
+Var
+  O1,O2 : Int64;
+
+Begin
+  Result:='';
+  O1:=1;
+  O2:=2;
+  // Will be marked as Failed.
+  if Not AssertEquals('Must fail: Int64s equal',O1,O2) then
+    exit;
+end;
+
+Function DoTest17: AnsiString;
+
+Var
+  O1,O2 : QWord;
+
+Begin
+  Result:='';
+  O1:=1;
+  O2:=2;
+  // Will be marked as Failed.
+  if Not AssertEquals('Must fail: QWords equal',O1,O2) then
+    exit;
+end;
+
+Function DoTest18: AnsiString;
+
+Var
+  O1,O2 : Pointer;
+
+Begin
+  Result:='';
+  O1:=Pointer(1);
+  O2:=Pointer(2);
+  // Will be marked as Failed.
+  if Not AssertEquals('Must fail: pointers equal',O1,O2) then
+    exit;
+end;
+
+Function DoTest19: AnsiString;
+
+Var
+  O1,O2 : Word;
+
+Begin
+  Result:='';
+  O1:=1;
+  O2:=2;
+  // Will be marked as Failed.
+  if Not AssertEquals('Must fail: Word equal',O1,O2) then
+    exit;
+end;
+
+Function DoTest20: AnsiString;
+
+Begin
+  Result:='';
+  ExpectException('Must fail: Expect exception EError',EError);
+end;
+
+Function DoTest21: AnsiString;
+
+Begin
+  Result:='';
+  ExpectException('Must fail: Expect exception EError',EError);
+  Raise EFail.Create('Expected');
+end;
+
+Function DoTest22: AnsiString;
+
+Begin
+  Result:='';
+  ExpectException('Expect exception EError',EFail);
+  Raise EFail.Create('Expected');
+end;
+
+Function DoTest23: AnsiString;
+
+Begin
+  Result:='';
+  AssertEquals('Must fail: Classes differ',EError,EFail);
+end;
+
+Function DoTest24: AnsiString;
+
+Begin
+  Result:='';
+  AssertEquals('Must fail: Classes differ (expected is nil)',Nil,EFail);
+end;
+
+Function DoTest25: AnsiString;
+
+Begin
+  Result:='';
+  AssertEquals('Must fail: Classes differ (actual is nil)',EFail,Nil);
+end;
+
+Function DoTest26: AnsiString;
+
+Var
+  A,B : TObject;
+
+Begin
+  Result:='';
+  A:=EFail.Create('');
+  B:=EError.Create();
+  try
+    AssertSame('Must fail: Instances differ',A,B);
+  finally
+    A.Free;
+    B.Free
+  end;
+end;
+
+Function DoTest27: AnsiString;
+
+Var
+  A : TObject;
+
+Begin
+  Result:='';
+  A:=EFail.Create('');
+  try
+    AssertSame('Must fail: Instances differ (actual nil)',A,Nil);
+  finally
+    A.Free;
+  end;
+end;
+
+Function DoTest28: AnsiString;
+
+Var
+  A : TObject;
+
+Begin
+  Result:='';
+  A:=EFail.Create('');
+  try
+    AssertSame('Must fail: Instances differ (expected nil)',Nil,A);
+  finally
+    A.Free;
+  end;
+end;
+
+Function DoTest29: AnsiString;
+
+Var
+  A : TObject;
+  B : TObject;
+
+Begin
+  Result:='';
+  A:=EFail.Create('');
+  try
+    B:=A;
+    AssertSame('Instances equal(expected nil)',B,A);
+  finally
+    A.Free;
+  end;
+end;
+
+Function DoTest30: AnsiString;
+
+Var
+  A,B : Double;
+
+Begin
+  Result:='';
+  A:=1.2;
+  B:=3.4;
+  AssertEquals('Must fail: Doubles not within delta',B,A);
+end;
+
+Function DoTest31: AnsiString;
+
+Var
+  A,B : Double;
+
+Begin
+  Result:='';
+  A:=1.2;
+  B:=1.2+(DefaultDoubleDelta/2);
+  AssertEquals('Doubles within delta',B,A);
+end;
+
+Function DoTest32: AnsiString;
+
+Var
+  A,B : Double;
+
+Begin
+  Result:='';
+  A:=1.2;
+  B:=3.4;
+  AssertEquals('Doubles within delta',B,A,1);
+end;
+
+Function DoTest33: AnsiString;
+
+Var
+  A : Pointer;
+
+Begin
+  Result:='';
+  A:=Nil;
+  AssertNull('A is nil',A);
+end;
+
+Function DoTest34: AnsiString;
+
+Var
+  A : Pointer;
+
+Begin
+  Result:='';
+  A:=Pointer(123);
+  AssertNull('Must fail: A is nil',A);
+end;
+
+Function DoTest35: AnsiString;
+
+Var
+  A : Pointer;
+
+Begin
+  Result:='';
+  A:=Nil;
+  AssertNotNull('Must fail: A is nil',A);
+end;
+
+Function DoTest36: AnsiString;
+
+Var
+  A : Pointer;
+
+Begin
+  Result:='';
+  A:=Pointer(123);
+  AssertNotNull('A is not nil',A);
+end;
+
+Function DoTest37: AnsiString;
+
+
+Begin
+  Result:='';
+  if not AssertFalse('Condition is false',False) then
+    Fail('This is not supposed to happen');
+end;
+
+Function DoTest38: AnsiString;
+
+Var
+  PA,PB : Pointer;
+
+Begin
+  Result:='';
+  PA:=@DoTest36;
+  PB:=@DoTest37;
+  if not AssertDiffers('Pointers differ',PA,PB) then
+    Fail('This is not supposed to happen');
+end;
+
+Function DoTest39: AnsiString;
+
+Var
+  PA,PB : Pointer;
+
+Begin
+  Result:='';
+  PA:=@DoTest36;
+  PB:=@DoTest36;
+  if AssertDiffers('Must fail: pointers differ',PA,PB) then
+    Fail('This is not supposed to happen');
+end;
+
+Procedure DoExcept;
+
+begin
+  Raise EError.Create;
+end;
+
+Procedure DoNoExcept;
+
+begin
+
+end;
+
+Procedure DoFailExcept;
+
+begin
+  Raise EFail.Create('err');
+end;
+
+Function DoTest40: AnsiString;
+
+Begin
+  Result:='';
+  AssertException('Must not fail (correct exception',EError,@DoExcept);
+end;
+
+Function DoTest41: AnsiString;
+
+Begin
+  Result:='';
+  AssertException('Must fail (no exception)',EError,@DoNoExcept);
+end;
+
+Function DoTest42: AnsiString;
+
+Begin
+  Result:='';
+  AssertException('Must fail (Wrong exception)',EError,@DoFailExcept);
+end;
+
+Function DoTest43: AnsiString;
+
+Begin
+  Result:='';
+  AssertNotSame('Pointers differ',EFail.Create(''),EError.Create);
+end;
+
+Function DoTest44: AnsiString;
+
+Begin
+  Result:='';
+  if Not AssertInheritsFrom('EError is TObject',EError,TObject) then
+    Fail('This should not happen');
+end;
+
+Function DoTest45: AnsiString;
+
+Begin
+  Result:='';
+  if AssertInheritsFrom('Must fail, nil parent',EError,Nil) then
+    Fail('This should not happen');
+end;
+
+Function DoTest46: AnsiString;
+
+Begin
+  Result:='';
+  if AssertInheritsFrom('Must fail, nil child',Nil,EError) then
+    Fail('This should not happen');
+end;
+
+Function DoTest47: AnsiString;
+
+Begin
+  Result:='';
+  AssertInheritsFrom('Instances. Must fail',EFail.Create(''),EError.Create);
+end;
+
+Begin
+  RequirePassed:=True;
+  AddTest('Test1',@DoTest1);
+  AddTest('Test2',@DoTest2);
+  AddTest('Test3',@DoTest3);
+  AddTest('Test4',@DoTest4);
+  AddTest('Test5',@DoTest5);
+  AddTest('Test6',@DoTest6);
+  AddTest('Test7',@DoTest7);
+  AddTest('Test8',@DoTest7)^.Active:=False;
+  AddTest('Test9',@DoTest9);
+  AddTest('Test10',@DoTest10);
+  AddTest('Test11',@DoTest11);
+  AddTest('Test12',@DoTest12);
+  AddTest('Test13',@DoTest13);
+  AddTest('Test14',@DoTest14);
+  AddTest('Test15',@DoTest15);
+  AddTest('Test16',@DoTest16);
+  AddTest('Test17',@DoTest17);
+  AddTest('Test18',@DoTest18);
+  AddTest('Test19',@DoTest19);
+  AddTest('Test20',@DoTest20);
+  AddTest('Test21',@DoTest21);
+  AddTest('Test22',@DoTest22);
+  AddTest('Test23',@DoTest23);
+  AddTest('Test24',@DoTest24);
+  AddTest('Test25',@DoTest25);
+  AddTest('Test26',@DoTest26);
+  AddTest('Test27',@DoTest27);
+  AddTest('Test28',@DoTest28);
+  AddTest('Test29',@DoTest29);
+  AddTest('Test30',@DoTest30);
+  AddTest('Test31',@DoTest31);
+  AddTest('Test32',@DoTest32);
+  AddTest('Test33',@DoTest33);
+  AddTest('Test34',@DoTest34);
+  AddTest('Test35',@DoTest35);
+  AddTest('Test36',@DoTest36);
+  AddTest('Test37',@DoTest37);
+  AddTest('Test38',@DoTest38);
+  AddTest('Test39',@DoTest39);
+  AddTest('Test40',@DoTest40);
+  AddTest('Test41',@DoTest41);
+  AddTest('Test43',@DoTest43);
+  AddTest('Test44',@DoTest44);
+  AddTest('Test45',@DoTest45);
+  AddTest('Test46',@DoTest46);
+  AddTest('Test47',@DoTest47);
+  RunAllSysTests;
+end.
+

rtl/test/testpunit3.pp

@@ -0,0 +1,17 @@
+{$mode objfpc}
+
+program testpunit2;
+
+uses punit, sysutils;
+
+Function DoTest : AnsiString;
+
+begin
+  Result:='test failed';
+end;
+
+begin
+  SetTimeHook(@SysUtils.Now);
+  RunTest(@DoTest);
+end.
+

rtl/test/testrtl.lpi

@@ -0,0 +1,224 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<CONFIG>
+  <ProjectOptions>
+    <Version Value="12"/>
+    <General>
+      <Flags>
+        <SaveOnlyProjectUnits Value="True"/>
+        <MainUnitHasCreateFormStatements Value="False"/>
+        <MainUnitHasTitleStatement Value="False"/>
+        <SaveJumpHistory Value="False"/>
+        <SaveFoldState Value="False"/>
+        <CompatibilityMode Value="True"/>
+      </Flags>
+      <SessionStorage Value="InProjectDir"/>
+      <Title Value="testrtl"/>
+      <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=SysUtils.StringBuilder"/>
+      </local>
+      <FormatVersion Value="2"/>
+      <Modes Count="1">
+        <Mode0 Name="default">
+          <local>
+            <CommandLineParams Value="--suite=SysUtils.StringBuilder"/>
+          </local>
+        </Mode0>
+      </Modes>
+    </RunParams>
+    <Units Count="39">
+      <Unit0>
+        <Filename Value="testrtl.pp"/>
+        <IsPartOfProject Value="True"/>
+      </Unit0>
+      <Unit1>
+        <Filename Value="utstrtotime.pp"/>
+        <IsPartOfProject Value="True"/>
+      </Unit1>
+      <Unit2>
+        <Filename Value="utwstrcmp.pp"/>
+        <IsPartOfProject Value="True"/>
+      </Unit2>
+      <Unit3>
+        <Filename Value="utrtl.pp"/>
+        <IsPartOfProject Value="True"/>
+      </Unit3>
+      <Unit4>
+        <Filename Value="utstrcmp.pp"/>
+        <IsPartOfProject Value="True"/>
+      </Unit4>
+      <Unit5>
+        <Filename Value="utuplow.pp"/>
+        <IsPartOfProject Value="True"/>
+      </Unit5>
+      <Unit6>
+        <Filename Value="utunifile.pp"/>
+        <IsPartOfProject Value="True"/>
+      </Unit6>
+      <Unit7>
+        <Filename Value="utstrtobool.pp"/>
+        <IsPartOfProject Value="True"/>
+      </Unit7>
+      <Unit8>
+        <Filename Value="utscanf.pp"/>
+        <IsPartOfProject Value="True"/>
+      </Unit8>
+      <Unit9>
+        <Filename Value="utrwsync.pp"/>
+        <IsPartOfProject Value="True"/>
+      </Unit9>
+      <Unit10>
+        <Filename Value="utformat.pp"/>
+        <IsPartOfProject Value="True"/>
+      </Unit10>
+      <Unit11>
+        <Filename Value="utfloattostr.pp"/>
+        <IsPartOfProject Value="True"/>
+      </Unit11>
+      <Unit12>
+        <Filename Value="utfilename.pp"/>
+        <IsPartOfProject Value="True"/>
+      </Unit12>
+      <Unit13>
+        <Filename Value="utffirst.pp"/>
+        <IsPartOfProject Value="True"/>
+      </Unit13>
+      <Unit14>
+        <Filename Value="utfile.pp"/>
+        <IsPartOfProject Value="True"/>
+      </Unit14>
+      <Unit15>
+        <Filename Value="utfexpand.pp"/>
+        <IsPartOfProject Value="True"/>
+      </Unit15>
+      <Unit16>
+        <Filename Value="utextractquote.pp"/>
+        <IsPartOfProject Value="True"/>
+      </Unit16>
+      <Unit17>
+        <Filename Value="utexec.pp"/>
+        <IsPartOfProject Value="True"/>
+      </Unit17>
+      <Unit18>
+        <Filename Value="utexpfncase.pp"/>
+        <IsPartOfProject Value="True"/>
+      </Unit18>
+      <Unit19>
+        <Filename Value="utbytesof.pp"/>
+        <IsPartOfProject Value="True"/>
+      </Unit19>
+      <Unit20>
+        <Filename Value="utdirex.pp"/>
+        <IsPartOfProject Value="True"/>
+      </Unit20>
+      <Unit21>
+        <Filename Value="utencoding.pp"/>
+        <IsPartOfProject Value="True"/>
+      </Unit21>
+      <Unit22>
+        <Filename Value="utencodingerr.pp"/>
+        <IsPartOfProject Value="True"/>
+      </Unit22>
+      <Unit23>
+        <Filename Value="utastrcmp.pp"/>
+        <IsPartOfProject Value="True"/>
+      </Unit23>
+      <Unit24>
+        <Filename Value="utsyshelpers.pp"/>
+        <IsPartOfProject Value="True"/>
+      </Unit24>
+      <Unit25>
+        <Filename Value="utstringhelp.pp"/>
+        <IsPartOfProject Value="True"/>
+      </Unit25>
+      <Unit26>
+        <Filename Value="utfattr.pp"/>
+        <IsPartOfProject Value="True"/>
+      </Unit26>
+      <Unit27>
+        <Filename Value="utenv.pp"/>
+        <IsPartOfProject Value="True"/>
+      </Unit27>
+      <Unit28>
+        <Filename Value="utdos.pp"/>
+        <IsPartOfProject Value="True"/>
+      </Unit28>
+      <Unit29>
+        <Filename Value="utdfexp.pp"/>
+        <IsPartOfProject Value="True"/>
+      </Unit29>
+      <Unit30>
+        <Filename Value="utfsearch.pp"/>
+        <IsPartOfProject Value="True"/>
+      </Unit30>
+      <Unit31>
+        <Filename Value="utverify.pp"/>
+        <IsPartOfProject Value="True"/>
+      </Unit31>
+      <Unit32>
+        <Filename Value="utstrcopy.pp"/>
+        <IsPartOfProject Value="True"/>
+      </Unit32>
+      <Unit33>
+        <Filename Value="utstrings1.pp"/>
+        <IsPartOfProject Value="True"/>
+      </Unit33>
+      <Unit34>
+        <Filename Value="utstringbuild.pp"/>
+        <IsPartOfProject Value="True"/>
+      </Unit34>
+      <Unit35>
+        <Filename Value="syssbh.inc"/>
+        <IsPartOfProject Value="True"/>
+      </Unit35>
+      <Unit36>
+        <Filename Value="syssb.inc"/>
+        <IsPartOfProject Value="True"/>
+      </Unit36>
+      <Unit37>
+        <Filename Value="utustringbuild.pp"/>
+        <IsPartOfProject Value="True"/>
+      </Unit37>
+      <Unit38>
+        <Filename Value="uttypinfo.pp"/>
+        <IsPartOfProject Value="True"/>
+      </Unit38>
+    </Units>
+  </ProjectOptions>
+  <CompilerOptions>
+    <Version Value="11"/>
+    <SearchPaths>
+      <IncludeFiles Value="$(ProjOutDir)"/>
+    </SearchPaths>
+    <Parsing>
+      <SyntaxOptions>
+        <UseAnsiStrings Value="False"/>
+      </SyntaxOptions>
+    </Parsing>
+  </CompilerOptions>
+  <Debugging>
+    <Exceptions Count="3">
+      <Item1>
+        <Name Value="EAbort"/>
+      </Item1>
+      <Item2>
+        <Name Value="ECodetoolError"/>
+      </Item2>
+      <Item3>
+        <Name Value="EFOpenError"/>
+      </Item3>
+    </Exceptions>
+  </Debugging>
+</CONFIG>

rtl/test/testrtl.pp

@@ -0,0 +1,22 @@
+{$h+}
+program testrtl;
+
+uses
+{$IFDEF unix} cthreads, {$ENDIF}
+  punit, sysutils, utsysutils,
+  utstrtotime, utstrcmp, utastrcmp, utwstrcmp, utuplow, utunifile,
+  utstrtobool, utscanf, utrwsync, utformat, utfloattostr, utfilename,
+  utffirst, utfile, utfexpand,utexpfncase,utextractquote, utexec,
+  utbytesof, utdirex, utencoding, utencodingerr, utsyshelpers,
+  utstringhelp, utfattr, utenv,utdfexp,utfsearch, utverify,
+  utstrcopy, utstrings1, utstringbuild, utustringbuild, uttypinfo, utclasses ;
+
+
+begin
+  SetTimeHook(@Now);
+  if IsExecInvocation then
+    Halt(Ord(Not TestExecInvocation))
+  else
+    RunAllSysTests;
+end.
+

rtl/test/tohelper.inc

@@ -0,0 +1,20 @@
+  Result:='';
+  V:=value;
+  if not AssertEquals('ToString',ValueAsString,V.ToString) then
+    Exit;
+  if not AssertEquals('ToBoolean',True,V.ToBoolean) then
+    Exit;
+  V:=0;
+  if not AssertEquals('ToBoolean',False,V.ToBoolean) then
+    Exit;
+  V:=value;
+  if not AssertEquals('ToHexString',ValueAshex,V.ToHexString) then
+    Exit;
+  if not AssertEquals('ToHexString',ValueAsHexDigString,V.ToHexString(ValueAsHexDig)) then
+    Exit;
+  if not AssertEquals('ToSingle',Single(Value+0.0),V.ToSingle,0.00001) then
+    Exit;
+  if not AssertEquals('ToDouble',Double(Value+0.0),V.ToDouble,0.00001) then
+    Exit;
+  if not AssertEquals('ToExtended',Extended(Value+0.0),V.ToExtended,0.00001) then
+    Exit;

rtl/test/unittest.cfg

@@ -0,0 +1,6 @@
+-n
+-S2
+-Fu../units/$fpctarget/
+-vwh
+-B
+

rtl/test/utastrcmp.pp

@@ -0,0 +1,171 @@
+unit utastrcmp;
+{$mode objfpc}
+{$h+}
+interface
+
+uses
+  {$ifdef unix}
+    {$ifdef darwin}iosxwstr{$else}cwstring{$endif},
+  {$endif unix}
+   SysUtils;
+
+implementation
+
+uses punit,utrtl;
+
+Function checka(ok : boolean; func : string; value : longint) : Boolean;
+
+begin
+  Result:=AssertTrue(Func+' failed, result = '+InTToStr(Value),Ok);
+end;
+
+Function tastrcmp : string;
+
+var
+  a, b: array[0..1] of char;
+  tmp : longint;
+begin
+  Result:='';
+  a[0] := #0; a[1] := #1;      //Empty string
+  b[0] := #0; b[1] := #0;      //Empty string with different char after end
+  tmp:=AnsiStrComp(a, b);      //should be zero because a=b
+  if not checka(tmp=0,'AnsiStrComp',tmp) then exit;
+  tmp:=AnsiStrIComp(a, b);     //should be zero because a=b
+  if not checka(tmp=0,'AnsiStrIComp',tmp) then exit;
+end;
+
+Var
+  teststr: string;
+
+Function check(b: boolean; testnr: longint) : Boolean;
+
+begin
+  Result:=AssertTrue(teststr+' error nr '+IntToStr(testnr),B);
+end;
+
+function testAnsiCompareText : string;
+begin
+  Result:='';
+  teststr:='AnsiCompareText';
+  if not Check(ansicomparetext('a', 'a') = 0, 1) then exit;
+  if not Check(ansicomparetext('a', 'A') = 0, 2) then exit;
+  if not Check(ansicomparetext('A', 'a') = 0, 3) then exit;
+  if not Check(ansicomparetext('a', 'b') < 0, 4) then exit;
+  if not Check(ansicomparetext('c', 'b') > 0, 5) then exit;
+  if not Check(ansicomparetext('abc', 'AbC') = 0, 6) then exit;
+  if not Check(ansicomparetext('0123456789', '0123456789') = 0, 7) then exit;
+  if not Check(ansicomparetext('', '0123456789') < 0, 8) then exit;
+  if not Check(ansicomparetext('AbC', '') > 0, 9) then exit;
+  if not Check(ansicomparetext('AbC', 'A') > 0, 10) then exit;
+  if not Check(ansicomparetext('AbC', 'Ab') > 0, 11) then exit;
+  if not Check(ansicomparetext('AbC', 'ab') > 0, 12) then exit;
+  if not Check(ansicomparetext('Ab'#0'C', 'ab'#0) > 0, 13) then exit;
+end;
+
+
+function testAnsiStrIComp : string;
+begin
+  Result:='';
+  teststr:='AnsiStrIComp';
+  if not Check(ansistricomp('a', 'a') = 0, 1) then exit;
+  if not Check(ansistricomp('a', 'A') = 0, 2) then exit;
+  if not Check(ansistricomp('A', 'a') = 0, 3) then exit;
+  if not Check(ansistricomp('a', 'b') < 0, 4) then exit;
+  if not Check(ansistricomp('c', 'b') > 0, 5) then exit;
+  if not Check(ansistricomp('abc', 'AbC') = 0, 6) then exit;
+  if not Check(ansistricomp('0123456789', '0123456789') = 0, 7) then exit;
+  if not Check(ansistricomp('', '0123456789') < 0, 8) then exit;
+  if not Check(ansistricomp('AbC', '') > 0, 9) then exit;
+  if not Check(ansistricomp('AbC', 'A') > 0, 10) then exit;
+  if not Check(ansistricomp('AbC', 'Ab') > 0, 11) then exit;
+  if not Check(ansistricomp('AbC', 'ab') > 0, 12) then exit;
+  if not Check(ansistricomp('Ab'#0'C', 'ab'#0) = 0, 13) then exit;
+end;
+
+
+Function testAnsiStrLComp : string;
+
+begin
+  Result:='';
+  teststr:='AnsiStrLComp';
+  if not Check (ansistrlcomp ('', '', 0) = 0, 1) then exit; { Trivial case. }
+  if not Check (ansistrlcomp ('a', 'a', 1) = 0, 2) then exit;       { Identity. }
+  if not Check (ansistrlcomp ('abc', 'abc', 3) = 0, 3) then exit;   { Multicharacter. }
+  if not Check (ansistrlcomp ('abc'#0, 'abcd', 4) < 0, 4) then exit;   { Length unequal. }
+  if not Check (ansistrlcomp ('abcd', 'abc'#0, 4) > 0, 5) then exit;
+  if not Check (ansistrlcomp ('abcd', 'abce', 4) < 0, 6) then exit;  { Honestly unequal. }
+  if not Check (ansistrlcomp ('abce', 'abcd', 4) > 0, 7) then exit;
+  if not Check (ansistrlcomp ('abce', 'abcd', 3) = 0, 10) then exit; { Count limited. }
+  if not Check (ansistrlcomp ('abce', 'abc', 3) = 0, 11) then exit;  { Count = length. }
+  if not Check (ansistrlcomp ('abcd', 'abce', 4) < 0, 12) then exit;  { Nudging limit. }
+  if not Check (ansistrlcomp ('abc', 'def', 0) = 0, 13) then exit;   { Zero count. }
+  if not Check (ansistrlcomp ('abc'#0'e', 'abc'#0'd', 5) > 0, 14) then exit;
+end;
+
+
+function testAnsiCompareStr : string;
+begin
+  Result:='';
+  teststr:='AnsiCompareStr';
+  if not Check (ansicomparestr ('', '') = 0, 1) then exit;              { Trivial case. }
+  if not Check (ansicomparestr ('a', 'a') = 0, 2) then exit;            { Identity. }
+  if not Check (ansicomparestr ('abc', 'abc') = 0, 3) then exit;        { Multicharacter. }
+  if not Check (ansicomparestr ('abc', 'abcd') < 0, 4) then exit;        { Length mismatches. }
+  if not Check (ansicomparestr ('abcd', 'abc') > 0, 5) then exit;
+  if not Check (ansicomparestr ('abcd', 'abce') < 0, 6) then exit;       { Honest miscompares. }
+  if not Check (ansicomparestr ('abce', 'abcd') > 0, 7) then exit;
+  if not Check (ansicomparestr ('abc'#0'e', 'abc'#0'd') > 0, 8) then exit;
+end;
+
+
+function testAnsiStrComp : string;
+begin
+  Result:='';
+  teststr:='AnsiStrComp';
+  if not Check (ansistrcomp ('', '') = 0, 1) then exit;              { Trivial case. }
+  if not Check (ansistrcomp ('a', 'a') = 0, 2) then exit;            { Identity. }
+  if not Check (ansistrcomp ('abc', 'abc') = 0, 3) then exit;        { Multicharacter. }
+  if not Check (ansistrcomp ('abc', 'abcd') < 0, 4) then exit;        { Length mismatches. }
+  if not Check (ansistrcomp ('abcd', 'abc') > 0, 5) then exit;
+  if not Check (ansistrcomp ('abcd', 'abce') < 0, 6) then exit;       { Honest miscompares. }
+  if not Check (ansistrcomp ('abce', 'abcd') > 0, 7) then exit;
+  if not Check (ansistrcomp ('abc'#0'e', 'abc'#0'd') = 0, 8) then exit;
+end;
+
+
+Function testAnsiStrLIComp : string;
+begin
+  Result:='';
+  teststr:='AnsiStrLIComp';
+  if not Check(ansistrlicomp('a', 'a', 1) = 0, 1) then exit;
+  if not Check(ansistrlicomp('a', 'A', 1) = 0, 2) then exit;
+  if not Check(ansistrlicomp('A', 'a', 1) = 0, 3) then exit;
+  if not Check(ansistrlicomp('a', 'b', 1) < 0, 4) then exit;
+  if not Check(ansistrlicomp('c', 'b', 1) > 0, 5) then exit;
+  if not Check(ansistrlicomp('abc', 'AbC', 3) = 0, 6) then exit;
+  if not Check(ansistrlicomp('0123456789', '0123456789', 10) = 0, 7) then exit;
+  if not Check(ansistrlicomp(#0'123456789', #0'123456799', 10) < 0, 8) then exit;
+  if not Check(ansistrlicomp(#0'bD', #0'bC', 3) > 0, 9) then exit;
+  if not Check(ansistrlicomp('AbC', 'A'#0#0,3) > 0, 10) then exit;
+  if not Check(ansistrlicomp('AbC', 'Ab'#0, 3) > 0, 11) then exit;
+  if not Check(ansistrlicomp('AbC', 'ab'#0, 3) > 0, 12) then exit;
+  if not Check(ansistrlicomp('0123456789', 'AbC', 0) = 0, 13) then exit;
+  if not Check(ansistrlicomp('AbC', 'abc', 1) = 0, 14) then exit;
+  if not Check(ansistrlicomp('AbC', 'abc', 2) = 0, 15) then exit;
+  if not Check(ansistrlicomp('AbC', 'abc', 3) = 0, 16) then exit;
+  if not Check(ansistrlicomp('AbC', 'abcd', 3) = 0, 17) then exit;
+  if not Check(ansistrlicomp('AbCc', 'abcd', 4) < 0, 18) then exit;
+  if not Check(ansistrlicomp('ADC', 'abcd', 1) = 0, 19) then exit;
+  if not Check(ansistrlicomp('ADC', 'abcd', 2) > 0, 20) then exit;
+  if not Check(ansistrlicomp('abc'#0'e', 'abc'#0'd', 5) > 0, 21) then exit;
+end;
+
+
+begin
+  SysutilsTest('testAnsiCompareText',@testAnsiCompareText);
+  SysutilsTest('testAnsiStrIComp',@testAnsiStrIComp);
+  SysutilsTest('testAnsiStrLComp',@testAnsiStrLComp);
+  SysutilsTest('testAnsiCompareStr',@testAnsiCompareStr);
+  SysutilsTest('testAnsiStrComp',@testAnsiStrComp);
+  SysutilsTest('testAnsiStrLIComp',@testAnsiStrLIComp);
+end.

rtl/test/utbytesof.pp

@@ -0,0 +1,76 @@
+unit utbytesof;
+
+{$mode objfpc}{$H+}
+interface
+
+uses
+  SysUtils, Classes;
+
+Implementation
+
+uses punit,utrtl;
+
+function CheckBytes(const B: TBytes): Boolean;
+const
+  Etalon: array[0..3] of Byte = (84, 101, 115, 116);
+var
+  I: Integer;
+begin
+  Result := Length(B) <= Length(Etalon);
+  if Result then
+    for I := Low(B) to High(B) do
+      Result := Result and (B[I] = Etalon[I]);
+end;
+
+function CheckWideBytes(const B: TBytes): Boolean;
+const
+  Etalon: array[0..7] of Byte = (
+{$ifdef FPC_BIG_ENDIAN}
+   00, 84, 00, 101, 00, 115, 00, 116
+{$else}
+   84, 00, 101, 00, 115, 00, 116, 00
+{$endif}
+  );
+var
+  I: Integer;
+begin
+  Result := Length(B) <= Length(Etalon);
+  if Result then
+    for I := Low(B) to High(B) do
+      Result := Result and (B[I] = Etalon[I]);
+end;
+
+Function CheckBytesOf : AnsiString;
+
+var
+  S: AnsiString;
+  U: UnicodeString;
+  B: TBytes;
+begin
+  Result:='';
+  S := 'Test';
+  U := S;
+  B := BytesOf(S);
+  if not CheckBytes(B) then
+    Exit('Error at 1');
+  if StringOf(B) <> U then
+    Exit('Error at 2');
+  B := BytesOf(S[1]);
+  if not CheckBytes(B) then
+    Exit('Error at 3');
+  B := BytesOf(U);
+  if not CheckBytes(B) then
+    Exit('Error at 4');
+  B := BytesOf(U[1]);
+  if not CheckBytes(B) then
+    Exit('Error at 5');
+  B := WideBytesOf(U);
+  if not CheckWideBytes(B) then
+    Exit('Error at 6');
+  if WideStringOf(B) <> U then
+    Exit('Error at 7');
+end;
+    
+begin
+  SysUtilsTest('BytesOf',@CheckBytesOf);    
+end.

rtl/test/utclasses.pp

@@ -0,0 +1,1390 @@
+unit utclasses;
+
+{$mode objfpc}{$H+}
+{$INTERFACES CORBA}
+
+interface
+
+uses
+  SysUtils, Classes, punit, utrtl;
+  
+implementation 
+  
+Function TestBytesStream : Ansistring;
+
+var
+  BS: TBytesStream;
+  MS: TMemoryStream;
+  B: TBytes;
+begin
+  Result:='';
+  B := TBytes.Create(1, 2, 3);
+  BS := TBytesStream.Create(B);
+  // save it to regular memory stream
+  MS := TMemoryStream.Create;
+  try
+    BS.SaveToStream(MS);
+  finally
+    BS.Free;
+  end;
+
+  // now restore and compare
+  BS := TBytesStream.Create;
+  try
+    MS.Position := 0;
+    BS.LoadFromStream(MS);
+    B := BS.Bytes;
+    if not AssertTrue('Bytes differ',not (Length(B) < 3) or (B[0] <> 1) or (B[1] <> 2) or (B[2] <> 3)) then
+      Exit;
+  finally
+    BS.Free;
+  end;
+  MS.Free;
+end;
+
+
+type
+ tenum = (eena,eenb,eenc,eend,eene,eenf,eeng,eenh,eeni);
+ tset = set of tenum;
+
+ ttestclass1 = class(tcomponent)
+  private
+   fprop1: tset;
+  public
+   property prop1: tset read fprop1 write fprop1 stored true;
+ end;
+
+ ttestclass2 = class(ttestclass1)
+  published
+   property prop1;
+ end;
+
+function TestStoredfalse : Ansistring;
+
+var
+ testclass2,testclass3: ttestclass2;
+ stream1,stream2: tmemorystream;
+ str1: ansistring;
+begin
+  Result:='';
+  str1:='';
+ testclass2:= ttestclass2.create(nil);
+ testclass2.prop1:= [eenb,eend,eene,eenh,eeni];
+ stream1:= tmemorystream.create;
+ try
+  stream1.writecomponent(testclass2);
+  stream2:= tmemorystream.create;
+  try
+   stream1.position:= 0;
+   objectbinarytotext(stream1,stream2);
+   stream1.position:= 0;
+   stream2.position:= 0;
+   setlength(str1,stream2.size);
+   move(stream2.memory^,str1[1],length(str1));
+   testclass3:=ttestclass2.create(nil);
+   stream1.readcomponent(testclass3);
+   if not AssertTrue('Property set',testclass3.prop1=[eenb,eend,eene,eenh,eeni]) then
+     Exit;
+  finally
+   stream2.free;
+  end;
+ finally
+  stream1.free;
+ end;
+end;
+
+
+type
+  TMyStringList = class(TStringList)
+  protected
+    ExchangeCount: LongInt;
+    procedure ExchangeItems(aLeft, aRight: Integer); override;
+  end;
+  
+procedure TMyStringList.ExchangeItems(aLeft, aRight: Integer);
+begin
+  Inc(ExchangeCount);
+  inherited ExchangeItems(aLeft, aRight);
+end;
+
+procedure FillStringList(aList: TStrings);
+begin
+  aList.Add('Beta');
+  aList.Add('Gamma');
+  aList.Add('Alpha');
+  aList.Add('Delta');
+end;
+
+type
+  TDummy = class
+    ExchangeCount: LongInt;
+    procedure Change(aSender: TObject);
+  end;
+  
+procedure TDummy.Change(aSender: TObject);
+begin
+  Inc(ExchangeCount);
+end;
+
+Function Testtstringlistexchange : Ansistring;
+
+var
+  sl: TStringList;
+  msl: TMyStringList;
+  dummy: TDummy;
+begin
+  Result:='';
+  dummy := TDummy.Create;
+  try
+    sl := TStringList.Create;
+    try
+      FillStringList(sl);
+      sl.OnChange := @dummy.Change;
+      sl.Sort;
+      // only OnChange call in TStringList.Sort
+      If not AssertEquals(' OnChange call in TStringList.Sort',1, dummy.ExchangeCount) then
+        Exit;
+    finally
+      sl.Free;
+    end;
+
+    dummy.ExchangeCount := 0;
+    
+    msl := TMyStringList.Create;
+    try
+      FillStringList(msl);
+      msl.OnChange := @dummy.Change;
+      msl.Sort;
+      // TMyStringList.ExchangeItems called 5 times
+      if Not AssertEquals('TMyStringList.ExhangeItems call count',3,msl.ExchangeCount) then
+        Exit;
+      // OnChange called once in Sort
+      if Not AssertEquals('Dummy.OnChange',1,dummy.ExchangeCount) then
+        Exit
+    finally
+      msl.Free;
+    end;
+  finally
+    dummy.Free;
+  end;
+end;
+
+
+type
+  TDummyVCLComObject = class(TInterfacedObject, IVCLComObject)
+  public
+    function GetTypeInfoCount(out Count: Integer): HResult; stdcall;
+    function GetTypeInfo(Index, LocaleID: Integer; out TypeInfo): HResult; stdcall;
+    function GetIDsOfNames(const IID: TGUID; Names: Pointer;
+      NameCount, LocaleID: Integer; DispIDs: Pointer): HResult; stdcall;
+    function Invoke(DispID: Integer; const IID: TGUID; LocaleID: Integer;
+      Flags: Word; var Params; VarResult, ExcepInfo, ArgErr: Pointer): HResult; stdcall;
+    function SafeCallException(ExceptObject: TObject;
+      ExceptAddr: Pointer): HResult; override;
+    procedure FreeOnRelease;
+  end;
+var
+  c: TComponent;
+  v: IVCLComObject;
+
+procedure DoCreateVCLComObject(Component: TComponent);
+begin
+  Component.VCLComObject := Pointer(V);
+end;
+
+{ TDummyVCLComObject }
+
+procedure TDummyVCLComObject.FreeOnRelease;
+begin
+
+end;
+
+
+function TDummyVCLComObject.GetIDsOfNames(const IID: TGUID; Names: Pointer;
+  NameCount, LocaleID: Integer; DispIDs: Pointer): HResult;stdcall;
+begin
+  Result := E_NOTIMPL;
+end;
+
+function TDummyVCLComObject.GetTypeInfo(Index, LocaleID: Integer;
+  out TypeInfo): HResult;stdcall;
+begin
+  Result := E_NOTIMPL;
+end;
+
+function TDummyVCLComObject.GetTypeInfoCount(out Count: Integer): HResult;stdcall;
+begin
+  Result := E_NOTIMPL;
+end;
+
+function TDummyVCLComObject.Invoke(DispID: Integer; const IID: TGUID;
+  LocaleID: Integer; Flags: Word; var Params; VarResult, ExcepInfo,
+  ArgErr: Pointer): HResult;stdcall;
+begin
+  Result := E_NOTIMPL;
+end;
+
+function TDummyVCLComObject.SafeCallException(ExceptObject: TObject;
+  ExceptAddr: Pointer): HResult;
+begin
+  Result := E_UNEXPECTED;
+end;
+
+Function Testvclcomobject : Ansistring;
+
+begin
+  Result:='';
+  v := TDummyVCLComObject.Create;
+  CreateVCLComObjectProc := @DoCreateVCLComObject;
+  c := TComponent.Create(nil);
+  if c.ComObject = nil then
+    Result:='No Comobject';
+  c.Free;
+  v := nil;
+end;
+
+Function TestLineBreak : String;
+
+var
+  tmp: TStrings;
+begin
+  tmp := TStringList.Create();
+  try
+    tmp.LineBreak := ',';
+    tmp.Text := 'a,b,c';
+    If tmp.Count<>3 then
+      exit('Count needs to be 3');
+    if tmp[0]<>'a' then
+      exit('First element a');  
+    if tmp[1]<>'b' then
+      exit('Second element b');  
+    if tmp[2]<>'c' then
+      exit('Third element c');  
+  finally
+    tmp.Free;
+  end;
+end;
+
+Function TestAlwaysQuote : String;
+
+Const
+  ResD  = 'ItemOne,ItemTwo,ItemThree,''Item With Spaces''';
+  ResAQ = '''ItemOne'',''ItemTwo'',''ItemThree'',''Item With Spaces''';
+  
+
+Var 
+  L : TStringList;
+  
+Begin
+  L:=TStringList.Create;
+  try
+    With L do
+      begin
+      Add('ItemOne');
+      Add('ItemTwo');
+      Add('ItemThree');
+      Add('Item With Spaces');
+      QuoteChar := '''';
+      if DelimitedText<>ResD then
+        Exit('Default fails');
+      AlwaysQuote := True;  
+      if DelimitedText<>ResAQ then
+        Exit('AlwaysQuote fails');
+      end;                       
+  finally
+    L.Free;
+  end;        
+end;
+
+Function TestGetNameValue : string;
+
+var
+  l: tstringlist;
+begin
+  l:= tstringlist.create;
+  try
+  l.add('bb');
+  l.MissingNameValueSeparatorAction:=mnvaValue; 
+  If not (l.ValueFromIndex[0]='bb') then
+    Exit('mnvaValue value error');
+  If not (l.Names[0]='') then
+    Exit('mnvaValue name error');
+  l.MissingNameValueSeparatorAction:=mnvaName; 
+  If not (l.ValueFromIndex[0]='') then
+    Exit('mnvaName value error');
+  If not (l.Names[0]='bb') then
+    Exit('mnvaName name error');
+  l.MissingNameValueSeparatorAction:=mnvaEmpty; 
+  If not (l.ValueFromIndex[0]='') then
+    Exit('mnvaEmpty value error');
+  If not (l.Names[0]='') then
+    Exit('mnvaEmptyerror');
+  l.MissingNameValueSeparatorAction:=mnvaError; 
+  try 
+    Writeln(l.ValueFromIndex[0]);
+    Exit('mnvError value error');
+  except
+    // Ignore, expected
+  end;
+  finally
+    L.free;
+  end;   
+end;
+
+
+type
+  TItem = class
+  public
+    Value: Integer;
+    constructor Create(aValue: Integer);
+  end;
+  TSortParameter = class
+  public
+    Desc: Boolean;
+  end;
+
+  { TItem }
+
+  constructor TItem.Create(aValue: Integer);
+  begin
+    inherited Create;
+    Value := aValue;
+  end;
+
+  function Compare(Item1, Item2, Context: Pointer): Integer;
+  var
+    xItem1: TItem absolute Item1;
+    xItem2: TItem absolute Item2;
+    xParam: TSortParameter absolute Context;
+  begin
+    Result := xItem1.Value-xItem2.Value;
+    if xParam.Desc then
+      Result := -Result;
+  end;
+
+
+
+Function TestSortContext : String;
+
+var
+  L: TList;
+  I: Integer;
+  B: Boolean;
+  P: TSortParameter;
+
+  Procedure FreeItems;
+
+  var
+    I : integer;
+
+  begin
+    for I:=0 to L.Count-1 do
+      TObject(L[i]).Free;
+  end;
+
+begin
+  L := TList.Create;
+  try
+    for I := 1 to 5 do
+      L.Add(TItem.Create(I));
+    P := TSortParameter.Create;
+    for B in Boolean do
+      begin
+      P.Desc := B;
+      L.Sort(@Compare, P);
+      if not B then
+        begin
+        For I:=1 to 5 do
+          If (TItem(L[i-1]).Value<>i) then
+             Exit(Format('ASC Error at %d',[I]));
+        end
+      else
+        For I:=1 to 5 do
+          If (TItem(L[i-1]).Value<>6-i) then
+             Exit(Format('DESC Error at %d',[I]));
+      end;
+
+  finally
+    P.Free;
+    FreeItems;
+    L.Free;
+  end;
+end;
+
+
+Function TestStringListReverse1: String;
+
+Var
+  L,l2 : TStringList;
+  I : Integer;
+
+begin
+  Result:='';
+  L2:=Nil;
+  L:=TStringList.Create;
+  try
+    L2:=TStringList.Create;
+    For I:=1 to 3 do
+      L.Add(IntToStr(I));
+    L.Reverse(L2);
+    For I:=0 to 2 do
+      if not AssertEquals('Item'+IntToStr(I),L[2-I],L2[I]) then exit;
+  finally
+    L.Free;
+    L2.Free;
+  end;
+
+end;
+
+Function TestStringListReverse2: String;
+
+Var
+  L,l2 : TStrings;
+  I : Integer;
+
+begin
+  Result:='';
+  L2:=Nil;
+  L:=TStringList.Create;
+  try
+    For I:=1 to 3 do
+      L.Add(IntToStr(I));
+    L2:=L.Reverse;
+    if not AssertEquals('Classname',L.ClassName,L2.ClassName) then exit;
+    For I:=0 to 2 do
+      if not AssertEquals('Item'+IntToStr(I),L[2-I],L2[I]) then exit;
+  finally
+    L.Free;
+    L2.Free;
+  end;
+end;
+
+Function TestStringsIndexOfStartAt : String;
+
+Var
+  L : TStrings;
+  I : Integer;
+
+begin
+  Result:='';
+  L:=TStringList.Create;
+  try
+    For I:=1 to 3 do
+      L.Add(IntToStr(I));
+    For I:=1 to 3 do
+      L.Add(IntToStr(I));
+    if not AssertEquals('Start at 0',2,L.IndexOf('3')) then exit;
+    if not AssertEquals('Start at 1',2,L.IndexOf('3',1)) then exit;
+    if not AssertEquals('Start at 2',2,L.IndexOf('3',2)) then exit;
+    if not AssertEquals('Start at 3',5,L.IndexOf('3',3)) then exit;
+    if not AssertEquals('Start at -1',5,L.IndexOf('3',-1)) then exit;
+  finally
+    L.Free;
+  end;
+end;
+
+Function TestStringsLastIndexOfStartAt : String;
+
+Var
+  L : TStrings;
+  I : Integer;
+
+begin
+  Result:='';
+  L:=TStringList.Create;
+  try
+    For I:=1 to 3 do
+      L.Add(IntToStr(I));
+    For I:=1 to 3 do
+      L.Add(IntToStr(I));
+    if not AssertEquals('Start at 0',5,L.LastIndexOf('3')) then exit;
+    if not AssertEquals('Start at 1',-1,L.LastIndexOf('3',1)) then exit;
+    if not AssertEquals('Start at 2',2,L.LastIndexOf('3',2)) then exit;
+    if not AssertEquals('Start at 3',2,L.LastIndexOf('3',3)) then exit;
+    if not AssertEquals('Start at -1',5,L.LastIndexOf('3',-1)) then exit;
+    if not AssertEquals('Start at -2',2,L.LastIndexOf('3',-2)) then exit;
+  finally
+    L.Free;
+  end;
+end;
+
+Function TestSlice: String;
+
+Var
+  L,l2 : TStrings;
+  I : Integer;
+
+begin
+  Result:='';
+  L:=TStringList.Create;
+  try
+    L2:=TStringList.Create;
+    For I:=1 to 3 do
+      L.Add(IntToStr(I));
+    L.Slice(1,l2);
+    if not AssertEquals('Item count',2,L2.Count) then exit;
+    if not AssertEquals('Item 0','2',L2[0]) then exit;
+    if not AssertEquals('Item 1','3',L2[1]) then exit;
+  finally
+    L2.Free;
+    L.Free;
+  end;
+end;
+
+Function TestSlice2 : String;
+
+Var
+  L,l2 : TStrings;
+  I : Integer;
+
+begin
+  Result:='';
+  L:=TStringList.Create;
+  try
+    For I:=1 to 3 do
+      L.Add(IntToStr(I));
+    L2:=L.Slice(1);
+    if not AssertEquals('Classname',L.ClassName,L2.ClassName) then exit;
+    if not AssertEquals('Item count',2,L2.Count) then exit;
+    if not AssertEquals('Item 0','2',L2[0]) then exit;
+    if not AssertEquals('Item 1','3',L2[1]) then exit;
+  finally
+    L2.Free;
+    L.Free;
+  end;
+end;
+
+Function TestFill : String;
+
+Var
+  L : TStrings;
+  I : Integer;
+
+begin
+  Result:='';
+  L:=TStringList.Create;
+  try
+    For I:=1 to 10 do
+      L.Add(IntToStr(I));
+    L.Fill(' ',3,7);
+    For I:=1 to 3 do
+      AssertEquals(IntToStr(I),IntToStr(I),L[i-1]);
+    For I:=3 to 7 do
+      AssertEquals(IntToStr(I),' ',L[i]);
+    For I:=9 to 10 do
+      AssertEquals(IntToStr(I),IntToStr(I),L[i-1]);
+  finally
+    L.Free;
+  end;
+end;
+
+Function TestFill2 : String;
+
+Var
+  L : TStrings;
+  I : Integer;
+
+begin
+  Result:='';
+  L:=TStringList.Create;
+  try
+    For I:=1 to 10 do
+      L.Add(IntToStr(I));
+    L.Fill(' ',3,-3);
+    For I:=1 to 3 do
+      AssertEquals(IntToStr(I),IntToStr(I),L[i-1]);
+    For I:=3 to 7 do
+      AssertEquals(IntToStr(I),' ',L[i]);
+    For I:=9 to 10 do
+      AssertEquals(IntToStr(I),IntToStr(I),L[i-1]);
+  finally
+    L.Free;
+  end;
+end;
+
+Type
+  TFilterStringList = Class(TStringList)
+   function DoFilter (const s: string): boolean;
+  end;
+
+function TFilterStringList.DoFilter (const s: string): boolean;
+
+begin
+  Result:=StrToInt(S)<6;
+end;
+
+
+Function TestFilter : String;
+
+Var
+  L : TFilterStringList;
+  L2 : TStrings;
+  I : Integer;
+
+begin
+  Result:='';
+  L:=TFilterStringList.Create;
+  try
+    For I:=1 to 10 do
+      L.Add(IntToStr(I));
+    L2:=L.Filter(@L.DoFilter);
+    if not AssertEquals('Classname',L.ClassName,L2.ClassName) then exit;
+    if not AssertEquals('Count',5,L2.Count) then exit;
+    For I:=1 to 5 do
+      AssertEquals(IntToStr(I),IntToStr(I),L2[i-1]);
+  finally
+    L.Free;
+    L2.Free;
+  end;
+end;
+
+Function TestFilter2 : String;
+
+Var
+  L : TFilterStringList;
+  L2 : TStrings;
+  I : Integer;
+
+begin
+  Result:='';
+  L2:=Nil;
+  L:=TFilterStringList.Create;
+  try
+    For I:=1 to 10 do
+      L.Add(IntToStr(I));
+    L2:=TStringList.Create;
+    L.Filter(@L.DoFilter,L2);
+    if not AssertEquals('Classname',L.ClassName,L2.ClassName) then exit;
+    if not AssertEquals('Count',5,L2.Count) then exit;
+    For I:=1 to 5 do
+      AssertEquals(IntToStr(I),IntToStr(I),L2[i-1]);
+  finally
+    L.Free;
+    L2.Free;
+  end;
+end;
+
+Type
+  TMapStringList = Class(TStringList)
+   function DoMap (const s: string): String;
+  end;
+
+function TMapStringList.DoMap (const s: string): string;
+
+begin
+  Result:=IntToStr(StrToInt(S)+10);
+end;
+
+Function TestMap : String;
+
+Var
+  L : TMapStringList;
+  L2 : TStrings;
+  I : Integer;
+
+begin
+  Result:='';
+  L:=TMapStringList.Create;
+  try
+    For I:=1 to 10 do
+      L.Add(IntToStr(I));
+    L2:=L.Map(@L.DoMap);
+    if not AssertEquals('Classname',L.ClassName,L2.ClassName) then exit;
+    if not AssertEquals('Count',10,L2.Count) then exit;
+    For I:=1 to 10 do
+      AssertEquals(IntToStr(I),IntToStr(I+10),L2[i-1]);
+  finally
+    L.Free;
+    L2.Free;
+  end;
+end;
+
+
+Function TestMap2 : String;
+
+Var
+  L : TMapStringList;
+  L2 : TStrings;
+  I : Integer;
+
+begin
+  Result:='';
+  L:=TMapStringList.Create;
+  try
+    For I:=1 to 10 do
+      L.Add(IntToStr(I));
+    L2:=TStringList.Create;
+    L.Map(@L.DoMap,L2);
+    if not AssertEquals('Count',10,L2.Count) then exit;
+    For I:=1 to 10 do
+      AssertEquals(IntToStr(I),IntToStr(I+10),L2[i-1]);
+  finally
+    L.Free;
+    L2.Free;
+  end;
+end;
+
+Type
+  TReduceStringList = Class(TStringList)
+   function DoReduce (const s1,s2: string): String;
+  end;
+
+function TReduceStringList.DoReduce (const s1,s2: string): String;
+
+begin
+  Result:=IntToStr(StrToInt(S1)+StrToInt(S2));
+end;
+
+Function TestReduce : String;
+
+Var
+  L : TReduceStringList;
+  S : String;
+  I : Integer;
+
+begin
+  Result:='';
+  L:=TReduceStringList.Create;
+  try
+    For I:=1 to 10 do
+      L.Add(IntToStr(I));
+    S:=L.Reduce(@L.DoReduce,'0');
+    If not AssertEquals('Correct','55',S) then exit;
+  finally
+    L.Free;
+  end;
+end;
+
+Function TestPop : String;
+
+Var
+  L : TStringList;
+  I : Integer;
+
+begin
+  Result:='';
+  L:=TStringList.Create;
+  try
+    For I:=1 to 10 do
+      L.Add(IntToStr(I));
+    For I:=10 downto 1 do
+      If not AssertEquals('Correct pop '+IntToStr(I),IntToStr(I),L.Pop) then exit;
+    If not AssertEquals('Correct pop at last','',L.Pop) then exit;
+  finally
+    L.Free;
+  end;
+end;
+
+Function TestShift : String;
+
+Var
+  L : TStringList;
+  I : Integer;
+
+begin
+  Result:='';
+  L:=TStringList.Create;
+  try
+    For I:=1 to 10 do
+      L.Add(IntToStr(I));
+    For I:=1 to 10 do
+      If not AssertEquals('Correct shift '+IntToStr(I),IntToStr(I),L.Shift) then exit;
+    If not AssertEquals('Correct shift at last','',L.shift) then exit;
+  finally
+    L.Free;
+  end;
+end;
+
+Type
+  TForeachStringList = Class(TStringList)
+   Public
+   res : String;
+   Procedure DoForeach (const s1: string);
+  end;
+
+Procedure TForeachStringList.DoForEach(Const S1 : String);
+
+begin
+  Res:=res+S1;
+end;
+
+Function TestForeach : String;
+
+Var
+  L : TForeachStringList;
+  I : Integer;
+
+begin
+  Result:='';
+  L:=TForeachStringList.Create;
+  try
+    For I:=1 to 10 do
+      L.Add(IntToStr(I));
+    L.Foreach(@L.DoForeach);
+    If not AssertEquals('Correct','12345678910',L.Res) then exit;
+  finally
+    L.Free;
+  end;
+end;
+
+Type
+  TForeachExStringList = Class(TStringList)
+   Public
+   res : String;
+   Procedure DoForeach (const s1: string; const aIndex : integer);
+  end;
+
+Procedure TForeachExStringList.DoForEach(Const S1 : String; const aIndex : integer);
+
+begin
+  Res:=res+S1+IntToStr(aIndex);
+end;
+
+Function TestForeachEx : String;
+
+Var
+  L : TForeachExStringList;
+  I : Integer;
+
+begin
+  Result:='';
+  L:=TForeachExStringList.Create;
+  try
+    For I:=1 to 10 do
+      L.Add(IntToStr(I));
+    L.Foreach(@L.DoForeach);
+    If not AssertEquals('Correct','102132435465768798109',L.Res) then exit;
+  finally
+    L.Free;
+  end;
+end;
+
+function CompareStringLists(Expected,TestSL : TStrings):string;
+
+var
+  I : Integer;
+
+begin
+  Result:='';
+  if Expected.Count<>TestSL.Count then
+    Exit('count mismatch: '+ inttostr(TestSL.Count)+' test strings; '+inttostr(Expected.Count)+' expected strings.');
+  for i:=0 to TestSL.Count-1 do
+    if (Expected.Count>i) and (TestSL[i]<>Expected[i]) then
+      Exit('Line '+IntToStr(i)+' mismatch, expected *'+Expected[i]+'*, got: *'+TestSL[i]);
+end;
+
+function ReadStrictDelimFalse:string;
+// Test if input works with Delphi-compatible sdf output
+// Strictdelimiter:=false (default) when processing the delimitedtext
+//
+// Mainly check if reading quotes is according to Delphi sdf specs and works.
+// Based on del4.zip in bug 19610
+const
+  // Matches del4.zip in bug 19610:
+  DelimText='normal_string;"quoted_string";"quoted;delimiter";"quoted and space";"""quoted_and_starting_quote";"""quoted, starting quote, and space";"quoted_with_tab'+#9+'character";"quoted_multi'+LineEnding+
+    'line";  UnquotedSpacesInfront;UnquotedSpacesAtTheEnd   ;  "Spaces before quoted string"';
+
+var
+  TestSL: TStringList;
+  Expected: TStringList;
+begin
+  //Expected values:
+  Expected:=TStringList.Create;
+  TestSL:=TStringList.Create;
+  try
+    Expected.Add('normal_string');
+    Expected.Add('quoted_string');
+    Expected.Add('quoted;delimiter');
+    Expected.Add('quoted and space');
+    Expected.Add('"quoted_and_starting_quote');
+    Expected.Add('"quoted, starting quote, and space');
+    Expected.Add('quoted_with_tab'+#9+'character');
+    Expected.Add('quoted_multi'+LineEnding+'line');
+    Expected.Add('UnquotedSpacesInfront');
+    Expected.Add('UnquotedSpacesAtTheEnd');
+    Expected.Add('Spaces before quoted string');
+
+    TestSL.Delimiter:=';'; //Match example in bug 19610, del4.zip
+    TestSL.StrictDelimiter:=false;
+    TestSL.DelimitedText:=DelimText;
+    Result:=CompareStringLists(Expected,TestSL);
+  finally
+    Expected.Free;
+    TestSL.Free;
+  end;
+end;
+
+function ReadStrictDelimTrue: string;
+// Test if input works with Delphi-compatible sdf output
+// Strictdelimiter:=true when processing the delimitedtext
+//
+// Mainly check if reading quotes is according to Delphi sdf specs and works.
+// Based on del4.zip in bug 19610
+const
+  // Matches del4.zip in bug 19610:
+  DelimText='normal_string;"quoted_string";"quoted;delimiter";"quoted and space";"""quoted_and_starting_quote";"""quoted, starting quote, and space";"quoted_with_tab'+#9+'character";"quoted_multi'+LineEnding+
+    'line";  UnquotedSpacesInfront;UnquotedSpacesAtTheEnd   ;  "Spaces before quoted string"';
+
+var
+  TestSL: TStringList;
+  Expected: TStringList;
+begin
+  result:='';
+  //Expected values:
+  Expected:=TStringList.Create;
+  TestSL:=TStringList.Create;
+  try
+    Expected.Add('normal_string');
+    Expected.Add('quoted_string');
+    Expected.Add('quoted;delimiter');
+    Expected.Add('quoted and space');
+    Expected.Add('"quoted_and_starting_quote');
+    Expected.Add('"quoted, starting quote, and space');
+    Expected.Add('quoted_with_tab'+#9+'character');
+    Expected.Add('quoted_multi'+LineEnding+'line');
+    Expected.Add('  UnquotedSpacesInfront');
+    Expected.Add('UnquotedSpacesAtTheEnd   ');
+    Expected.Add('  "Spaces before quoted string"');
+
+    TestSL.Delimiter:=';'; //Match example in bug 19610, del4.zip
+    TestSL.StrictDelimiter:=true;
+    TestSL.DelimitedText:=DelimText;
+    Result:=CompareStringLists(Expected,TestSL);
+  finally
+    Expected.Free;
+    TestSL.Free;
+  end;
+end;
+
+function ReadStrictDelimFalseCornerCases: String;
+
+// Test if input works with Delphi-compatible sdf output
+// Strictdelimiter:=false (default) when processing the delimitedtext
+//
+// Has some corner cases that Delphi produces but are not evident from their
+// documentation
+// Based on del4.zip in bug 19610
+const
+  // Matches del4.zip in bug 19610:
+  DelimText='"Spaces after quoted string"   ;';
+
+var
+  TestSL: TStringList;
+  Expected: TStringList;
+begin
+  result:='';
+  //Expected values:
+  Expected:=TStringList.Create;
+  TestSL:=TStringList.Create;
+  try
+    Expected.Add('Spaces after quoted string');
+    Expected.Add('');
+
+    TestSL.Delimiter:=';'; //Match example in bug 19610, del4.zip
+    TestSL.StrictDelimiter:=false;
+    TestSL.DelimitedText:=DelimText;
+    Result:=CompareStringLists(Expected,TestSL);
+  finally
+    Expected.Free;
+    TestSL.Free;
+  end;
+end;
+
+function ReadStrictDelimTrueCornerCases: string;
+// Test if input works with Delphi-compatible sdf output
+// Strictdelimiter:=true when processing the delimitedtext
+//
+// Has some corner cases that Delphi produces but are not evident from their
+// documentation
+// Based on del4.zip in bug 19610
+const
+  // Matches del4.zip in bug 19610:
+  DelimText='"Spaces after quoted string"   ;';
+
+var
+  TestSL: TStringList;
+  Expected: TStringList;
+begin
+  Result:='';
+  //Expected values:
+  Expected:=TStringList.Create;
+  TestSL:=TStringList.Create;
+  try
+    // With delimiter true, we get 2 extra empty lines, also some spaces
+    Expected.Add('Spaces after quoted string');
+    Expected.Add('   ');
+    Expected.Add('');
+
+    TestSL.Delimiter:=';'; //Match example in bug 19610, del4.zip
+    TestSL.StrictDelimiter:=true;
+    TestSL.DelimitedText:=DelimText;
+    //Test:
+    Result:=CompareStringLists(Expected,TestSL);
+  finally
+    Expected.Free;
+    TestSL.Free;
+  end;
+end;
+
+function ReadStrictDelimTrueSafeQuote:string;
+// Test if input works with sdf output that has always been quoted
+// Delphi accepts this input even though it does not write it by default
+// This is a more unambiguous format than unquoted
+// Strictdelimiter:=true when processing the delimitedtext
+//
+const
+  DelimText='"normal_string";"""quoted_string""";"""quoted;delimiter""";"""quoted and space""";"""starting_quote";"string_with_tab'+#9+'character";"multi'+LineEnding+
+    'line";"  SpacesInfront";"SpacesAtTheEnd   ";"  ""Spaces before quoted string"""';
+
+var
+  TestSL: TStringList;
+  Expected: TStringList;
+begin
+  result:='';
+  //Expected values:
+  Expected:=TStringList.Create;
+  TestSL:=TStringList.Create;
+  try
+    Expected.Add('normal_string');
+    Expected.Add('"quoted_string"');
+    Expected.Add('"quoted;delimiter"');
+    Expected.Add('"quoted and space"');
+    Expected.Add('"starting_quote');
+    Expected.Add('string_with_tab'+#9+'character');
+    Expected.Add('multi'+LineEnding+
+      'line');
+    Expected.Add('  SpacesInfront');
+    Expected.Add('SpacesAtTheEnd   ');
+    Expected.Add('  "Spaces before quoted string"');
+
+    TestSL.Delimiter:=';'; //Match example in bug 19610, del4.zip
+    TestSL.StrictDelimiter:=true;
+    TestSL.DelimitedText:=DelimText;
+    Result:=CompareStringLists(Expected,TestSL);
+  finally
+    Expected.Free;
+    TestSL.Free;
+  end;
+end;
+
+function ReadStrictDelimFalseSafeQuote: string;
+// Test if input works with sdf output that has always been quoted
+// Delphi accepts this input even though it does not write it by default
+// This is a more unambiguous format than unquoted
+// Strictdelimiter:=false when processing the delimitedtext
+//
+const
+  DelimText='"normal_string";"""quoted_string""";"""quoted;delimiter""";"""quoted and space""";"""starting_quote";"string_with_tab'+#9+'character";"multi'+LineEnding+
+    'line";"  SpacesInfront";"SpacesAtTheEnd   ";"  ""Spaces before quoted string"""';
+
+var
+  TestSL: TStringList;
+  Expected: TStringList;
+begin
+  Result:='';
+  //Expected values:
+  Expected:=TStringList.Create;
+  TestSL:=TStringList.Create;
+  try
+    Expected.Add('normal_string');
+    Expected.Add('"quoted_string"');
+    Expected.Add('"quoted;delimiter"');
+    Expected.Add('"quoted and space"');
+    Expected.Add('"starting_quote');
+    Expected.Add('string_with_tab'+#9+'character');
+    Expected.Add('multi'+LineEnding+'line');
+    Expected.Add('  SpacesInfront');
+    Expected.Add('SpacesAtTheEnd   ');
+    Expected.Add('  "Spaces before quoted string"');
+
+    TestSL.Delimiter:=';'; //Match example in bug 19610, del4.zip
+    TestSL.StrictDelimiter:=false;
+    TestSL.DelimitedText:=DelimText;
+    Result:=CompareStringLists(Expected,TestSL);
+  finally
+    Expected.Free;
+    TestSL.Free;
+  end;
+end;
+
+function ReadCommatext: string;
+
+// Test if input works with Delphi-compatible commatext
+const
+  CommaText='normal_string,"quoted_string","quoted,delimiter","quoted and space","""quoted_and_starting_quote","""quoted, starting quote, and space","quoted_with_tab'+#9+'character","quoted_multi'+LineEnding+
+    'line","  UnquotedSpacesInfront","UnquotedSpacesAtTheEnd   ","  ""Spaces before quoted string"""';
+
+var
+  TestSL: TStringList;
+  Expected: TStringList;
+begin
+  result:='';
+  //Expected values:
+  Expected:=TStringList.Create;
+  TestSL:=TStringList.Create;
+  try
+    Expected.Add('normal_string');
+    Expected.Add('quoted_string');
+    Expected.Add('quoted,delimiter');
+    Expected.Add('quoted and space');
+    Expected.Add('"quoted_and_starting_quote');
+    Expected.Add('"quoted, starting quote, and space');
+    Expected.Add('quoted_with_tab'+#9+'character');
+    Expected.Add('quoted_multi'+LineEnding+
+      'line');
+    Expected.Add('  UnquotedSpacesInfront');
+    Expected.Add('UnquotedSpacesAtTheEnd   ');
+    Expected.Add('  "Spaces before quoted string"');
+    TestSL.CommaText:=CommaText;
+    //Test:
+    Result:=CompareStringLists(Expected,TestSL);
+  finally
+    Expected.Free;
+    TestSL.Free;
+  end;
+end;
+
+Function CheckDelimited(TestSL : Tstrings; const Expected, ExpectedSafeQuote : string) : String;
+
+begin
+  if (TestSL.DelimitedText<>Expected) and (TestSL.DelimitedText<>ExpectedSafeQuote) then
+    Exit('result: *'+TestSL.DelimitedText+'* while expected was: *'+Expected+'* - or, with safe quote output: *'+ExpectedSafeQuote+'*');
+end;
+
+function WriteStrictDelimFalse:string;
+
+// Test if conversion stringlist=>delimitedtext gives the right data
+// (right in this case: what Delphi outputs)
+// Strictdelimiter:=false when processing the delimitedtext
+const
+  Expected='normal_string;"""quoted_string""";"just;delimiter";"""quoted;delimiter""";"""quoted and space""";"""starting_quote";"single""quote";"""""quoted starting quote and space""";"with_tab'+#9+'character";"multi'+LineEnding+
+    'line";"   UnquotedSpacesInfront";"UnquotedSpacesAtTheEnd  ";"  ""Spaces before quoted string"""';
+  //If we choose to output the "safely quoted" version, we need to test for it:
+  //Though this version is not the same output as Delphi, it leads to the
+  //same input if imported again (see ReadStrictDelimFalseSafeQuote for corresponding tests)
+  ExpectedSafeQuote='"normal_string";"""quoted_string""";"just;delimiter";"""quoted;delimiter""";"""quoted and space""";"""starting_quote";"single""quote";"""""quoted starting quote and space""";"with_tab'+#9+'character";"multi'+LineEnding+
+    'line";"   UnquotedSpacesInfront";"UnquotedSpacesAtTheEnd  ";"  ""Spaces before quoted string"""';
+var
+  TestSL: TStringList;
+begin
+  Result:='';
+  TestSL:=TStringList.Create;
+  try
+    TestSL.Add('normal_string');
+    TestSL.Add('"quoted_string"');
+    TestSL.Add('just;delimiter');
+    TestSL.Add('"quoted;delimiter"');
+    TestSL.Add('"quoted and space"');
+    TestSL.Add('"starting_quote');
+    TestSL.Add('single"quote');
+    TestSL.Add('""quoted starting quote and space"');
+    TestSL.Add('with_tab'+#9+'character');
+    TestSL.Add('multi'+LineEnding+
+      'line');
+    TestSL.Add('   UnquotedSpacesInfront');
+    TestSL.Add('UnquotedSpacesAtTheEnd  ');
+    TestSL.Add('  "Spaces before quoted string"');
+
+    TestSL.Delimiter:=';';
+    TestSL.StrictDelimiter:=false;
+    Result:=CheckDelimited(TestSL,Expected,ExpectedSafeQuote);
+  finally
+    TestSL.Free;
+  end;
+end;
+
+
+
+function WriteStrictDelimTrue:String;
+// Test if conversion stringlist=>delimitedtext gives the right data
+// (right in this case: what Delphi outputs)
+// Strictdelimiter:=true when processing the delimitedtext
+const
+  Expected='normal_string;"""quoted_string""";"just;delimiter";"""quoted;delimiter""";"""quoted and space""";"""starting_quote";"single""quote";"""""quoted starting quote and space""";with_tab'+#9+'character;multi'+LineEnding+
+    'line;   UnquotedSpacesInfront;UnquotedSpacesAtTheEnd  ;"  ""Spaces before quoted string"""';
+  //If we choose to output the "safely quoted" version, we need to test for it:
+  //Though this version is not the same output as Delphi, it leads to the
+  //same input if imported again (see ReadStrictDelimTrueSafeQuote for corresponding tests)
+  ExpectedSafeQuote='"normal_string";"""quoted_string""";"just;delimiter";"""quoted;delimiter""";"""quoted and space""";"""starting_quote";"single""quote";"""""quoted starting quote and space""";"with_tab'+#9+'character";"multi'+LineEnding+
+    'line";"   UnquotedSpacesInfront";"UnquotedSpacesAtTheEnd  ";"  ""Spaces before quoted string"""';
+
+var
+  TestSL: TStringList;
+begin
+  result:='';
+  TestSL:=TStringList.Create;
+  try
+    TestSL.Add('normal_string');
+    TestSL.Add('"quoted_string"');
+    TestSL.Add('just;delimiter');
+    TestSL.Add('"quoted;delimiter"');
+    TestSL.Add('"quoted and space"');
+    TestSL.Add('"starting_quote');
+    TestSL.Add('single"quote');
+    TestSL.Add('""quoted starting quote and space"');
+    TestSL.Add('with_tab'+#9+'character');
+    TestSL.Add('multi'+LineEnding+
+      'line');
+    TestSL.Add('   UnquotedSpacesInfront');
+    TestSL.Add('UnquotedSpacesAtTheEnd  ');
+    TestSL.Add('  "Spaces before quoted string"');
+
+    TestSL.Delimiter:=';';
+    TestSL.StrictDelimiter:=true;
+    Result:=CheckDelimited(TestSL,Expected,ExpectedSafeQuote);
+  finally
+    TestSL.Free;
+  end;
+end;
+
+function ReadWriteStrictDelimFalse:String;
+// Test if conversion stringlist=>delimitedtext=>stringlist gives identical data
+// Strictdelimiter:=false (default) when processing the delimitedtext
+
+var
+  TestSL: TStringList;
+  ResultSL: TStringList;
+begin
+  result:='';
+  ResultSL:=TStringList.Create;
+  TestSL:=TStringList.Create;
+  try
+    TestSL.Add('normal_string');
+    TestSL.Add('"quoted_string"');
+    TestSL.Add('"quoted;delimiter"');
+    TestSL.Add('"quoted and space"');
+    TestSL.Add('"starting_quote');
+    TestSL.Add('""quoted, starting quote, and space"');
+    TestSL.Add('with_tab'+#9+'character');
+    TestSL.Add('multi'+LineEnding+
+      'line');
+    TestSL.Add('   UnquotedSpacesInfront');
+    TestSL.Add('UnquotedSpacesAtTheEnd  ');
+    TestSL.Add('  "Spaces before quoted string"');
+
+    TestSL.Delimiter:=';';
+    TestSL.StrictDelimiter:=false;
+    ResultSL.Delimiter:=';';
+    ResultSL.StrictDelimiter:=false;
+    ResultSL.DelimitedText:=TestSL.DelimitedText;
+    Result:=CompareStringLists(ResultSL,TestSL);
+  finally
+    ResultSL.Free;
+    TestSL.Free;
+  end;
+end;
+
+function ReadWriteStrictDelimTrue:String;
+// Test if conversion stringlist=>delimitedtext=>stringlist gives identical data
+// Strictdelimiter:=true when processing the delimitedtext
+
+var
+  TestSL: TStringList;
+  ResultSL: TStringList;
+begin
+  result:='';
+  ResultSL:=TStringList.Create;
+  TestSL:=TStringList.Create;
+  try
+    TestSL.Add('normal_string');
+    TestSL.Add('"quoted_string"');
+    TestSL.Add('"quoted;delimiter"');
+    TestSL.Add('"quoted and space"');
+    TestSL.Add('"starting_quote');
+    TestSL.Add('""quoted, starting quote, and space"');
+    TestSL.Add('with_tab'+#9+'character');
+    TestSL.Add('multi'+LineEnding+
+      'line');
+    TestSL.Add('   UnquotedSpacesInfront');
+    TestSL.Add('UnquotedSpacesAtTheEnd  ');
+    TestSL.Add('  "Spaces before quoted string"');
+
+    TestSL.Delimiter:=';';
+    TestSL.StrictDelimiter:=false;
+    ResultSL.Delimiter:=';';
+    ResultSL.StrictDelimiter:=true;
+    ResultSL.DelimitedText:=TestSL.DelimitedText;
+    //Test:
+    Result:=CompareStringLists(ResultSL,TestSL);
+  finally
+    ResultSL.Free;
+    TestSL.Free;
+  end;
+end;
+
+Function AddStrictDelimFalse : string;
+
+var
+  TestSL: TStringList;
+  ResultSL: TStringList;
+
+begin
+  result:='';
+  ResultSL:=TStringList.Create;
+  TestSL:=TStringList.Create;
+  try
+    TestSL.Add('a');
+    TestSL.Add('b');
+    TestSL.Add('c');
+    TestSL.StrictDelimiter:=false;
+    TestSL.AddDelimitedtext('"quoted and space"');
+    ResultSL.Add('a');
+    ResultSL.Add('b');
+    ResultSL.Add('c');
+    ResultSL.Add('quoted and space');
+    Result:=CompareStringLists(ResultSL,TestSL);
+  finally
+    ResultSL.Free;
+    TestSL.Free;
+  end;
+end;
+
+
+Procedure RegisterTests;
+
+Var
+  P : Psuite;
+begin
+  P:=EnsureSuite('Classes');
+  AddTest('Testvclcomobject',@Testvclcomobject,P);
+  AddTest('Testtstringlistexchange',@Testtstringlistexchange,P);
+  AddTest('TestStoredfalse',@TestStoredfalse,P);
+  AddTest('TestBytesStream',@TestBytesStream,P);
+  AddTest('TestLineBreak',@TestLineBreak,P);
+  AddTest('TestAlwaysQuote',@TestAlwaysQuote,P);
+  AddTest('TestGetNameValue',@TestGetNameValue,P);
+  AddTest('SortContext',@TestSortContext,P);
+  AddTest('TestStringlistReverse1',@TestStringListReverse1,P);
+  AddTest('TestStringlistReverse2',@TestStringListReverse2,P);
+  AddTest('TestStringsIndexOfStartAt',@TestStringsIndexOfStartAt,P);
+  AddTest('TestStringsLastIndexOfStartAt',@TestStringsLastIndexOfStartAt,P);
+  AddTest('TestSlice',@TestSlice,P);
+  AddTest('TestSlice2',@TestSlice2,P);
+  AddTest('TestFill',@TestFill,P);
+  AddTest('TestFill2',@TestFill2,P);
+  AddTest('TestFilter',@TestFilter,P);
+  AddTest('TestFilter2',@TestFilter,P);
+  AddTest('TestMap',@TestMap,P);
+  AddTest('TestMap2',@TestMap2,P);
+  AddTest('TestReduce',@TestReduce,P);
+  AddTest('TestPop',@TestPop,P);
+  AddTest('TestShift',@TestShift,P);
+  AddTest('TestForeach',@TestForeach,P);
+  AddTest('TestForeachEx',@TestForeachEx,P);
+  AddTest('ReadStrictDelimFalse',@ReadStrictDelimFalse,P);
+  AddTest('ReadStrictDelimTrue',@ReadStrictDelimTrue,P);
+  AddTest('ReadStrictDelimFalseCornerCases',@ReadStrictDelimFalseCornerCases,P);
+  AddTest('ReadStrictDelimTrueCornerCases',@ReadStrictDelimTrueCornerCases,P);
+  AddTest('ReadStrictDelimTrueSafeQuote',@ReadStrictDelimTrueSafeQuote,P);
+  AddTest('ReadStrictDelimFalseSafeQuote',@ReadStrictDelimFalseSafeQuote,P);
+  AddTest('ReadCommaText',@ReadCommaText,P);
+  AddTest('WriteStrictDelimFalse',@WriteStrictDelimFalse,P);
+  AddTest('WriteStrictDelimTrue',@WriteStrictDelimTrue,P);
+  AddTest('ReadWriteStrictDelimFalse',@ReadWriteStrictDelimFalse,P);
+  AddTest('ReadWriteStrictDelimTrue',@ReadWriteStrictDelimTrue,P);
+  AddTest('AddStrictDelimFalse',@AddStrictDelimFalse,P);
+end;
+
+initialization
+  RegisterTests;  
+end.

rtl/test/utdfexp.pp

@@ -0,0 +1,557 @@
+{ %skiptarget=wince }
+
+{
+    This file is part of the Free Pascal test suite.
+    Copyright (c) 1999-2004 by the Free Pascal development team.
+
+    Test for possible bugs in Dos.FExpand
+
+    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}
+
+unit utdfexp;
+
+interface
+
+uses punit, utrtl;
+
+{$DEFINE DEBUG}
+(* Defining DEBUG causes all the source and target strings *)
+(* to be written to the console to make debugging easier.  *)
+{ $DEFINE DIRECT}
+(* Defining DIRECT causes direct embedding of fexpand.inc instead     *)
+(* of using FExpand implementation in (previously compiled) unit Dos. *)
+
+implementation
+
+uses
+ Dos;
+
+{$IFDEF DIRECT}
+(* For testing purposes on non-native platforms *)
+ {$DEFINE VOLUMES}
+ {$DEFINE NODOTS}
+ { $DEFINE AMIGA}
+ { $DEFINE UNIX}
+ {$DEFINE MACOS}
+
+ { $DEFINE FPC_FEXPAND_DRIVES}
+ { $DEFINE FPC_FEXPAND_UNC}
+ {$DEFINE FPC_FEXPAND_VOLUMES}
+ {$DEFINE FPC_FEXPAND_NO_DEFAULT_PATHS}
+ {$DEFINE FPC_FEXPAND_DRIVESEP_IS_ROOT}
+ { $DEFINE FPC_FEXPAND_DIRSEP_IS_UPDIR}
+ {$DEFINE FPC_FEXPAND_NO_DOTS_UPDIR}
+ { $DEFINE FPC_FEXPAND_NO_CURDIR}
+ { $DEFINE FPC_FEXPAND_TILDE}
+ { $DEFINE FPC_FEXPAND_MULTIPLE_UPDIR}
+ {$DEFINE FPC_FEXPAND_DIRSEP_IS_CURDIR}
+ { $DEFINE FPC_FEXPAND_GETENV_PCHAR}
+{$ENDIF DIRECT}
+
+{$IFDEF LINUX}
+ {$IFNDEF UNIX}
+  {$DEFINE UNIX}
+ {$ENDIF UNIX}
+{$ENDIF LINUX}
+
+{$IFDEF AMIGA}
+ {$IFNDEF HASAMIGA}
+  {$DEFINE HASAMIGA}
+ {$ENDIF HASAMIGA}
+{$ENDIF AMIGA}
+
+{$IFDEF HASAMIGA}
+ {$DEFINE VOLUMES}
+ {$DEFINE NODRIVEC}
+ {$DEFINE NODOTS}
+{$ENDIF HASAMIGA}
+
+{$IFDEF NETWARE}
+ {$DEFINE VOLUMES}
+ {$DEFINE NODRIVEC}
+{$ENDIF NETWARE}
+
+{$IFDEF UNIX}
+ {$DEFINE NODRIVEC}
+{$ENDIF UNIX}
+
+{$IFDEF MACOS}
+ {$DEFINE VOLUMES}
+ {$DEFINE NODRIVEC}
+ {$DEFINE NODOTS}
+{$ENDIF MACOS}
+
+const
+{$IFNDEF NODRIVEC}
+ CC = 'C:';
+{$ENDIF NODRIVEC}
+{$IFNDEF FPC}
+ FileNameCasePreserving = false;
+ DirectorySeparator = '\';
+ DirectorySeparator2 = '\';
+ DirSep = '\';
+ CDrive = 'C:';
+ DriveSep = ':';
+{$ELSE FPC}
+(* Used for ChDir/MkDir *)
+ DirectorySeparator2 = System.DirectorySeparator;
+ {$IFDEF DIRECT}
+  {$IFDEF MACOS}
+ DirectorySeparator = ':';
+ LFNSupport = true;
+ FileNameCasePreserving = true;
+  {$ELSE MACOS}
+   {$IFDEF UNIX}
+ DirectorySeparator = '/';
+ DriveSeparator = '/';
+ FileNameCasePreserving = true;
+   {$ELSE UNIX}
+    {$IFDEF HASAMIGA}
+ DirectorySeparator = '/';
+ FileNameCasePreserving = true;
+    {$ELSE HASAMIGA}
+ DirectorySeparator = '\';
+ FileNameCasePreserving = false;
+    {$ENDIF HASAMIGA}
+   {$ENDIF UNIX}
+  {$ENDIF MACOS}
+ {$ENDIF DIRECT}
+ DirSep = DirectorySeparator;
+ {$IFDEF MACOS}
+ DriveSep = '';
+ {$ELSE MACOS}
+ DriveSep = DriveSeparator;
+ {$ENDIF MACOS}
+ {$IFDEF UNIX}
+ CDrive = '';
+ {$ELSE UNIX}
+  {$IFDEF MACOS}
+ CDrive = 'C';
+  {$ELSE MACOS}
+   {$IFDEF HASAMIGA}
+ CDrive = 'C';
+   {$ELSE HASAMIGA}
+ CDrive = 'C:';
+   {$ENDIF HASAMIGA}
+  {$ENDIF MACOS}
+ {$ENDIF UNIX}
+{$ENDIF FPC}
+ TestFileName = 'testfile.tst';
+ TestDir1Name = 'TESTDIR1';
+ TestDir2Name = 'TESTDIR2';
+
+{$IFDEF DIRECT}
+procedure XToDirect (var S: string);
+var
+ I: byte;
+begin
+ if DirectorySeparator2 <> DirectorySeparator then
+  for I := 1 to Length (S) do
+   if S [I] = DirectorySeparator2 then
+    S [I] := DirectorySeparator;
+{$IFNDEF FPC_FEXPAND_DRIVES}
+ if DriveSeparator = DirectorySeparator then
+  I := Pos (DirectorySeparator + DirectorySeparator, S)
+ else
+  I := Pos (DriveSeparator, S);
+ if I <> 0 then
+  Delete (S, 1, I);
+{$ENDIF FPC_FEXPAND_DRIVES}
+end;
+
+procedure GetDir (Drive: byte; var Directory: string);
+begin
+ System.GetDir (Drive, Directory);
+ XToDirect (Directory);
+end;
+
+ {$I fexpand.inc}
+{$ENDIF DIRECT}
+
+var
+{$IFNDEF NODRIVEC}
+ CDir,
+{$endif}
+ TestDir, TestDir0, OrigDir, CurDir, S: DirStr;
+ TestDrive: string [2];
+ F: file;
+
+function Translate (S: PathStr): PathStr;
+
+var
+  I: byte;
+
+begin
+{$IFDEF UNIX}
+ if (Length (S) > 1) and (S [2] = ':') then Delete (S, 1, 2);
+{$ELSE UNIX}
+ for I := 1 to Length (S) do if S [I] = '/' then S [I] := DirSep;
+ if (Length (S) > 1) and (S [1] in ['a'..'z']) and (S[2]=DriveSep) then
+   S [1] := UpCase (S [1]);
+{$ENDIF UNIX}
+ if not (FileNameCasePreserving) then
+                           for I := 1 to Length (S) do S [I] := UpCase (S [I]);
+ Translate := S;
+end;
+
+Function Check (ID : Integer; Src, Rslt: PathStr) : Boolean;
+
+var
+ Rslt2: PathStr;
+ S : string;
+begin
+{$IFDEF DEBUG}
+  if ShowDebugOutput then
+    WriteLn (ID,' : ',Src, '=>', Rslt);
+{$ENDIF DEBUG}
+  Rslt := Translate (Rslt);
+  Rslt2 := FExpand (Src);
+{$IFDEF DIRECT}
+  {$IFNDEF FPC_FEXPAND_DRIVES}
+    I := Pos (System.DriveSeparator, Rslt2);
+    if I <> 0 then
+      Delete (Rslt2, 1, I);
+  {$ENDIF FPC_FEXPAND_DRIVES}
+{$ENDIF DIRECT}
+{$IFNDEF UNIX}
+  if (Length (Rslt2) > 1) and (Rslt2 [1] in ['a'..'z']) and (Rslt2[2]=DriveSep) then
+    Rslt2 [1] := UpCase (Rslt2 [1]);
+{$ENDIF NDEF UNIX}
+  Str(ID,S);
+  Check:=AssertEquals(S+': FExpand ('+Src+ ')', Rslt,Rslt2);
+end;
+
+Function DoTest : TTestString;
+
+begin
+  Result:='';
+  {$IFDEF DIRECT}
+   {$IFNDEF FPC_FEXPAND_DRIVES}
+   I := Pos (System.DriveSeparator, CurDir);
+   if I <> 0 then
+    Delete (CurDir, 1, I);
+   {$ENDIF FPC_FEXPAND_DRIVES}
+  {$ENDIF DIRECT}
+  {$IFNDEF NODRIVEC}
+   GetDir (3, CDir);
+  {$ENDIF NODRIVEC}
+   if not Check (1,' ', CurDir + DirSep + ' ') then exit;
+  {$IFDEF HASAMIGA}
+  if not Check (2, '', CurDir) then exit;
+  {$ELSE HASAMIGA}
+  if not Check (3,'', CurDir + DirSep) then exit;
+  {$ENDIF HASAMIGA}
+  {$IFDEF MACOS}
+   if not Check (4,':', CurDir + DirSep) then exit;
+  {$ELSE MACOS}
+   if not Check (5,'.', CurDir) then exit;
+  {$ENDIF MACOS}
+
+  {$IFNDEF NODRIVEC}
+  if CDir [Length (CDir)] = DirSep then
+    begin
+    if not Check (6,'c:anything', CDir + 'anything') then
+      exit,
+    end
+  else
+    if not Check (7,'c:anything', CDir + DirSep + 'anything') then exit;
+    if not Check (8,CC + DirSep, CDrive + DirSep) then exit;
+   {$IFDEF NODOTS}
+   if not Check (9,'C:.', 'C:.') then exit;
+   if not Check (10,CC + DirSep + '.', CDrive + DirSep + '.') then exit;
+   if not Check (CC + DirSep + '..', CDrive + DirSep + '..') then exit;
+   {$ELSE NODOTS}
+   if not Check (11,'C:.', CDir) then exit;
+   if not Check (12,CC + DirSep + '.', CDrive + DirSep) then exit;
+   if not Check (13,CC + DirSep + '..', CDrive + DirSep) then exit;
+   {$ENDIF NODOTS}
+   if not  Check (14,CC + DirSep + 'DOS', CDrive + DirSep + 'DOS') then exit;
+   {$IFNDEF NODOTS}
+   if not Check (15,CC + DirSep + '..' + DirSep + 'DOS', CDrive + DirSep + 'DOS') then exit;
+   {$ENDIF NODOTS}
+   if not Check (16,CC + DirSep + 'DOS.', CDrive + DirSep + 'DOS.') then exit;
+   {$IFDEF HASAMIGA} (* This has no effect - AMIGA has NODRIVEC defined... *)
+   if not Check (17,CC + DirSep + 'DOS' + DirSep, CDrive + DirSep) then exit;
+   {$ELSE HASAMIGA}
+   if not Check (18,CC + DirSep + 'DOS' + DirSep, CDrive + DirSep + 'DOS' + DirSep) then exit;
+   {$ENDIF HASAMIGA}
+   {$IFNDEF NODOTS}
+   if not Check (19,CC + DirSep + 'DOS' + DirSep + '.', CDrive + DirSep + 'DOS') then exit;
+   if not Check (20,CC + DirSep + 'DOS' + DirSep + '..', CDrive + DirSep) then exit;
+   if not Check (21,CC + DirSep + 'DOS' + DirSep + '..' + DirSep, CDrive + DirSep) then exit;
+   if not Check (22,CC + DirSep + 'DOS' + DirSep + 'TEST' + DirSep + '..', CDrive +
+                                                                 DirSep + 'DOS') then exit;
+   if not Check (23,ID,'C:' + DirSep + 'DOS' + DirSep + 'TEST' + DirSep + '..' + DirSep,
+                                               CDrive + DirSep + 'DOS' + DirSep) then exit;
+   {$ENDIF NODOTS}
+  {$ENDIF NODRIVEC}
+
+  {$IFNDEF MACOS}
+   {$IFDEF HASAMIGA}
+   if not Check (24,DirSep, TestDir + TestDir1Name) then exit;
+   if not Check (25,DirSep + DirSep + TestFileName, TestDir + TestFileName) then exit;
+   if not Check (26,DirSep + 'DOS', TestDir + TestDir1Name + DirSep + 'DOS') then exit;
+   {$ELSE HASAMIGA}
+   if not Check (27,DirSep, TestDrive + DirSep) then exit;
+   if not Check (28,DirSep + '.', TestDrive + DirSep) then exit;
+   if not Check (29,DirSep + '..', TestDrive + DirSep)then exit;
+   if not Check (30,DirSep + 'DOS', TestDrive + DirSep + 'DOS') then exit;
+   {$ENDIF HASAMIGA}
+  {$ENDIF MACOS}
+   if not Check (31,'d', CurDir + DirSep + 'd')then exit;
+  {$IFDEF MACOS}
+   if not Check (32,DirSep + 'd', CurDir + DirSep + 'd') then exit;
+  {$ELSE MACOS}
+   {$IFNDEF NODOTS}
+   if not Check (33,'.' + DirSep + 'd', CurDir + DirSep + 'd') then exit;
+   {$ENDIF NODOTS}
+  {$ENDIF MACOS}
+   if not Check (34,'d' + DirSep + TestFileName, CurDir + DirSep + 'd' + DirSep + TestFileName) then exit;
+   if not Check (35,' d', CurDir + DirSep + ' d') then exit;
+   if not Check (36,'dd', CurDir + DirSep + 'dd') then exit;
+  {$IFDEF MACOS}
+   if not Check (37,DirSep + 'dd' + DirSep + 'dd', CurDir + DirSep + 'dd' + DirSep + 'dd') then exit;
+   if not Check (38,'dd' + DirSep + 'dd', 'dd' + DirSep + 'dd') then exit;
+  {$ELSE MACOS}
+   if not Check (39,'dd' + DirSep + 'dd', CurDir + DirSep + 'dd' + DirSep + 'dd') then exit;
+  {$ENDIF MACOS}
+   if not Check (40,'ddd', CurDir + DirSep + 'ddd') then exit;
+  {$IFDEF MACOS}
+   if not Check (41,'dddd' + DirSep + 'eeee.ffff', 'dddd' + DirSep + 'eeee.ffff') then exit;
+  {$ELSE MACOS}
+   if not Check (42,'dddd' + DirSep + 'eeee.ffff', CurDir + DirSep + 'dddd' + DirSep
+                                                                  + 'eeee.ffff') then exit;
+  {$ENDIF MACOS}
+   if not Check (43,'.special', CurDir + DirSep + '.special') then exit;
+   if not Check (44,'..special', CurDir + DirSep + '..special') then exit;
+   if not Check (45,'special..', CurDir + DirSep + 'special..') then exit;
+  {$IFDEF HASAMIGA}
+   if not Check (46,'special.' + DirSep, CurDir + DirSep + 'special.' + DirSep) then exit;
+  {$ELSE HASAMIGA}
+   {$IFDEF MACOS}
+   if not Check (47,'special.' + DirSep, 'special.' + DirSep) then exit;
+   {$ELSE MACOS}
+   if not Check (48,'special.' + DirSep, CurDir + DirSep + 'special.' + DirSep) then exit;
+   {$ENDIF MACOS}
+  {$ENDIF HASAMIGA}
+  {$IFDEF MACOS}
+   if not Check (49,DirSep + DirSep, TestDir + TestDir1Name + DirSep) then exit;
+   if not Check (50,DirSep + DirSep + TestFileName, TestDir + TestDir1Name + DirSep
+                                                                 + TestFileName) then exit;
+  {$ELSE MACOS}
+   if not Check (51,DirSep + '.special', TestDrive + DirSep + '.special') then exit;
+   {$IFNDEF NODOTS}
+   if not Check (52,'..', TestDir + TestDir1Name) then exit;
+   if not Check (53,'.' + DirSep + '..', TestDir + TestDir1Name) then exit;
+   if not Check (54,'..' + DirSep + '.', TestDir + TestDir1Name) then exit;
+   {$ENDIF NODOTS}
+  {$ENDIF MACOS}
+  {$IFDEF NETWARE}
+   if not Check (55,'...', TestDir) then exit;
+  {$ELSE NETWARE}
+   if not Check (56,'...', CurDir + DirSep + '...') then exit;
+  {$ENDIF NETWARE}
+   if not Check (57,TestFileName, CurDir + DirSep + TestFileName) then exit;
+  {$IFDEF UNIX}
+   S := GetEnv ('HOME');
+   { On m68k netbsd at least, HOME contains a final slash
+     remove it PM }
+   if (Length (S) > 1) and (S [Length (S)] = DirSep) then
+     S:=Copy(S,1,Length(S)-1);
+   if Length (S) = 0 then
+    begin
+     if not Check (58,'~', CurDir) then exit;
+     if not Check (59,'~' + DirSep + '.', DirSep) then exit;
+    end
+   else
+    begin
+     if not Check (60,'~', S) then exit;
+     if not Check (61,'~' + DirSep + '.', S) then exit;
+    end;
+   if (Length (S) > 0) and (S [Length (S)] <> DirSep) then
+    S := S + DirSep;
+   if not Check (62,'~NobodyWithThisNameShouldEverExist.test/nothing', CurDir + DirSep +
+                              '~NobodyWithThisNameShouldEverExist.test/nothing') then exit;
+   if not Check (63,'/tmp/~NoSuchUserAgain', '/tmp/~NoSuchUserAgain') then exit;
+   if Length (S) = 0 then
+    begin
+     if not Check (64,'~' + DirSep, DirSep) then exit;
+     if not Check (65,'~' + DirSep + '.' + DirSep, DirSep) then exit;
+     if not Check (66,'~' + DirSep + 'directory' + DirSep + 'another',
+                                      DirSep + 'directory' + DirSep + 'another') then exit;
+    end
+   else
+    begin
+     if not Check (67,'~' + DirSep, S) then exit;
+     if not Check (68,'~' + DirSep + '.' + DirSep, S) then exit;
+     if not Check (69,'~' + DirSep + 'directory' + DirSep + 'another',
+                                           S + 'directory' + DirSep + 'another') then exit;
+    end;
+  {$ELSE UNIX}
+   {$IFNDEF NODRIVEC}
+   if not Check (70,TestDrive + '..', TestDir + TestDir1Name) then exit;
+   if not Check (71,TestDrive + '..' + DirSep, TestDir + TestDir1Name + DirSep) then exit;
+   if not Check (72,TestDrive + '.' + DirSep + '.', CurDir) then exit;
+   if not Check (73,TestDrive + '.' + DirSep + '..', TestDir + TestDir1Name) then exit;
+  {$I-}
+  (*
+  { $ ifndef unix }
+  {   avoid a and b drives for
+     no unix systems to reduce the
+     probablility of getting an alert message box }
+   { This should not be needed - unit popuperr should solve this?! TH }
+   I := 3;
+  {$else unix} *)
+   I := 1;
+  { $ endif unix}
+   repeat
+    S := '';
+    GetDir (I, S);
+    IOR := IOResult;
+    if IOR = 0 then Inc (I);
+   until (I > 26) or (IOR <> 0);
+   if I <= 26 then
+   begin
+    S := Chr (I + 64) + ':ddd';
+    if not Check (74,S, Chr (I + 64) + ':' + DirSep + 'ddd') then exit;
+   end else
+     if ShowDebugOutput then
+       WriteLn ('Sorry, cannot test FExpand behaviour for incorrect drives here.');
+  {$I+}
+    {$IFDEF FPC}
+   if not Check (75,'d\d/d', CurDir + DirSep + 'd' + DirSep + 'd' + DirSep + 'd') then exit;
+   if not Check (76,'\\server\share\directory', '\\server\share\directory') then exit;
+   if not Check (77,'\\server\share\directory1\directory2\..',
+                                                    '\\server\share\directory1') then exit;
+   if not Check (78,'\\', '\\') then exit;
+   if not Check (79,'\\.', '\\.\') then exit;
+   if not Check (80,'\\.\', '\\.\') then exit;
+   if not Check (81,'\\.\.', '\\.\.') then exit;
+   if not Check (82,'\\.\..', '\\.\..') then exit;
+   if not Check (83,'\\.\...', '\\.\...') then exit;
+   if not Check (84,'\\.\TEST', '\\.\TEST') then exit;
+   if not Check (85,'\\..\', '\\..\') then exit;
+   if not Check (86,'\\..\TEST', '\\..\TEST') then exit;
+   if not Check (87,'\\..\TEST\.', '\\..\TEST') then exit;
+   if not Check (88,'\\..\TEST1\TEST2\..', '\\..\TEST1') then exit;
+   if not Check (89,'\\..\TEST\..', '\\..\TEST') then exit;
+   if not Check (90,'\\..\TEST\..\..', '\\..\TEST') then exit;
+    {$ENDIF FPC}
+   {$ENDIF NODRIVEC}
+  {$ENDIF UNIX}
+  {$IFDEF VOLUMES}
+   {$IFDEF HASAMIGA}
+   if not Check (91,'VolName' + DriveSep + 'DIR1', 'VolName' + DriveSep + 'DIR1') then exit;
+   {$ELSE HASAMIGA}
+   if not Check (92,'VolName' + DriveSep + DirSep + 'DIR1', 'VolName' + DriveSep + DirSep + 'DIR1') then exit;
+   {$ENDIF HASAMIGA}
+   {$IFNDEF NODOTS}
+   if not Check (93,'VolName' + DriveSep + DirSep + 'DIR1' + DirSep + '..', 'VolName' + DriveSep + DirSep) then exit;
+   if not Check (94,'VolName' + DriveSep + DirSep + 'DIR1' + DirSep + '..' + DirSep + '..',
+                                                            'VolName' + DriveSep + DirSep) then exit;
+   if not Check (95,'VolName' + DriveSep + DirSep + '.', 'VolName:' + DirSep) then exit;
+   if not Check (96,'VolName' + DriveSep + DirSep + '..', 'VolName:' + DirSep) then exit;
+   if not Check (97,'VolName' + DriveSep + DirSep + '..' + DirSep, 'VolName' + DriveSep + DirSep) then exit;
+   {$ENDIF NODOTS}
+   {$IFDEF NETWARE}
+   if not Check (98,'SrvName\VolName' + DriveSep + DirSep + 'TEST', 'SrvName' + DirSep + 'VolName' +
+                                                           DriveSep + DirSep + 'TEST') then exit;
+   if not Check (99,'SrvName/VolName' + DriveSep + DirSep + 'TEST', 'SrvName' + DirSep + 'VolName' +
+                                                           DriveSep + DirSep + 'TEST') then exit;
+   {$ENDIF NETWARE}
+   {$IFDEF HASAMIGA}
+    {$IFDEF NODOTS}
+   if not Check (100,'.', CurDir + DirSep + '.') then exit;
+    {$ELSE NODOTS}
+   if not Check (101,'.', CurDir) then exit;
+    {$ENDIF NODOTS}
+   {$ENDIF HASAMIGA}
+  {$ENDIF VOLUMES}
+end;
+
+Function TestDosFExpand : TTestString;
+
+begin
+  Result:='';
+  TestDir:=SysGetSetting('fexpanddir');
+  if (TestDir='') then
+    begin
+    if ShowDebugOutput then
+      begin
+      WriteLn ('Warning: Parameter missing!');
+      WriteLN('Full path to a directory with write access' +
+{$IFNDEF UNIX}
+ {$IFNDEF VOLUMES}
+        #13#10'(preferably not on a C: drive)' +
+ {$ENDIF VOLUMES}
+{$ENDIF UNIX}
+        ' expected.');
+      WriteLn ('Trying to use the current directory instead ' +
+{$IFDEF UNIX}
+        '(not quite ideal).');
+{$ELSE UNIX}
+        '(problems might arise).');
+{$ENDIF UNIX}
+      end;
+    // Get current dir
+{$IFDEF DIRECT}System.{$ENDIF DIRECT}GetDir(0,TestDir);
+    end;
+  if TestDir[Length(TestDir)]<>DirectorySeparator2 then
+    TestDir := TestDir + DirectorySeparator2;
+{$IFDEF DIRECT}System.{$ENDIF DIRECT}GetDir (0,OrigDir);
+{$IFDEF NODRIVEC}
+  TestDrive := '';
+{$ELSE NODRIVEC}
+  TestDrive := Copy (TestDir, 1, 2);
+  GetDir ((Ord (TestDir [1]) and not ($20)) - 64, OrigTstDir);
+{$ENDIF NODRIVEC}
+{$I-}
+  MkDir (TestDir + TestDir1Name);
+  if IOResult <> 0 then ;
+  MkDir (TestDir + TestDir1Name + DirectorySeparator2 + TestDir2Name);
+  if IOResult <> 0 then ;
+{$I+}
+  ChDir (TestDir + TestDir1Name + DirectorySeparator2 + TestDir2Name);
+{$I-}
+  TestDir0 := TestDir;
+{$IFDEF DIRECT}
+  XToDirect (TestDir);
+  {$IFNDEF FPC_FEXPAND_DRIVES}
+  I := Pos (System.DriveSeparator, TestDir);
+  if I <> 0 then
+    Delete (TestDir, 1, I);
+  {$ENDIF FPC_FEXPAND_DRIVES}
+{$ENDIF DIRECT}
+  Assign (F, TestFileName);
+  Rewrite (F);
+  Close (F);
+  if IOResult <> 0 then ;
+{$IFNDEF DIRECT}
+  Assign (F, FExpand (TestFileName));
+{$ENDIF DIRECT}
+{$I+}
+  GetDir (0, CurDir);
+  // Do the actual tests.
+  // The test exits at the first error, so we put it in a subroutine to be able to clean up.
+  Result:=DoTest;
+  // Clean up
+  Erase (F);
+{$IFNDEF NODRIVEC}
+  ChDir (OrigTstDir);
+{$ENDIF NODRIVEC}
+  ChDir (OrigDir);
+  RmDir (TestDir0 + TestDir1Name + DirectorySeparator2 + TestDir2Name);
+  RmDir (TestDir0 + TestDir1Name);
+end;
+
+begin
+  AddTest('DosFExpand',@TestDosFExpand,EnsureSuite('Dos'));
+end.

rtl/test/utdirex.pp

@@ -0,0 +1,156 @@
+unit utdirex;
+
+interface
+{$mode objfpc}
+{$H+}
+
+uses
+  sysutils;
+
+implementation
+
+uses punit,utrtl;
+
+{$I+}
+
+const
+  AllowOneTrailingSeparator: boolean = false;
+  AllowMultipleTrailingSeparators: boolean = false;
+
+Function TestDirectoryExists(Test : Integer;Const DirName : string; ExpectedResult : boolean) : Boolean;
+
+begin
+  Result:=AssertEquals('Test '+IntToStr(Test),ExpectedResult,Sysutils.DirectoryExists (DirName));
+end;
+
+Function TestParents(BaseN : Integer;var dir : string) : Boolean;
+
+var
+  sep_pos,maxpos,i : longint;
+  N : integer;
+begin
+  Result:=True;
+  N:=0;
+  while Result do
+    begin
+    Inc(N);
+    sep_pos:=0;
+    for i:=length(dir) downto 1 do
+      if dir[i] in AllowDirectorySeparators then
+        begin
+        sep_pos:=i;
+        break;
+        end;
+    if (sep_pos=0) then
+      exit;
+    maxpos:=sep_pos;
+    dir:=copy(dir,1,maxpos);
+    Result:=TestDirectoryExists(BaseN+2*N,dir,AllowOneTrailingSeparator);
+    if Result and (length(dir)>1) then
+      begin
+      dir:=copy(dir,1,maxpos-1);
+      Result:=TestDirectoryExists(BaseN+2*N+1,dir,true);
+      end
+    else
+      exit;
+    end;
+end;
+
+Function DoTestDirectoryExists : AnsiString;
+
+var
+  dir,dir1,dir2,StoredDir : string;
+  P: shortstring;
+  ch : char;
+begin
+  Result:='';
+  StoredDir:='';
+  P:=ExtractFilePath(paramstr(0));
+  if ShowDebugOutput then
+    begin
+    Writeln('Path="',P,'"');
+    Writeln('DirectorySeparator="',DirectorySeparator,'"');
+    Write('AllowDirectorySeparators="');
+    for ch:=low(char) to high(char) do
+      if ch in AllowDirectorySeparators then
+        Write(ch);
+    Writeln('"');
+    end;
+
+{ The following would be already tested at the beginning of TestParents
+  TestDirectoryExists(P,true);
+}
+{ The following check wouldn't work correctly if running the test executable
+  from a root drive - not a typical case, but still worth mentioning... }
+  if DirectoryExists(P) then
+   AllowOneTrailingSeparator:=true
+  else if ShowDebugOutput then
+     WriteLn ('Warning: Some code may expect support for a trailing directory separator!');
+  if DirectoryExists(P+DirectorySeparator) then
+    AllowMultipleTrailingSeparators:=true;
+
+  dir:=P;
+  if ShowDebugOutput then
+    Writeln('Calling TestParents with dir="',dir,'"');
+  TestParents(100,dir);
+  dir:=P;
+{$IFDEF MACOS}
+ {$WARNING The following test is wrong for Mac OS!}
+{$ENDIF MACOS}
+{$IFDEF AMIGA}
+ {$WARNING The following test is wrong for Amiga (volumes are not detected properly)!}
+{$ENDIF AMIGA}
+{$IFDEF NETWARE}
+ {$WARNING The following test is wrong for Amiga (volumes are not detected properly)!}
+{$ENDIF NETWARE}
+{$IFNDEF UNIX}
+  if (length(dir)>2) and (dir[2]= DriveSeparator) and (dir[3]=DirectorySeparator) then
+    begin
+      GetDir(0,StoredDir);
+      ChDir(Copy(Dir,1,3));
+      if ShowDebugOutput then
+        Writeln('Calling TestParents with dir="',dir,'" from directory '
+                                               + Copy (Dir, 1, 3) + ' (root)');
+      TestParents(200,dir);
+      ChDir(StoredDir);
+    end;
+{$ELSE UNIX}
+  GetDir(0,StoredDir);
+  ChDir(DirectorySeparator);
+  if ShowDebugOutput then
+    Writeln('Calling TestParents with dir="',dir,'" from directory '
+                                             + DirectorySeparator + ' (root)');
+  if not TestParents(200,dir) then exit;
+  ChDir(StoredDir);
+{$ENDIF UNIX}
+  dir:=P+'_Dummy';
+  if not TestDirectoryExists(1,dir,false) then exit;
+  dir1:=P+'_Dummy'+DirectorySeparator;
+  if not TestDirectoryExists(2,dir1,false) then exit;
+  mkdir(dir);
+  if not TestDirectoryExists(3,dir,true) then exit;
+  if not TestDirectoryExists(4,dir1,AllowOneTrailingSeparator) then exit;
+  { Check that using two directory separators fails }
+  if not TestDirectoryExists(5,dir1+DirectorySeparator,AllowMultipleTrailingSeparators) then exit;
+  if ('/' in AllowDirectorySeparators) and ('/' <> DirectorySeparator) then
+   begin
+    if not TestDirectoryExists(6,dir+'/',AllowOneTrailingSeparator) then exit;
+    if not TestDirectoryExists(7,dir1+'/',AllowMultipleTrailingSeparators) then exit;
+    if not TestDirectoryExists(8,dir1+'//',AllowMultipleTrailingSeparators) then exit;
+   end;
+  if not TestDirectoryExists (9,dir1 + DirectorySeparator + DirectorySeparator, AllowMultipleTrailingSeparators) then exit;
+  dir2:=dir1+'_Dummy2';
+  if not TestDirectoryExists(10,dir2,false) then exit;
+  mkdir(dir2);
+  if not TestDirectoryExists(11,dir2,true) then exit;
+  rmdir(dir2);
+  rmdir(dir);
+  if not TestDirectoryExists(12,dir,false) then exit;
+  if not TestDirectoryExists(13,dir1,false) then exit;
+end;
+
+begin
+  SysUtilsTest('TestDirectoryExists',@DoTestDirectoryExists);
+end.
+
+

rtl/test/utdos.pp

@@ -0,0 +1,46 @@
+unit utdos;
+
+{$mode objfpc}
+
+interface
+
+uses
+  Classes, SysUtils;
+
+{ verifies that the DOSError variable is equal to }
+{ the value requested.                            }
+
+Function CheckDosError(Msg : String; err: Integer) : Boolean;
+
+implementation
+
+uses dos, punit;
+
+Function CheckDosError(Msg : String; err: Integer) : Boolean;
+
+ var
+  x : integer;
+  s :string;
+ Begin
+  x := DosError;
+  case x of
+  0 : s := '(0): No Error.';
+  2 : s := '(2): File not found.';
+  3 : s := '(3): Path not found.';
+  5 : s := '(5): Access Denied.';
+  6 : s := '(6): Invalid File Handle.';
+  8 : s := '(8): Not enough memory.';
+  10 : s := '(10) : Invalid Environment.';
+  11 : s := '(11) : Invalid format.';
+  18 : s := '(18) : No more files.';
+  else
+   begin
+    Str (X, S);
+    s := '(' + s + ') - INVALID DOSERROR';
+   end
+  end;
+  Result:=AssertEquals(Msg+': Value of DOSError ('+S+')',Err,X);
+ end;
+
+end.
+

rtl/test/utencoding.pp

@@ -0,0 +1,157 @@
+unit utencoding;
+
+{$mode delphi}{$H+}
+{$codepage cp1251}
+
+interface
+
+uses
+  SysUtils, Classes;
+
+implementation
+
+uses punit, utrtl;
+
+function CheckCodePage(const B: TBytes; AEncoding: TEncoding): Boolean;
+var
+  DetectedEncoding: TEncoding;
+begin
+  DetectedEncoding := nil;
+  Result :=
+    (TEncoding.GetBufferEncoding(B, DetectedEncoding) <> 0) and
+    (DetectedEncoding = AEncoding);
+end;
+
+Function DoEncodingTest : AnsiString;
+
+const
+  UTF8Bytes: array[0..18] of byte = ($EF,$BB,$BF,$D0,$9F,$D1,$80,$D0,$BE,$D0,$B2,$D0,$B5,$D1,$80,$D0,$BA,$D0,$B0);
+  UTF16Bytes: array[0..17] of byte = ($FF,$FE,$1F,$04,$40,$04,$3E,$04,$32,$04,$35,$04,$40,$04,$3A,$04,$30,$04);
+  UTF16BEBytes: array[0..17] of byte = ($FE,$FF,$04,$1F,$04,$40,$04,$3E,$04,$32,$04,$35,$04,$40,$04,$3A,$04,$30);
+
+type
+  TCp1251String = type AnsiString(1251);
+  TCp866String = type AnsiString(866);
+var
+  Cp866Encoding,
+  Cp1251Encoding: TEncoding;
+  Bytes: TBytes;
+  Cp1251String,
+  Cp1251String2: TCp1251String;
+  Cp866String: Tcp866String;
+  S: AnsiString;
+  U8: UTF8String;
+  U1, U2: UnicodeString;
+begin
+  Result:='';
+  // 1. check various conversions
+  Cp866Encoding := TEncoding.GetEncoding('IBM866');
+  Cp1251Encoding := TEncoding.GetEncoding('windows-1251');
+  Cp1251String := 'Ïðèâåò çåìëÿíå!';
+  Cp866String := Cp1251String;
+  Bytes := Cp1251Encoding.GetBytes(Cp1251String);
+  Bytes := TEncoding.Convert(Cp1251Encoding, Cp866Encoding, Bytes);
+  SetString(S, PAnsiChar(Bytes), Length(Bytes));
+  if not CompareMem(Pointer(S), Pointer(Cp866String), Length(S)) then
+    Exit('Error at 1');
+  if StringCodePage(S)<>CP_ACP then
+    Exit('Error at 11');
+  Cp1251String2:=Cp1251String;
+  SetString(Cp1251String,pchar(Cp1251String2),length(Cp1251String2));
+  if StringCodePage(Cp1251String)<>1251 then
+    Exit('Error at 12');
+  U1 := Cp866Encoding.GetString(Bytes);
+  U2 := TEncoding.Unicode.GetString(TEncoding.Convert(Cp866Encoding, TEncoding.Unicode, Bytes));
+  if U1 <> U2 then
+    Exit('Error at 2');
+  U1 := TEncoding.BigEndianUnicode.GetString(TEncoding.Convert(Cp866Encoding, TEncoding.BigEndianUnicode, Bytes));
+  if U1 <> U2 then
+    Exit('Error at 3');
+  Bytes := TEncoding.Convert(Cp866Encoding, TEncoding.UTF8, Bytes);
+  U8 := Cp866String;
+  if not CompareMem(Pointer(U8), @Bytes[0], Length(U8)) then
+    Exit('Error at 4');
+  // 2. check misc functions
+  if not (TEncoding.IsStandardEncoding(TEncoding.Unicode) or TEncoding.IsStandardEncoding(TEncoding.UTF8) or TEncoding.IsStandardEncoding(TEncoding.UTF7)) or
+    TEncoding.IsStandardEncoding(Cp866Encoding) or TEncoding.IsStandardEncoding(Cp1251Encoding) then
+    Exit('Error at 5');
+  if Cp866Encoding.EncodingName = '' then
+    Exit('Error at 6')
+  else if ShowDebugOutput then
+    WriteLn(Cp866Encoding.EncodingName);
+  if TEncoding.Default.CodePage <> DefaultSystemCodePage then
+    Exit('Error at 7');
+  // 3. check codepage detection
+  SetLength(Bytes, Length(UTF8Bytes));
+  Move(UTF8Bytes[0], Bytes[0], Length(UTF8Bytes));
+  if not CheckCodePage(Bytes, TEncoding.UTF8) then
+    Exit('Error at 8');
+  SetLength(Bytes, Length(UTF16Bytes));
+  Move(UTF16Bytes[0], Bytes[0], Length(UTF16Bytes));
+  if not CheckCodePage(Bytes, TEncoding.Unicode) then
+    Exit('Error at 9');
+  SetLength(Bytes, Length(UTF16BEBytes));
+  Move(UTF16BEBytes[0], Bytes[0], Length(UTF16BEBytes));
+  if not CheckCodePage(Bytes, TEncoding.BigEndianUnicode) then
+    Exit('Error at 10');
+  Cp866Encoding.Free;
+  Cp1251Encoding.Free;
+  Result:='';
+end;
+
+Function DoEncodingTest2 : AnsiString;
+
+var
+  ACP,StartDefaultSystemCodePage: TSystemCodePage;
+
+begin
+  StartDefaultSystemCodePage := DefaultSystemCodePage;
+  ACP:=TEncoding.ANSI.CodePage;
+  try
+    // test creating ANSI when DefaultSystemCodePage is set to non-ANSI
+    if DefaultSystemCodePage<>CP_UTF8 then
+      DefaultSystemCodePage := CP_UTF8
+    else
+      DefaultSystemCodePage := 1250;
+    if TEncoding.ANSI.CodePage<>ACP then
+      Exit('AnsiCodePage changed when setting DefaultSystemCodePage to non-initial value');
+
+    // test default
+    DefaultSystemCodePage := StartDefaultSystemCodePage;
+    if TEncoding.ANSI.CodePage<>TEncoding.SystemEncoding.CodePage then
+      Exit('Ansi codepage not set to UTF8');
+
+    // try utf-8
+    DefaultSystemCodePage := CP_UTF8;
+    if TEncoding.ANSI.CodePage<>ACP then
+      Exit('AnsiCodePage changed when setting DefaultSystemCodePage to UTF8');
+    if TEncoding.SystemEncoding.CodePage<>DefaultSystemCodePage then
+      Exit('SystemEncoding differs from defaultsystemcodepage');
+
+    // try a different single-byte encoding
+    if StartDefaultSystemCodePage=1250 then
+      DefaultSystemCodePage := 1251
+    else
+      DefaultSystemCodePage := 1250;
+
+    if TEncoding.ANSI.CodePage<>ACP then
+      Exit('Ansicodepage changed when setting defaultsystemcodepage to different single-byte codepage');
+    if TEncoding.SystemEncoding.CodePage<>DefaultSystemCodePage then
+      Exit('SystemEncoding not correctly set after changing to different single-byte codepage');
+
+    // try start again
+    DefaultSystemCodePage := StartDefaultSystemCodePage;
+    if TEncoding.SystemEncoding.CodePage<>DefaultSystemCodePage then
+      Exit('Systemencoding codepage not set correct when changing back to original');
+
+  finally
+    DefaultSystemCodePage:=StartDefaultSystemCodePage;
+  end;
+end;
+
+
+
+begin  
+  SysUtilsTest('EncodingTest',@DoEncodingTest);
+  SysUtilsTest('EncodingTest2',@DoEncodingTest2);
+end.Encodin

rtl/test/utencodingerr.pp

@@ -0,0 +1,75 @@
+unit utencodingerr;
+
+{$mode delphi}
+{$H+}
+
+interface
+
+uses
+  SysUtils;
+
+implementation
+
+uses punit, utrtl;
+
+Procedure DumpException(E : Exception);
+
+begin
+  If ShowDebugOutput then
+    Writeln(E.ClassName, ' ', E.Message);
+end;
+
+Function encodingerrors : AnsiString;
+
+var
+  S: String;
+  Bytes: TBytes;
+  
+begin
+  Result:='';
+  S := '';
+  Bytes:=Nil;
+  SetLength(Bytes, 0);
+  try
+    // invalid source array?
+    TEncoding.UTF8.GetBytes(S, 1, -1, Bytes, 0);
+    Exit('Error on 1');
+  except on E: Exception do
+    DumpException(E);
+  end;
+  S := 'Test';
+  try
+    // delphi raises a message "Invalid source array" while the problem is in
+    // destination array in real
+    TEncoding.UTF8.GetBytes(S, 0, 2, Bytes, 0);
+    Exit('Error on 2');
+  except on E: Exception do
+    DumpException(E);
+  end;
+  SetLength(Bytes, 1);
+  try
+    // invalid count
+    TEncoding.UTF8.GetBytes(S, 5, 2, Bytes, 0);
+    Exit('Error on 3');
+  except on E: Exception do
+    DumpException(E);
+  end;
+  try
+    // character index out of bounds
+    TEncoding.UTF8.GetBytes(S, 0, 2, Bytes, 0);
+    Exit('Error on 4');
+  except on E: Exception do
+    DumpException(E);
+  end;
+  try
+    // invalid destination index
+    TEncoding.UTF8.GetBytes(S, 1, 2, Bytes, -1);
+    Exit('Error on 5');
+  except on E: Exception do
+    DumpException(E);
+  end;
+end;
+
+initialization
+  SysUtilsTest('utencodingerr',@encodingerrors);  
+end.

rtl/test/utenv.pp

@@ -0,0 +1,82 @@
+{******************************************}
+{  Used to check the DOS unit              }
+{------------------------------------------}
+{  TestEncCount routine testing            }
+{******************************************}
+{$mode objfpc}
+unit utenv;
+
+interface
+
+uses punit, utrtl;
+
+implementation
+
+uses dos, utdos;
+
+Function TestEnvCount : TTestString;
+
+Var
+ I: Integer;
+ E,S : string;
+Begin
+  Result:='';
+  if ShowDebugOutput then
+    begin
+    WriteLn('----------------------------------------------------------------------');
+    WriteLn('                       ENVCOUNT/ENVSTR                                ');
+    WriteLn('----------------------------------------------------------------------');
+    WriteLn(' Note: Environment variables should be of the form VAR=VALUE          ');
+    WriteLn(' Note: Non valid indexes should return empty strings.                 ');
+    WriteLn(' Note: Index 0 points to an empty string                              ');
+    WriteLn('----------------------------------------------------------------------');
+    end;
+  if not CheckDosError('Initial value',0) then exit;
+  {*------------------------- NOTE -------------------------------------*}
+  {* Variables should be of the form VAR=VALUE                          *}
+  {*--------------------------------------------------------------------*}
+  if not AssertTrue('Have environment',EnvCount>0) then exit;
+  if ShowDebugOutput then
+    begin
+    WriteLn('Number of environment variables : ',EnvCount);
+    WriteLn('CURRENT ENVIRONMENT');
+    end;
+  For I:=1 to EnvCount do
+    begin
+    Str(I,S);
+    E:=EnvStr(i);
+    if not CheckDosError('After getting valid environment variable '+S,0) then exit;
+    if not AssertTrue('Environment var '+S+' is not empty',E<>'') then exit;
+    if ShowDebugOutput then
+      WriteLn(E);
+    end;
+  if ShowDebugOutput then
+    begin
+    WriteLn('----------------------------------------------------------------------');
+    WriteLn(' Note: The next few lines should be empty strings, as they are        ');
+    WriteLn('       invalid environment indexes.                                   ');
+    WriteLn('----------------------------------------------------------------------');
+    end;
+ For i:=-5 to 0 do
+   begin
+   Str(I,S);
+   E:=EnvStr(i);
+   if not CheckDosError('After getting valid environment variable '+S,0) then exit;
+   if not AssertTrue('Invalid environment var '+S+' is empty',E='') then exit;
+   if ShowDebugOutput then
+     WriteLn(E);
+   end;
+ For i:=EnvCount+10 to EnvCount+20 do
+   begin
+   Str(I,S);
+   E:=EnvStr(i);
+   if not CheckDosError('After getting valid environment variable '+S,0) then exit;
+   if not AssertTrue('Invalid environment var '+S+' is empty',E='') then exit;
+   if ShowDebugOutput then
+     WriteLn(E);
+   end;
+end;
+
+Begin
+  AddTest('TestEnvCount',@TestEnvCount,EnsureSuite('Dos'));
+end.

rtl/test/utexec.pp

@@ -0,0 +1,74 @@
+{$mode objfpc}
+{$h+}
+unit utexec;
+
+interface
+
+uses
+    sysutils;
+
+Function IsExecInvocation : Boolean;
+Function TestExecInvocation : Boolean;
+
+Implementation
+
+uses punit, utrtl;
+
+const
+  comparestr='-Fu/usr/local/lib/fpc/1.0.10/units/freebsd/rtl/*';
+
+Function IsExecInvocation : Boolean;
+
+begin
+  Result:=ParamStr(1)=comparestr
+end;
+
+Function TestExecInvocation : Boolean;
+
+var
+  i : Longint;
+
+begin
+  I:=1;
+  Result:=True;
+  While Result and (I<=11) do
+    begin
+    Result:=ParamStr(i)=comparestr;
+    Inc(i);
+    end;
+  Result:=Result and (paramstr(12)='');
+end;
+
+Function TestExecuteProcess : String;
+
+var
+  cmd,cmdline : String;
+  i           : Longint;
+
+
+begin
+  AllowDirectorySeparators:=['/','\'];
+  cmd:=ExtractFileName(Paramstr(0));
+{$ifdef unix}
+  cmd:='./'+cmd;
+{$endif}
+  cmdline:='';
+  for i:=0 to 10 do
+   begin
+   if Cmdline<>'' then
+     CmdLine:=CmdLine+' ';
+   cmdline:=cmdline+comparestr;
+   end;
+  if Not AssertEquals('Failed to execute test command',0,ExecuteProcess(cmd,cmdline)) Then exit;
+  // test illegal command
+  try
+    ExecuteProcess('afsdfdas',cmdline);
+    Result:='Failed to raise exception for unknown command';
+  except
+    Result:=''
+  end;
+end;
+
+begin
+  SysUtilsTest('TestExecuteProcess',@TestExecuteProcess);
+end.

rtl/test/utexpfncase.pp

@@ -0,0 +1,140 @@
+unit utexpfncase;
+
+interface
+{$MODE OBJFPC}
+{$H+}
+{$DEFINE FPCTEST}
+
+uses SysUtils;
+
+implementation
+
+uses punit, utrtl;
+
+const
+  TestFilesNumber = 3;
+{$IFDEF UNIX}
+  MinPathLength = 1;
+{$ELSE UNIX}
+  MinPathLength = 3;
+{$ENDIF UNIX}
+
+type
+  TTestFiles = array [1..TestFilesNumber] of shortstring;
+
+
+const
+  TestFiles: TTestFiles = ('testFile1.tst', 'testFile2.tst', 'TestFile2.tst');
+
+Procedure TestExpFNC (const FN1, ExpReturn: string; ExpMatch: TFilenameCaseMatch);
+
+var
+  FN2: string;
+  Match: TFilenameCaseMatch;
+  N1,N2 : String;
+  
+begin
+  Str(expmatch,N1);
+  FN2 := ExpandFileNameCase (FN1, Match);
+  if (Match <> ExpMatch)  or ((ExpReturn <> '') and (FN2 <> ExpReturn) and
+     ((Match <> mkAmbiguous) or not (FileNameCaseSensitive) or
+      (UpperCase (FN2) <> UpperCase (ExpReturn)))) then
+    begin
+    Str(Match,N2);
+    FailExit('Error: Input = '+ FN1+ ', Output = '+ FN2+ ' (expected '+ExpReturn+'), MatchFound = '+N2+' (expected '+ N1+ ')');
+    end;
+end;
+
+
+Procedure DoTestExpandFilename(TempDir : String);
+
+var
+  I: byte;
+  TestDir: string;
+
+begin
+  for I := 1 to TestFilesNumber do
+    FileClose (FileCreate (TestFiles [I]));
+
+  TestExpFNC ('*File1.tst', ExpandFileName ('testFile1.tst'), mkExactMatch);
+  if FileNameCaseSensitive then
+   TestExpFNC ('TestFile1.tst', ExpandFileName ('testFile1.tst'), mkSingleMatch)
+  else
+   TestExpFNC ('TestFile1.tst', ExpandFileName ('testFile1.tst'), mkExactMatch);
+  TestExpFNC ('testFile1.tst', ExpandFileName ('testFile1.tst'), mkExactMatch);
+  TestExpFNC ('testFile2.tst', ExpandFileName ('testFile2.tst'), mkExactMatch);
+  if FileNameCaseSensitive then
+   TestExpFNC ('TestFile2.tst', ExpandFileName ('TestFile2.tst'), mkExactMatch)
+  else
+   TestExpFNC ('TestFile2.tst', ExpandFileName ('testFile2.tst'), mkExactMatch);
+  if FileNameCaseSensitive then
+   TestExpFNC ('testfile2.tst', ExpandFileName ('testFile2.tst'), mkAmbiguous)
+  else
+   TestExpFNC ('testfile2.tst', ExpandFileName ('testFile2.tst'), mkExactMatch);
+(* Return value depends on ordering of files in the particular filesystem used thus not checked *)
+  TestExpFNC ('*File2.tst', '', mkExactMatch);
+  if FileNameCaseSensitive then
+   TestExpFNC ('*File*.tst', '', mkExactMatch)
+  else
+   TestExpFNC ('*File*.tst', '', mkExactMatch);
+  TestExpFNC ('..' + DirectorySeparator + '*' + DirectorySeparator + '*File*.tst',
+     ExpandFileName ('..' + DirectorySeparator + '*' + DirectorySeparator + '*File*.tst'),
+                                                                                    mkNone);
+  I := Length (TempDir);
+  TestDir := TempDir;
+  while (I > 1) and not (TempDir [I] in ['a'..'z','A'..'Z']) do
+   Dec (I);
+  if I > 0 then
+   begin
+    if TestDir [I] in ['a'..'z'] then
+     TestDir [I] := char (Ord (TestDir [I]) and not $20)
+    else
+     TestDir [I] := char (Ord (TestDir [I]) or $20);
+   end
+  else
+    WriteLn ('Warning: Cannot perform all required tests; please set TEMP!');
+  if FileNameCaseSensitive then
+   TestExpFNC (TestDir + DirectorySeparator + 'testFile1.tst',
+               ExpandFileName (TempDir + DirectorySeparator + 'testFile1.tst'), mkSingleMatch)
+  else
+   TestExpFNC (TestDir + DirectorySeparator + 'testFile1.tst',
+               ExpandFileName (TestDir + DirectorySeparator + 'testFile1.tst'), mkExactMatch);
+  if FileNameCaseSensitive then
+   TestExpFNC (TestDir + DirectorySeparator + 'testfile1.tst',
+               ExpandFileName (TempDir + DirectorySeparator + 'testFile1.tst'), mkSingleMatch)
+  else
+   TestExpFNC (TestDir + DirectorySeparator + 'testfile1.tst',
+               ExpandFileName (TestDir + DirectorySeparator + 'testFile1.tst'), mkExactMatch);
+  for I := 1 to TestFilesNumber do
+   if not (DeleteFile (TestFiles [I])) then
+    begin
+    if FileNameCaseSensitive or (I <> 3) then
+      WriteLn ('Warning: Deletion of ', TestFiles [I], ' (file #', I, ') failed - possibly due to case insensitive file system!');
+    end;
+end;
+
+Function TestExpandFilename : String;   
+
+var
+  TempDir : string;
+  CurDir: string;
+
+begin
+  Result:='';
+  TempDir := ExpandFilename (GetTempDir);
+  if (Length (TempDir) > MinPathLength) and
+                  (TempDir [Length (TempDir)] in AllowDirectorySeparators) then
+  TempDir := LeftStr (TempDir, Length (TempDir) - 1);
+
+  CurDir := GetCurrentDir;
+  Try
+    SetCurrentDir (TempDir);
+    DoTestExpandFilename(TempDir);
+  finally
+    SetCurrentDir(CurDir);
+  end;    
+end;
+
+begin
+  SysUtilsTest('TestExpandFileNameCase',@TestExpandFilename);
+end.

rtl/test/utextractquote.pp

@@ -0,0 +1,45 @@
+unit utextractquote;
+
+interface
+// test  AnsiExtractQuotedStr
+
+{$mode objfpc}
+{$h+}
+
+Uses SysUtils;
+
+implementation
+
+uses punit, utrtl;
+
+Function TestAnsiExtractQuotedStr : String;
+
+  Function dotest(str,val2,val3:string) : Boolean;
+
+  var
+    p : pchar;
+    s2 : string;
+
+  begin
+    p:=pchar(Str);
+    s2:=AnsiExtractQuotedStr(p,'"');
+    Result:=AssertEquals('Testing >'+Str+'< return value',val2,S2);
+    if Not Result then exit;
+    Result:=AssertEquals('Testing >'+Str+'< left value',val3,ansistring(p));
+  end;
+
+begin
+  Result:='';
+  if not dotest('"test1""test2"','test1"test2','') then exit;
+  if not dotest('"test1" "test2"','test1',' "test2"') then exit;
+  if not dotest('"test1 test2"','test1 test2','') then exit;
+  if not dotest('"test1 test2','test1 test2','') then exit;
+  if not dotest('','','') then exit;
+  if not dotest('"','','') then exit;
+  if not dotest('""','','') then exit;
+  if not dotest('"x"','x','') then exit;
+end;
+
+begin  
+  SysUtilsTest('TestAnsiExtractQuotedStr',@TestAnsiExtractQuotedStr);
+end.

rtl/test/utfattr.pp

@@ -0,0 +1,305 @@
+{******************************************}
+{  Used to check the DOS unit              }
+{------------------------------------------}
+{  SetFAttr / GetFAttr testing             }
+{******************************************}
+{$mode objfpc}
+unit utfattr;
+
+interface
+
+uses punit, utrtl;
+
+implementation
+
+uses dos, utdos;
+{$IFDEF MSDOS}
+        {$DEFINE EXTATTR}
+{$ENDIF}
+{$IFDEF DPMI}
+        {$DEFINE EXTATTR}
+{$ENDIF}
+{$IFDEF GO32V1}
+        {$DEFINE EXTATTR}
+{$ENDIF}
+{$IFDEF GO32V2}
+        {$DEFINE EXTATTR}
+{$ENDIF}
+{$IFDEF OS2}
+        {$DEFINE EXTATTR}
+{$ENDIF}
+{$IFDEF WIN32}
+        {$DEFINE EXTATTR}
+{$ENDIF}
+{$IFDEF ATARI}
+        {$DEFINE EXTATTR}
+{$ENDIF}
+{$IFDEF WINCE}
+        {$DEFINE EXTATTR}
+{$ENDIF}
+
+
+CONST
+{ what is the root path }
+{$ifdef UNIX}
+  RootPath = '/';
+{$else UNIX}
+  {$ifdef WINCE}
+    RootPath = '\';
+  {$else WINCE}
+    RootPath = 'C:\';
+  {$endif WINCE}
+{$ENDIF}
+ Week:Array[0..6] of String =
+ ('Sunday','Monday','Tuesday','Wednesday','Thursday','Friday','Saturday');
+
+ TestFName = 'TESTDOS.DAT';  { CASE SENSITIVE DON'T TOUCH! }
+ TestFName1 = 'TESTFILE';    { CASE SENSITIVE DON'T TOUCH! }
+ TestDir = 'MYDIR';          { CASE SENSITIVE DON'T TOUCH! }
+{$IFDEF TP}
+  DirectorySeparator = '\';
+{$ENDIF}
+
+
+Function TestFAttr1 : TTestString;
+
+Var
+ F: File;
+ Attr: Word;
+ m,s: string;
+
+Begin
+  Result:='';
+  Attr:=0;
+  S:='';
+  M:='Opening an invalid file...';
+  if ShowDebugOutput then
+    WriteLn(M);
+  Assign(f,'');
+  GetFAttr(f,Attr);
+  if not CheckDosError(M,3) then exit;
+  Assign(f,TestFName);
+  M:='Trying to open a valid file...';
+  if ShowDebugOutput then
+    WriteLn(M+'Success!');
+  GetFAttr(f,Attr);
+  if not CheckDosError(M,0) then exit;
+{$ifndef wince}
+  M:='Trying to open the current directory file...';
+  if ShowDebugOutput then
+    Write(M);
+  Assign(f,'.');
+  GetFAttr(f,Attr);
+  if Not AssertTrue(M+'Not directory',(attr and Directory)<>0) then
+    Exit;
+  if ShowDebugOutput then
+    Writeln('Success');
+  if not CheckDosError(M,0) then exit;
+  M:='Trying to open the parent directory file...';
+  if ShowDebugOutput then
+    Write(M);
+  Assign(f,'..');
+  GetFAttr(f,Attr);
+  if not AssertTrue(M+'Not directory',(attr and Directory)<> 0) then
+    exit;
+  if ShowDebugOutput then
+     WriteLn('Success!');
+  if not CheckDosError(M,0) then exit;
+{$endif wince}
+{ This is completely platform dependent
+  M:='Trying to open the parent directory file when in root...';
+  if ShowDebugOutput then
+    Write(M);
+  Getdir(0,s);
+  ChDir(RootPath);
+  Assign(f,'..');
+  GetFAttr(f,Attr);
+  ChDir(s);
+  if not CheckDosError(M,3) then exit;
+  if ShowDebugOutput then
+    WriteLn('Success!');
+}
+{$ifdef go32v2}
+  { Should normally fail, because of end directory separator. This is
+    allowed under unixes so the test is go32v2 only }
+  M:='Trying to open a directory file...Success!';
+  if ShowDebugOutput then
+    WriteLn(M);
+  GetDir(0,s);
+  Assign(f,s+DirectorySeparator);
+  GetFAttr(f, Attr);
+  if not CheckDosError(M,3) then exit;
+{$endif}
+  M:='Trying to open a directory file...';
+  if ShowDebugOutput then
+    Write(M);
+{$ifdef wince}
+  s:='\windows';
+{$else}
+  GetDir(0,s);
+{$endif wince}
+  Assign(f,s);
+  GetFAttr(f, Attr);
+  if not AssertTrue(M+'Not directory',(attr and Directory)<> 0) then
+   exit;
+  if ShowDebugOutput then
+    WriteLn('Success!');
+  CheckDosError(M,0);
+end;
+
+Function TestFAttr : TTestString;
+Var
+ F: File;
+ Attr: Word;
+ s: string;
+Begin
+  Result:='';
+  Attr:=0;
+  S:='';
+  Assign(f, TestFname);
+  {----------------------------------------------------------------}
+  { This routine causes problems, because it all depends on the    }
+  { operating system. It is assumed here that HIDDEN is available  }
+  { to all operating systems.                                      }
+  {----------------------------------------------------------------}
+  s:='Setting read-only attribute on '+TestFName+'...';
+  SetFAttr(f,ReadOnly);
+  if not CheckDosError(S,0) then exit;
+{$IFDEF EXTATTR}
+  GetFAttr(f,Attr);
+  if not CheckDosError(S,0) then exit;
+  if not AssertTrue(S+'Read-only attribute set.',Attr and ReadOnly<> 0) then exit;
+  if ShowDebugOutput then
+    WriteLn(s+'Success.')
+  { file should no longer be read only }
+  s:='Removing read-only attribute...';
+  SetFAttr(f,Archive);
+  if not CheckDosError(S,0) then exit;
+  GetFAttr(f,Attr);
+  if not CheckDosError(S,0) then exit;
+  if not AssertTrue(S+'Read-only attribute still set.',Attr and ReadOnly=0) then exit;
+  if ShowDebugOutput then
+    WriteLn(s+'Success.');
+{$ENDIF}
+  s:='Setting hidden attribute on '+TestFName+'...';
+  SetFAttr(f,Hidden);
+  CheckDosError(S,0);
+{$IFDEF EXTATTR}
+  GetFAttr(f,Attr);
+  CheckDosError(0);
+  if not AssertTrue(S+'Hidden attribute set.',Attr and Hidden<> 0) then exit;
+  if ShowDebugOutput then
+    WriteLn(s+'Success.');
+  { file should no longer be read only }
+  s:='Removing hidden attribute...';
+  SetFAttr(f,Archive);
+  CheckDosError(S,0);
+  GetFAttr(f,Attr);
+  CheckDosError(S,0);
+  if not AssertTrue(S+'Hidden attribute still set.',Attr and Hidden=0) then exit;
+  if ShowDebugOutput then
+    WriteLn(s+'Success.');
+{$ENDIF}
+
+{$IFDEF EXTATTR}
+
+ s:='Setting system attribute on '+TestFName+'...';
+ SetFAttr(f,SysFile);
+ CheckDosError(S,0);
+ GetFAttr(f,Attr);
+ CheckDosError(S,0);
+ if not AssertTrue(S+'System attribute set.',Attr and SysFile<> 0) then exit;
+ if ShowDebugOutput then
+   WriteLn(s+'Success.')
+ { file should no longer be read only }
+ s:='Removing Sysfile attribute...';
+ SetFAttr(f,0);
+ CheckDosError(0);
+ GetFAttr(f,Attr);
+ CheckDosError(0);
+ if not AssertTrue(S+'System attribute set.',Attr and SysFile= 0) then exit;
+ if ShowDebugOutput then
+   WriteLn(s+'Success.');
+{$ENDIF}
+{
+ s:='Setting Directory attribute on '+TestFName+'...';
+ SetFAttr(f,Directory);
+ CheckDosError(S,5);
+ GetFAttr(f,Attr);
+ CheckDosError(S,0);
+ if Not AssertTrue(s+'Directory Attribute set.',(Attr and Directory)=0) then exit;
+ if ShowDebugOutput then
+   WriteLn(s+'Success.');
+}
+ {**********************************************************************}
+ {********************** TURBO PASCAL BUG ******************************}
+ { The File is not a volume name, and DosError = 0, which is incorrect  }
+ { it shoulf not be so in FPC.                                          }
+ {**********************************************************************}
+ {********************** TURBO PASCAL BUG ******************************}
+ s:='Setting Volume attribute on '+TestFName+'...';
+ SetFAttr(f,VolumeID);
+{$ifndef tp}
+ CheckDosError(S,5);
+{$else}
+ CheckDosError(S,0);
+{$endif}
+ GetFAttr(f,Attr);
+ CheckDosError(S,0);
+ if not AssertTrue(s+'Volume Attribute set.',Attr and VolumeID=0) then
+ if ShowDebugOutput then
+   WriteLn(s+'Success.');
+end;
+
+
+Function DoneFattr : TTestString;
+
+var
+  f: file;
+
+begin
+  Result:='';
+  RmDir(TestDir);
+  Assign(f,TestFname);
+  Erase(f);
+  Assign(f,TestFname1);
+  Erase(f);
+end;
+
+Function InitFattr : TTestString;
+
+var
+  f: file;
+
+Begin
+  Result:='';
+{$IFDEF MACOS}
+  pathTranslation:= true;
+{$ENDIF}
+  if ShowDebugoutput then
+    WriteLn('File should never be executed in root path!');
+  Assign(f,TestFName);
+  Rewrite(f,1);
+  BlockWrite(f,Week,sizeof(Week));
+  Close(f);
+  Assign(f,TestFName1);
+  Rewrite(f,1);
+  Close(F);
+  MkDir(TestDir);
+end;
+
+Procedure RegisterFattrTests;
+
+Var
+  P : PSuite;
+
+begin
+  P:=AddSuite('Fattr',@InitFattr,@DonefAttr,EnsureSuite('Dos'));
+  AddTest('testfattr1',@testfattr1,P);
+  AddTest('testfattr',@testfattr,P);
+end;
+
+initialization
+  RegisterFattrTests;
+
+end.

rtl/test/utfexpand.pp

@@ -0,0 +1,476 @@
+unit utfexpand;
+
+{$mode objfpc}
+{$h+}
+interface
+{ %target=linux,freebsd,openbsd,netbsd,win32,win64,darwin,haiku,morphos }
+
+{
+    This file is part of the Free Pascal test suite.
+    Copyright (c) 1999-2004 by the Free Pascal development team.
+
+    Test for possible bugs in SysUtils.ExpandFileName
+
+    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.
+
+ **********************************************************************}
+
+{$codepage utf8}
+
+
+{ $DEFINE DEBUG}
+(* Defining DEBUG causes all the source and target strings *)
+(* to be written to the console to make debugging easier.  *)
+
+uses
+{$ifdef unix}
+ {$ifdef darwin}iosxwstr{$else}cwstring{$endif},
+{$endif}
+ SysUtils;
+
+implementation
+
+uses punit, utrtl;
+
+{$IFDEF LINUX}
+ {$IFNDEF UNIX}
+  {$DEFINE UNIX}
+ {$ENDIF UNIX}
+{$ENDIF LINUX}
+
+{$IFDEF AMIGA}
+ {$DEFINE VOLUMES}
+ {$DEFINE NODRIVEC}
+{$ENDIF AMIGA}
+
+{$IFDEF NETWARE}
+ {$DEFINE VOLUMES}
+ {$DEFINE NODRIVEC}
+{$ENDIF NETWARE}
+
+{$IFDEF UNIX}
+ {$DEFINE NODRIVEC}
+{$ENDIF UNIX}
+
+{$IFDEF MACOS}
+ {$DEFINE VOLUMES}
+ {$DEFINE NODRIVEC}
+ {$DEFINE NODOTS}
+{$ENDIF MACOS}
+
+const
+{$IFNDEF NODRIVEC}
+ CC = UTF8String('C:');
+{$ENDIF NODRIVEC}
+{$IFNDEF FPC}
+ FileNameCasePreserving = false;
+ DirectorySeparator = '\';
+ DirectorySeparator2 = '\';
+ DirSep = '\';
+ CDrive = 'C:';
+ DriveSep = ':';
+{$ELSE FPC}
+(* Used for ChDir/MkDir *)
+ DirectorySeparator2 = UTF8String(System.DirectorySeparator);
+ {$IFDEF DIRECT}
+  {$IFDEF MACOS}
+ DirectorySeparator = UTF8String(':');
+ LFNSupport = true;
+ FileNameCasePreserving = true;
+  {$ELSE MACOS}
+   {$IFDEF UNIX}
+ DirectorySeparator = UTF8String('/');
+ DriveSeparator = UTF8String('/');
+ FileNameCasePreserving = true;
+   {$ELSE UNIX}
+    {$IFDEF AMIGA}
+ DirectorySeparator = UTF8String(':');
+ FileNameCasePreserving = true;
+    {$ELSE AMIGA}
+ DirectorySeparator = UTF8String('\');
+ FileNameCasePreserving = false;
+    {$ENDIF AMIGA}
+   {$ENDIF UNIX}
+  {$ENDIF MACOS}
+ {$ENDIF DIRECT}
+ DirSep = UTF8String(DirectorySeparator);
+ {$IFDEF MACOS}
+ DriveSep = '';
+ {$ELSE MACOS}
+  {$IFDEF AMIGA}
+ DriveSep = '';
+  {$ELSE AMIGA}
+ DriveSep = DriveSeparator;
+  {$ENDIF AMIGA}
+ {$ENDIF MACOS}
+ {$IFDEF UNIX}
+ CDrive = '';
+ {$ELSE UNIX}
+  {$IFDEF MACOS}
+ CDrive = UTF8String('C');
+  {$ELSE MACOS}
+   {$IFDEF AMIGA}
+ CDrive = UTF8String('C');
+   {$ELSE AMIGA}
+ CDrive = UTF8String('C:');
+   {$ENDIF AMIGA}
+  {$ENDIF MACOS}
+ {$ENDIF UNIX}
+{$ENDIF FPC}
+ TestFileName = UTF8String('™estfilê.™st');
+ TestDir1Name = UTF8String('TÊS™DIR1');
+ TestDir2Name = UTF8String('TE∑™DIR2');
+
+
+var
+{$IFNDEF NODRIVEC}
+ CDir,
+{$endif}
+ TestDir, TestDir0, OrigDir, CurDir, S: UTF8String;
+ TestDrive: UTF8String;
+ F: file;
+
+function Translate (S: rawbytestring): rawbytestring;
+var
+ I: byte;
+begin
+{$IFDEF UNIX}
+ if (Length (S) > 1) and (S [2] = ':') then Delete (S, 1, 2);
+{$ELSE UNIX}
+ for I := 1 to Length (S) do if S [I] = '/' then S [I] := DirSep[1];
+ if (Length (S) > 1) and (S [1] in ['a'..'z']) and (S[2]=DriveSep) then
+   S [1] := UpCase (S [1]);
+{$ENDIF UNIX}
+ if not (FileNameCasePreserving) then
+   for I := 1 to Length (S) do S [I] := UpCase (S [I]);
+ Translate := S;
+end;
+
+procedure Check (Src, Rslt: rawbytestring);
+var
+ Rslt2: rawbytestring;
+begin
+{$IFDEF DEBUG}
+ WriteLn (Src, '=>', Rslt);
+{$ENDIF DEBUG}
+ Rslt := Translate (Rslt);
+ Rslt2 := ExpandFileName (Src);
+{$IFDEF DIRECT}
+ {$IFNDEF FPC_FEXPAND_DRIVES}
+ I := Pos (System.DriveSeparator, Rslt2);
+ if I <> 0 then
+  Delete (Rslt2, 1, I);
+ {$ENDIF FPC_FEXPAND_DRIVES}
+{$ENDIF DIRECT}
+{$IFNDEF UNIX}
+ if (Length (Rslt2) > 1) and (Rslt2 [1] in ['a'..'z']) and (Rslt2[2]=DriveSep) then
+   Rslt2 [1] := UpCase (Rslt2 [1]);
+{$ENDIF NDEF UNIX}
+
+ if Rslt <> Rslt2 then
+   FailExit('Error: ExpandFileName ('+Src+ ') should be "'+Rslt+'", not "'+Rslt2+'"');
+end;
+
+Function DoTestFexpand : AnsiString;
+
+begin
+   Result:='';
+   Assign (F, TestFileName);
+   Rewrite (F);
+   Close (F);
+   if IOResult <> 0 then ;
+   { prevent conversion of TestFileName to ansi code page in case of
+     ExpandFileName(ansistring) }
+   Assign (F, ExpandFileName (RawByteString(TestFileName)));
+  {$I+}
+   GetDir (0, CurDir);
+  {$IFNDEF NODRIVEC}
+   GetDir (3, CDir);
+  {$ENDIF NODRIVEC}
+   Check (' ', CurDir + DirSep + ' ');
+  {$IFDEF AMIGA}
+   Check ('', CurDir);
+  {$ELSE AMIGA}
+   Check ('', CurDir + DirSep);
+  {$ENDIF AMIGA}
+  {$IFDEF MACOS}
+   Check (':', CurDir + DirSep);
+  {$ELSE MACOS}
+   Check ('.', CurDir);
+  {$ENDIF MACOS}
+
+  {$IFNDEF NODRIVEC}
+  if CDir [Length (CDir)] = DirSep then Check ('c:anything', CDir + 'anything')
+                           else Check ('c:anything', CDir + DirSep + 'anything');
+   Check (CC + DirSep, CDrive + DirSep);
+  {$IFDEF NODOTS}
+   Check ('C:.', 'C:.');
+   Check (CC + DirSep + '.', CDrive + DirSep + '.');
+   Check (CC + DirSep + '..', CDrive + DirSep + '..');
+  {$ELSE NODOTS}
+   Check ('C:.', CDir);
+   Check (CC + DirSep + '.', CDrive + DirSep);
+   Check (CC + DirSep + '..', CDrive + DirSep);
+  {$ENDIF NODOTS}
+   Check (CC + DirSep + UTF8String('∂œ∑'), CDrive + DirSep + UTF8String('∂œ∑'));
+  {$IFNDEF NODOTS}
+   Check (CC + DirSep + '..' + DirSep + UTF8String('∂œ∑'), CDrive + DirSep + UTF8String('∂œ∑'));
+  {$ENDIF NODOTS}
+   Check (CC + DirSep + 'DOS.', CDrive + DirSep + 'DOS.');
+  {$IFDEF AMIGA}
+   Check (CC + DirSep + UTF8String('∂œ∑') + DirSep, CDrive + DirSep);
+  {$ELSE AMIGA}
+   Check (CC + DirSep + UTF8String('∂œ∑') + DirSep, CDrive + DirSep + UTF8String('∂œ∑') + DirSep);
+  {$ENDIF AMIGA}
+  {$IFNDEF NODOTS}
+   Check (CC + DirSep + UTF8String('∂œ∑') + DirSep + '.', CDrive + DirSep + UTF8String('∂œ∑'));
+   Check (CC + DirSep + UTF8String('∂œ∑') + DirSep + '..', CDrive + DirSep);
+   Check (CC + DirSep + UTF8String('∂œ∑') + DirSep + '..' + DirSep, CDrive + DirSep);
+   Check (CC + DirSep + UTF8String('∂œ∑') + DirSep + UTF8String('†ĘŚ™') + DirSep + '..', CDrive +
+                                                                 DirSep + UTF8String('∂œ∑'));
+   Check (CC + DirSep + UTF8String('∂œ∑') + DirSep + UTF8String('†ĘŚ™') + DirSep + '..' + DirSep,
+                                               CDrive + DirSep + UTF8String('∂œ∑') + DirSep);
+  {$ENDIF NODOTS}
+  {$ENDIF NODRIVEC}
+
+  {$IFNDEF MACOS}
+   Check (DirSep, TestDrive + DirSep);
+   Check (DirSep + '.', TestDrive + DirSep);
+   Check (DirSep + '..', TestDrive + DirSep);
+   Check (DirSep + UTF8String('∂œ∑'), TestDrive + DirSep + UTF8String('∂œ∑'));
+  {$ENDIF MACOS}
+   Check (UTF8String('∆'), CurDir + DirSep + UTF8String('∆'));
+  {$IFDEF MACOS}
+   Check (DirSep + UTF8String('∆'), CurDir + DirSep + UTF8String('∆'));
+  {$ELSE MACOS}
+   {$IFNDEF NODOTS}
+   Check ('.' + DirSep + UTF8String('∆'), CurDir + DirSep + UTF8String('∆'));
+   {$ENDIF NODOTS}
+  {$ENDIF MACOS}
+   Check (UTF8String('∆') + DirSep + TestFileName, CurDir + DirSep + UTF8String('∆') + DirSep + TestFileName);
+   Check (UTF8String(' ∆'), CurDir + DirSep + UTF8String(' ∆'));
+   Check (UTF8String('∆∆'), CurDir + DirSep + UTF8String('∆∆'));
+  {$IFDEF MACOS}
+   Check (DirSep + UTF8String('∆∆') + DirSep + UTF8String('∆∆'), CurDir + DirSep + UTF8String('∆∆') + DirSep + UTF8String('∆∆'));
+   Check (UTF8String('∆∆') + DirSep + UTF8String('∆∆'), UTF8String('∆∆') + DirSep + UTF8String('∆∆'));
+  {$ELSE MACOS}
+   Check (UTF8String('∆∆') + DirSep + UTF8String('∆∆'), CurDir + DirSep + UTF8String('∆∆') + DirSep + UTF8String('∆∆'));
+  {$ENDIF MACOS}
+   Check (UTF8String('∂∂∂'), CurDir + DirSep + UTF8String('∂∂∂'));
+  {$IFDEF MACOS}
+   Check (UTF8String('∂∂∂∂') + DirSep + UTF8String('ÊÊÊÊ.ƒƒƒƒ'), UTF8String('∂∂∂∂') + DirSep + UTF8String('ÊÊÊÊ.ƒƒƒƒ'));
+  {$ELSE MACOS}
+   Check (UTF8String('∂∂∂∂') + DirSep + UTF8String('ÊÊÊÊ.ƒƒƒƒ'), CurDir + DirSep + UTF8String('∂∂∂∂') + DirSep
+                                                                  + UTF8String('ÊÊÊÊ.ƒƒƒƒ'));
+  {$ENDIF MACOS}
+   Check (UTF8String(UTF8String('.∑πê©îæ¬')), CurDir + DirSep + UTF8String(UTF8String('.∑πê©îæ¬')));
+   Check (UTF8String('..∑πê©îæ¬'), CurDir + DirSep + UTF8String('..∑πê©îæ¬'));
+   Check (UTF8String('∑πê©îæ¬..'), CurDir + DirSep + UTF8String('∑πê©îæ¬..'));
+  {$IFDEF AMIGA}
+   Check (UTF8String('∑πê©îæ¬.') + DirSep, CurDir);
+  {$ELSE AMIGA}
+   {$IFDEF MACOS}
+   Check (UTF8String('∑πê©îæ¬.') + DirSep, UTF8String('∑πê©îæ¬.') + DirSep);
+   {$ELSE MACOS}
+   Check (UTF8String('∑πê©îæ¬.') + DirSep, CurDir + DirSep + UTF8String('∑πê©îæ¬.') + DirSep);
+   {$ENDIF MACOS}
+  {$ENDIF AMIGA}
+  {$IFDEF MACOS}
+   Check (DirSep + DirSep, TestDir + TestDir1Name + DirSep);
+   Check (DirSep + DirSep + TestFileName, TestDir + TestDir1Name + DirSep
+                                                                 + TestFileName);
+  {$ELSE MACOS}
+   Check (DirSep + UTF8String('.∑πê©îæ¬'), TestDrive + DirSep + UTF8String(UTF8String('.∑πê©îæ¬')));
+   {$IFNDEF NODOTS}
+   Check ('..', TestDir + TestDir1Name);
+   Check ('.' + DirSep + '..', TestDir + TestDir1Name);
+   Check ('..' + DirSep + '.', TestDir + TestDir1Name);
+   {$ENDIF NODOTS}
+  {$ENDIF MACOS}
+  {$IFDEF NETWARE}
+   Check ('...', TestDir);
+  {$ELSE NETWARE}
+   Check ('...', CurDir + DirSep + '...');
+  {$ENDIF NETWARE}
+   Check (TestFileName, CurDir + DirSep + TestFileName);
+  {$IFDEF UNIX}
+   S := GetEnvironmentVariable ('HOME');
+   { On m68k netbsd at least, HOME contains a final slash
+     remove it PM }
+   if (Length (S) > 1) and (S [Length (S)] = DirSep) then
+     S:=Copy(S,1,Length(S)-1);
+   if Length (S) = 0 then
+    begin
+     Check ('~', CurDir);
+     Check ('~' + DirSep + '.', DirSep);
+    end
+   else
+    begin
+     Check ('~', S);
+     Check ('~' + DirSep + '.', S);
+    end;
+   if (Length (S) > 0) and (S [Length (S)] <> DirSep) then
+    S := S + DirSep;
+   Check (UTF8String('~ıœßodyWithThisNameShouldEverExist.test/nothinfl'), CurDir + DirSep +
+                              UTF8String('~ıœßodyWithThisNameShouldEverExist.test/nothinfl'));
+   Check ('/tmp/~NoSº©hUse®Again', '/tmp/~NoSº©hUse®Again');
+   if Length (S) = 0 then
+    begin
+     Check ('~' + DirSep, DirSep);
+     Check ('~' + DirSep + '.' + DirSep, DirSep);
+     Check ('~' + DirSep + UTF8String('∂î®ê©†œ®Ú') + DirSep + UTF8String('anothe®'),
+                                      DirSep + UTF8String('∂î®ê©†œ®Ú') + DirSep + UTF8String('anothe®'));
+    end
+   else
+    begin
+     Check ('~' + DirSep, S);
+     Check ('~' + DirSep + '.' + DirSep, S);
+     Check ('~' + DirSep + UTF8String('∂î®ê©†œ®Ú') + DirSep + UTF8String('anothe®'),
+                                           S + UTF8String('∂î®ê©†œ®Ú') + DirSep + UTF8String('anothe®'));
+    end;
+  {$ELSE UNIX}
+   {$IFNDEF NODRIVEC}
+   Check (TestDrive + '..', TestDir + TestDir1Name);
+   Check (TestDrive + '..' + DirSep, TestDir + TestDir1Name + DirSep);
+   Check (TestDrive + '.' + DirSep + '.', CurDir);
+   Check (TestDrive + '.' + DirSep + '..', TestDir + TestDir1Name);
+  {$I-}
+  (*
+  { $ ifndef unix }
+  {   avoid a and b drives for
+     no unix systems to reduce the
+     probablility of getting an alert message box }
+   { This should not be needed - unit popuperr should solve this?! TH }
+   I := 3;
+  {$else unix} *)
+   I := 1;
+  { $ endif unix}
+   repeat
+    S := '';
+    GetDir (I, S);
+    IOR := IOResult;
+    if IOR = 0 then Inc (I);
+   until (I > 26) or (IOR <> 0);
+   if I <= 26 then
+   begin
+    S := UTF8String(Chr (I + 64)) + UTF8String(':∂∂∂');
+    Check (S, UTF8String(Chr (I + 64)) + UTF8String(':') + DirSep + UTF8String('∂∂∂'));
+   end else
+     WriteLn ('Sorry, cannot test ExpandFileName behaviour for incorrect drives here.');
+  {$I+}
+    {$IFDEF FPC}
+   Check ('∆\∆/∆', CurDir + DirSep + UTF8String('∆') + DirSep + UTF8String('∆') + DirSep + UTF8String('∆'));
+   Check ('\\serve®\sha®e\di®ectory', '\\serve®\sha®e\di®ectory');
+   Check ('\\serve®\sha®e\directo®y1\directo®y2\..',
+                                                    '\\serve®\sha®e\directo®y1');
+   Check ('\\', '\\');
+   Check ('\\.', '\\.\');
+   Check ('\\.\', '\\.\');
+   Check ('\\.\.', '\\.\.');
+   Check ('\\.\..', '\\.\..');
+   Check ('\\.\...', '\\.\...');
+   Check ('\\.\†êÒ™', '\\.\†êÒ™');
+   Check ('\\..\', '\\..\');
+   Check ('\\..\†êÒ™', '\\..\†êÒ™');
+   Check ('\\..\†êÒ™\.', '\\..\†êÒ™');
+   Check ('\\..\†êÒ™1\TÊ∑T2\..', '\\..\†êÒ™1');
+   Check ('\\..\†êÒ™\..', '\\..\†êÒ™');
+   Check ('\\..\†êÒ™\..\..', '\\..\†êÒ™');
+    {$ENDIF FPC}
+   {$ENDIF NODRIVEC}
+  {$ENDIF UNIX}
+  {$IFDEF VOLUMES}
+   Check (UTF8String('√olıame') + DriveSep + DirSep + UTF8String('∆ή1'), UTF8String('√olıame') + DriveSep + DirSep + UTF8String('∆ή1'));
+   {$IFNDEF NODOTS}
+   Check (UTF8String('√olıame') + DriveSep + DirSep + UTF8String('∆ή1') + DirSep + '..', UTF8String('√olıame') + DriveSep + DirSep);
+   Check (UTF8String('√olıame') + DriveSep + DirSep + UTF8String('∆ή1') + DirSep + '..' + DirSep + '..',
+                                                            UTF8String('√olıame') + DriveSep + DirSep);
+   Check (UTF8String('√olıame') + DriveSep + DirSep + '.', UTF8String('√olıame:') + DirSep);
+   Check (UTF8String('√olıame') + DriveSep + DirSep + '..', UTF8String('√olıame:') + DirSep);
+   Check (UTF8String('√olıame') + DriveSep + DirSep + '..' + DirSep, UTF8String('√olıame') + DriveSep + DirSep);
+   {$ENDIF NODOTS}
+   {$IFDEF NETWARE}
+   Check (UTF8String('∑rvName\√olıame') + DriveSep + DirSep + UTF8String('†ĘŚ™'), UTF8String('∑rvName') + DirSep + UTF8String('√olıame') +
+                                                           DriveSep + DirSep + UTF8String('†ĘŚ™'));
+   Check (UTF8String('∑rvName/√olıame') + DriveSep + DirSep + UTF8String('†ĘŚ™'), UTF8String('∑rvName') + DirSep + UTF8String('√olıame') +
+                                                           DriveSep + DirSep + UTF8String('†ĘŚ™'));
+   {$ENDIF NETWARE}
+   {$IFDEF AMIGA}
+    {$IFDEF NODOTS}
+   Check ('.', CurDir + DirSep + '.');
+    {$ELSE NODOTS}
+   Check ('.', CurDir);
+    {$ENDIF NODOTS}
+   {$ENDIF AMIGA}
+  {$ENDIF VOLUMES}
+   Erase (F);
+  {$IFNDEF NODRIVEC}
+   ChDir (OrigTstDir);
+  {$ENDIF NODRIVEC}
+end;
+
+Function TestFexpand : AnsiString;
+
+begin
+  Result:='';
+  { ensure ExpandFileName doesn't lose data when the file system can represent all characters }
+  DefaultFileSystemCodePage:=CP_UTF8;
+  DefaultRTLFileSystemCodePage:=CP_UTF8;
+  { ensure we do lose data if we somewhere accidentally use the default system code page
+    to perform operations }
+  DefaultSystemCodePage:=CP_ASCII;
+  if TestDir [Length (TestDir)] <> DirectorySeparator2 then
+    TestDir := TestDir + DirectorySeparator2;
+  GetDir (0, OrigDir);
+  {$IFDEF NODRIVEC}
+   TestDrive := '';
+  {$ELSE NODRIVEC}
+   TestDrive := Copy (TestDir, 1, 2);
+   GetDir ((Ord (TestDir [1]) and not ($20)) - 64, OrigTstDir);
+  {$ENDIF NODRIVEC}
+  {$I-}
+   MkDir (TestDir + TestDir1Name);
+   if IOResult <> 0 then ;
+   MkDir (TestDir + TestDir1Name + DirectorySeparator2 + TestDir2Name);
+   if IOResult <> 0 then ;
+  {$I+}
+   ChDir (TestDir + TestDir1Name + DirectorySeparator2 + TestDir2Name);
+  {$I-}
+   TestDir0 := TestDir;
+   try
+     Result:=DoTestFExpand;
+   finally
+     ChDir (OrigDir);
+     RmDir (TestDir0 + TestDir1Name + DirectorySeparator2 + TestDir2Name);
+     RmDir (TestDir0 + TestDir1Name);
+  end;
+end;
+
+Procedure GetTestDir;
+
+Var
+  T : String;
+
+begin
+  T:=SysGetSetting('fexpanddir');
+  if T='' then
+   {$IFDEF DIRECT}System.{$ENDIF DIRECT}GetDir (0,T);
+  if T='' then
+    T:='.';
+  TestDir:=T;
+end;
+
+begin
+  case GetSysTestOS of
+    'linux','freebsd','openbsd','netbsd','win32','win64','darwin','haiku','morphos':
+      begin
+      GetTestDir;
+      SysUtilsTest('TestFexpand',@TestFexpand);
+      end;
+  end;
+end.

rtl/test/utffirst.pp

@@ -0,0 +1,275 @@
+unit utffirst;
+{$mode objfpc}
+{$h+}
+{$codepage utf8}
+interface
+
+uses
+{$ifdef unix}
+  {$ifdef darwin}iosxwstr{$else}cwstring{$endif},
+{$endif}
+  SysUtils;
+
+
+implementation
+
+uses punit, utrtl;
+
+Function dotffirstutf8 : string;
+
+const
+  FNAME = utf8string('adéfg');
+  
+var
+  f: thandle;
+  res: longint;
+  fnamecmp,
+  fsearch : utf8string;
+  rsr: TRawByteSearchRec;
+
+begin
+  Result:='';
+  DeleteFile(FNAME);
+  f:=FileCreate(FNAME);
+  if f<=0 then
+    Exit('Cannot create file');
+  FileClose(f);
+  
+  { determine how the file system reports the name of the file (with the é
+    precomposed or decomposed) so we can pass the correct form to findfirst. We cannot
+    deal with this automatically in findfirst itself, because some OSes/file systems
+    allow both forms to coexist. }
+  if (findfirst('ad*fg',faAnyFile and not(faDirectory),rsr)<>0) then
+    Exit('Findfirst 1 did not return result')
+  else
+    begin
+      fnamecmp:=rsr.name;
+      findclose(rsr);
+    end;
+
+  fsearch:=fnamecmp;
+  fsearch[1]:='?';
+  res:=findfirst(fsearch,faAnyFile and not(faDirectory),rsr);
+
+  if Not AssertEquals('Findfirst 2: res',0,Res) then
+    exit;
+  if not AssertEquals('Findfirst 2 : name',fnamecmp,rsr.name) then
+    begin
+    findclose(rsr);
+    exit;
+    end;
+  fsearch:=fnamecmp;
+  fsearch[2]:='?';
+  if (findfirst(fsearch,faAnyFile and not(faDirectory),rsr)<>0) or
+     (rsr.name<>fnamecmp) then
+    Exit('FindFirst 3 failed')
+  else
+    findclose(rsr);
+
+  { must succeed regardless of whether the é is decomposed or not }
+  if (findfirst('ad?fg',faAnyFile and not(faDirectory),rsr)<>0) or
+     (rsr.name<>fnamecmp) then
+    Exit('FindFirst 4 failed')
+  else
+    findclose(rsr);
+
+  { this should succeed if if the the é is decomposed (at least "ls ade?fg" succeeds
+    on Mac OS X) }
+  if (fnamecmp[3]='e') then
+    if (findfirst('ade?fg',faAnyFile and not(faDirectory),rsr)<>0) then
+      Exit('FindFirst 5')
+    else
+      findclose(rsr);
+
+  fsearch:=fnamecmp;
+  fsearch[length(fsearch)-1]:='?';
+  if (findfirst(fsearch,faAnyFile and not(faDirectory),rsr)<>0) or
+     (rsr.name<>fnamecmp) then
+    Exit('FindFirst 6')
+  else
+    findclose(rsr);
+
+  fsearch:=fnamecmp;
+  fsearch[length(fsearch)]:='?';
+  if (findfirst(fsearch,faAnyFile and not(faDirectory),rsr)<>0) or
+     (rsr.name<>fnamecmp) then
+    Exit('FindFirst 7')
+  else
+    findclose(rsr);
+
+  if (findfirst('a*fg',faAnyFile and not(faDirectory),rsr)<>0) or
+     (rsr.name<>fnamecmp) then
+    Exit('FindFirst 8')
+  else
+    findclose(rsr);
+
+  if (findfirst('ad*',faAnyFile and not(faDirectory),rsr)<>0) or
+     (rsr.name<>fnamecmp) then
+    Exit('FindFirst 9')
+  else
+    findclose(rsr);
+
+  fsearch:=fnamecmp;
+  fsearch[length(fsearch)-1]:='*';
+  if (findfirst(fsearch,faAnyFile and not(faDirectory),rsr)<>0) or
+     (rsr.name<>fnamecmp) then
+    Exit('FindFirst 10')
+  else
+    findclose(rsr);
+end;
+
+Function tffirstutf8 : string;
+const
+  FNAME = utf8string('adéfg');
+
+Var
+  curdir: utf8string;
+
+begin
+  RemoveDir('tffdir');
+  if not DirectoryExists('tffdir') then
+    if not CreateDir('tffdir') then
+      exit('Failed to create test dir tffdir');
+  curdir:=utf8string(GetCurrentDir);
+  if not SetCurrentDir('tffdir') then
+    Exit('Cannot chdir to  test dir');
+  Result:=dotffirstutf8;
+  DeleteFile(FNAME);
+  SetCurrentDir(curdir);
+  RemoveDir('tffdir');
+end;
+
+
+
+Function dotffirstutf16 : string;
+
+const
+  FNAME = unicodestring('adéfg');
+var
+  f: thandle;
+  res: longint;
+  fnamecmp,
+  fsearch,
+  curdir: unicodestring;
+  usr: TUnicodeSearchRec;
+begin
+  DeleteFile(FNAME);
+  f:=FileCreate(FNAME);
+  if f<=0 then
+    Exit('Failed to create file');
+  FileClose(f);
+  
+  { determine how the file system reports the name of the file (with the é
+    precomposed or decomposed) so we can pass the correct form to findfirst. We cannot
+    deal with this automatically in findfirst itself, because some OSes/file systems
+    allow both forms to coexist. }
+  if (findfirst('ad*fg',faAnyFile and not(faDirectory),usr)<>0) then
+    Exit('Failed at 11')
+  else
+    begin
+      fnamecmp:=usr.name;
+      findclose(usr);
+    end;
+
+  fsearch:=fnamecmp;
+  fsearch[1]:='?';
+  res:=findfirst(fsearch,faAnyFile and not(faDirectory),usr);
+  if Not AssertEquals('Findfirst 2 res',0,Res) then exit;
+  if Not AssertEquals('Findfirst 2 name',fnamecmp,usr.name) then
+    begin
+    findClose(usr);
+    exit;
+    end;
+  findclose(usr);
+
+  fsearch:=fnamecmp;
+  fsearch[2]:='?';
+  if (findfirst(fsearch,faAnyFile and not(faDirectory),usr)<>0) or
+     (usr.name<>fnamecmp) then
+    Exit('Failed at 13')
+  else
+    findclose(usr);
+
+  { must succeed regardless of whether the é is decomposed or not }
+  if (findfirst('ad?fg',faAnyFile and not(faDirectory),usr)<>0) or
+     (usr.name<>fnamecmp) then
+    Exit('Failed at 14')
+  else
+    findclose(usr);
+
+  { this should succeed if if the the é is decomposed (at least "ls ade?fg" succeeds
+    on Mac OS X) }
+  if (fnamecmp[3]='e') then
+    if (findfirst('ade?fg',faAnyFile and not(faDirectory),usr)<>0) then
+      Exit('Failed at 15')
+    else
+      findclose(usr);
+
+  fsearch:=fnamecmp;
+  fsearch[length(fsearch)-1]:='?';
+  if (findfirst(fsearch,faAnyFile and not(faDirectory),usr)<>0) or
+     (usr.name<>fnamecmp) then
+    Exit('Failed at 16')
+  else
+    findclose(usr);
+
+  fsearch:=fnamecmp;
+  fsearch[length(fsearch)]:='?';
+  if (findfirst(fsearch,faAnyFile and not(faDirectory),usr)<>0) or
+     (usr.name<>fnamecmp) then
+    Exit('Failed at 17')
+  else
+    findclose(usr);
+
+  if (findfirst('a*fg',faAnyFile and not(faDirectory),usr)<>0) or
+     (usr.name<>fnamecmp) then
+    Exit('Failed at 18')
+  else
+    findclose(usr);
+
+  if (findfirst('ad*',faAnyFile and not(faDirectory),usr)<>0) or
+     (usr.name<>fnamecmp) then
+    Exit('Failed at 19')
+  else
+    findclose(usr);
+
+  fsearch:=fnamecmp;
+  fsearch[length(fsearch)-1]:='*';
+  if (findfirst(fsearch,faAnyFile and not(faDirectory),usr)<>0) or
+     (usr.name<>fnamecmp) then
+    Exit('Failed at 20')
+  else
+    findclose(usr);
+end;
+
+Function tffirstutf16 : string;
+const
+  FNAME = unicodestring('adéfg');
+
+Var
+  curdir: utf8string;
+
+begin
+  RemoveDir('tffdir');
+  if not DirectoryExists('tffdir') then
+    if not CreateDir('tffdir') then
+      exit('Failed to create test dir tffdir');
+  curdir:=utf8string(GetCurrentDir);
+  if not SetCurrentDir('tffdir') then
+    Exit('Cannot chdir to  test dir');
+  Result:=Dotffirstutf16;
+  DeleteFile(FNAME);
+  SetCurrentDir(curdir);
+  RemoveDir('tffdir');
+end;
+
+begin
+  Case GetSysTestOS of
+    'linux','freebsd','openbsd','netbsd','win32','win64','darwin','haiku','morphos' :
+       begin
+       SysutilsTest('TestFFirstUtf8',@tffirstutf8);
+       SysutilsTest('TestFFirstUtf16',@tffirstutf16);
+       end;
+  end;
+end.
+

rtl/test/utfile.pp

@@ -0,0 +1,222 @@
+unit utfile;
+
+{$mode objfpc}
+{$h+}
+
+interface
+
+uses
+  SysUtils;
+
+Implementation
+
+uses punit, utrtl;
+
+Function File1 : String;
+
+var
+  l,l2: longint;
+begin
+  try
+    try
+      l:=filecreate('tfile2.dat');
+      if (l<0) then
+        FailExit('unable to create file');
+      fileclose(l);
+      l:=fileopen('tfile2.dat',fmopenread);
+      if (filewrite(l,l,sizeof(l))>0) then
+        FailExit('writing to read-only file succeeded');
+      fileclose(l);
+      deletefile('tfile2.dat');
+
+
+      l:=filecreate('tfile2.dat');
+      if (l<0) then
+        FailExit('unable to create file (2)');
+      fileclose(l);
+      l:=fileopen('tfile2.dat',fmopenwrite);
+      if (filewrite(l,l,sizeof(l))<>sizeof(l)) then
+        FailExit('writing to write-only file failed');
+      if (fileseek(l,0,fsFromBeginning)<>0) then
+        FailExit('seeking write-only file failed');
+      if (fileread(l,l2,sizeof(l))>=0) then
+        FailExit('reading from write-only file succeeded');
+      fileclose(l);
+
+      l:=fileopen('tfile2.dat',fmopenread or fmShareDenyWrite);
+      if (l<0) then
+        FailExit('unable to open file in read-only mode and fmShareDenyWrite mode');
+      l2:=fileopen('tfile2.dat',fmopenread or fmShareDenyWrite);
+      if (l2 < 0) then
+        FailExit('opening two files as read-only with fmShareDenyWrite failed');
+      fileclose(l2);
+      l2:=fileopen('tfile2.dat',fmopenread or fmShareExclusive);
+      if (l2 >= 0) then
+        begin
+          fileclose(l2);
+          FailExit('opening file first as read-only with fmShareDenyWrite, and then again as fmopenread with fmShareExclusive succeeded');
+        end;
+      fileclose(l);
+
+
+      l:=fileopen('tfile2.dat',fmopenwrite or fmShareExclusive);
+      if (l<0) then
+        FailExit('unable to open file in write-only and fmShareExclusive mode');
+      l2:=fileopen('tfile2.dat',fmopenwrite or fmShareExclusive);
+      if (l2 >= 0) then
+        begin
+          fileclose(l2);
+          FailExit('opening two files as write-only with fmShareExclusive succeeded');
+        end;
+      l2:=fileopen('tfile2.dat',fmopenwrite or fmShareDenyWrite);
+      if (l2 >= 0) then
+        begin
+          fileclose(l2);
+          FailExit('opening file first as write-only with fmShareExclusive, and then again as fmopenwrite with fmShareDenyWrite succeeded');
+        end;
+      fileclose(l);
+
+
+      l:=fileopen('tfile2.dat',fmopenread or fmShareExclusive);
+      if (l<0) then
+        FailExit('unable to open file in read-only and fmShareExclusive mode');
+      l2:=fileopen('tfile2.dat',fmopenread or fmShareExclusive);
+      if (l2 >= 0) then
+        begin
+          fileclose(l2);
+          FailExit('opening two files as read-only with fmShareExclusive succeeded');
+        end;
+      l2:=fileopen('tfile2.dat',fmopenread or fmShareDenyWrite);
+      if (l2 >= 0) then
+        begin
+          fileclose(l2);
+          FailExit('opening file first as read-only with fmShareExclusive, and then again as fmopenread with fmShareDenyWrite succeeded');
+        end;
+      fileclose(l);
+
+
+      l:=fileopen('tfile2.dat',fmopenread);
+      if (l<0) then
+        FailExit('unable to open file in read-only mode (2)');
+      l2:=fileopen('tfile2.dat',fmopenread);
+      if (l2 >= 0) then
+        begin
+          fileclose(l2);
+          FailExit('opening two files as read-only without sharing specified succeeded (should not, file is by default locked)');
+        end;
+      l2:=fileopen('tfile2.dat',fmopenread or fmShareDenyWrite);
+      if (l2 >= 0) then
+        begin
+          fileclose(l2);
+          FailExit('opening two files as read-only with fmShareDenyWrite succeeded (should not, file is by default locked)');
+        end;
+      fileclose(l);
+
+
+      { should be same as no locking specified }
+      l:=fileopen('tfile2.dat',fmopenread or fmShareCompat);
+      if (l<0) then
+        FailExit('unable to open file in read-only mode (3)');
+      l2:=fileopen('tfile2.dat',fmopenread or fmShareCompat);
+      if (l2 >= 0) then
+        begin
+          fileclose(l2);
+          FailExit('opening two files as read-only with fmShareCompat succeeded (should be locked)');
+        end;
+      l2:=fileopen('tfile2.dat',fmopenread or fmShareDenyWrite);
+      if (l2 >= 0) then
+        begin
+          fileclose(l2);
+          FailExit('opening file first as read-only fmShareCompat (should not have any effect), and then again as fmopenread with fmShareDenyWrite succeeded');
+        end;
+      fileclose(l);
+
+
+      l:=fileopen('tfile2.dat',fmopenread or fmShareDenyNone);
+      if (l<0) then
+        FailExit('unable to open file in read-only mode and fmShareDenyNone mode');
+      l2:=fileopen('tfile2.dat',fmopenread or fmShareDenyNone);
+      if (l2 < 0) then
+        FailExit('opening two files as read-only with fmShareDenyNone failed');
+      fileclose(l2);
+      l2:=fileopen('tfile2.dat',fmopenread or fmShareDenyWrite);
+      if (l2 < 0) then
+        FailExit('opening two files as read-only with fmShareDenyNone and then fmShareDenyWrite failed');
+      fileclose(l2);
+{ on Windows, fmShareExclusive checks whether the file is already open in any way by the current
+  or another process. On Unix, that is not the case, and we also cannot check against a
+  fmShareDenyNone mode
+}
+{$ifndef unix}
+      l2:=fileopen('tfile2.dat',fmopenread or fmShareExclusive);
+      if (l2 >= 0) then
+        begin
+          fileclose(l2);
+          FailExit('opening two files as read-only with fmShareDenyNone and then fmShareExclusive succeeded');
+        end;
+{$endif}
+      fileclose(l);
+
+      l:=fileopen('tfile2.dat',fmopenread or fmShareDenyWrite);
+      if (l<0) then
+        FailExit('unable to open file in read-only mode and fmShareDenyWrite mode (2)');
+      l2:=fileopen('tfile2.dat',fmopenread or fmShareDenyNone);
+      if (l2 < 0) then
+        FailExit('opening files as read-only with fmShareDenyWrite and then fmShareDenyNone failed');
+      fileclose(l2);
+      fileclose(l);
+
+
+      l:=fileopen('tfile2.dat',fmopenwrite or fmShareDenyNone);
+      if (l<0) then
+        FailExit('unable to open file in write-only mode and fmShareDenyNone mode');
+      l2:=fileopen('tfile2.dat',fmopenread or fmShareDenyNone);
+      if (l2 < 0) then
+        FailExit('opening two files as read/write-only with fmShareDenyNone failed');
+      fileclose(l2);
+
+    except
+      on e: exception do
+        begin
+          writeln(e.message);
+          exitcode:=1;
+        end;
+    end;
+  finally
+    if (l>=0) then
+      fileclose(l);
+    deletefile('tfile2.dat');
+  end;
+end;
+
+Function file2 : string;
+
+VAR
+  dateTime: TDateTime;
+  f : file;
+
+BEGIN
+  if FileExists('datetest.dat') then
+    begin
+    Assign(f,'datetest.dat');
+    Erase(f);
+    end;
+  if FileExists('datetest.dat') then
+    Exit('Error at 1000');
+  FileClose(FileCreate('datetest.dat'));
+  if not(FileExists('datetest.dat')) then
+    Exit('Error at 1001');
+  dateTime := IncMonth(Now, -1);
+  if FileSetDate('datetest.dat', DateTimeToFileDate(dateTime))<>0 then
+    Exit('Error at 1002');
+  if FileExists('datetest.dat') then
+    begin
+    Assign(f,'datetest.dat');
+    Erase(f);
+    end;
+end;
+
+begin
+  SysutilsTest('tfile1',@file1);
+  SysutilsTest('tfile2',@file2);
+end.

rtl/test/utfile1.pp

@@ -0,0 +1,40 @@
+PROGRAM Test;
+
+USES
+  SysUtils;
+
+procedure do_error(l : longint);
+  begin
+     writeln('Error near number ',l);
+     halt(1);
+  end;
+
+VAR
+  dateTime: TDateTime;
+  f : file;
+
+BEGIN
+  if FileExists('datetest.dat') then
+    begin
+      Assign(f,'datetest.dat');
+      Erase(f);
+    end;
+
+  if FileExists('datetest.dat') then
+    do_error(1000);
+
+  FileClose(FileCreate('datetest.dat'));
+
+  if not(FileExists('datetest.dat')) then
+    do_error(1001);
+
+  dateTime := IncMonth(Now, -1);
+  if FileSetDate('datetest.dat', DateTimeToFileDate(dateTime))<>0 then
+    do_error(1002);
+
+  if FileExists('datetest.dat') then
+    begin
+      Assign(f,'datetest.dat');
+      Erase(f);
+    end;
+END.

rtl/test/utfile2.pp

@@ -0,0 +1,188 @@
+{$ifdef fpc}
+{$mode objfpc}
+{$h+}
+{$endif}
+
+uses
+  SysUtils;
+
+{$ifndef fpc}
+const
+  fmsharecompat = cardinal(0);
+  fsFromBeginning = cardinal(0);
+{$endif}
+
+var
+  l,l2: longint;
+begin
+  try
+    try
+      l:=filecreate('tfile2.dat');
+      if (l<0) then
+        raise exception.create('unable to create file');
+      fileclose(l);
+      l:=fileopen('tfile2.dat',fmopenread);
+      if (filewrite(l,l,sizeof(l))>0) then
+        raise exception.create('writing to read-only file succeeded');
+      fileclose(l);
+      deletefile('tfile2.dat');
+
+
+      l:=filecreate('tfile2.dat');
+      if (l<0) then
+        raise exception.create('unable to create file (2)');
+      fileclose(l);
+      l:=fileopen('tfile2.dat',fmopenwrite);
+      if (filewrite(l,l,sizeof(l))<>sizeof(l)) then
+        raise exception.create('writing to write-only file failed');
+      if (fileseek(l,0,fsFromBeginning)<>0) then
+        raise exception.create('seeking write-only file failed');
+      if (fileread(l,l2,sizeof(l))>=0) then
+        raise exception.create('reading from write-only file succeeded');
+      fileclose(l);
+
+      l:=fileopen('tfile2.dat',fmopenread or fmShareDenyWrite);
+      if (l<0) then
+        raise exception.create('unable to open file in read-only mode and fmShareDenyWrite mode');
+      l2:=fileopen('tfile2.dat',fmopenread or fmShareDenyWrite);
+      if (l2 < 0) then
+        raise exception.create('opening two files as read-only with fmShareDenyWrite failed');
+      fileclose(l2);
+      l2:=fileopen('tfile2.dat',fmopenread or fmShareExclusive);
+      if (l2 >= 0) then
+        begin
+          fileclose(l2);
+          raise exception.create('opening file first as read-only with fmShareDenyWrite, and then again as fmopenread with fmShareExclusive succeeded');
+        end;
+      fileclose(l);
+
+
+      l:=fileopen('tfile2.dat',fmopenwrite or fmShareExclusive);
+      if (l<0) then
+        raise exception.create('unable to open file in write-only and fmShareExclusive mode');
+      l2:=fileopen('tfile2.dat',fmopenwrite or fmShareExclusive);
+      if (l2 >= 0) then
+        begin
+          fileclose(l2);
+          raise exception.create('opening two files as write-only with fmShareExclusive succeeded');
+        end;
+      l2:=fileopen('tfile2.dat',fmopenwrite or fmShareDenyWrite);
+      if (l2 >= 0) then
+        begin
+          fileclose(l2);
+          raise exception.create('opening file first as write-only with fmShareExclusive, and then again as fmopenwrite with fmShareDenyWrite succeeded');
+        end;
+      fileclose(l);
+
+
+      l:=fileopen('tfile2.dat',fmopenread or fmShareExclusive);
+      if (l<0) then
+        raise exception.create('unable to open file in read-only and fmShareExclusive mode');
+      l2:=fileopen('tfile2.dat',fmopenread or fmShareExclusive);
+      if (l2 >= 0) then
+        begin
+          fileclose(l2);
+          raise exception.create('opening two files as read-only with fmShareExclusive succeeded');
+        end;
+      l2:=fileopen('tfile2.dat',fmopenread or fmShareDenyWrite);
+      if (l2 >= 0) then
+        begin
+          fileclose(l2);
+          raise exception.create('opening file first as read-only with fmShareExclusive, and then again as fmopenread with fmShareDenyWrite succeeded');
+        end;
+      fileclose(l);
+
+
+      l:=fileopen('tfile2.dat',fmopenread);
+      if (l<0) then
+        raise exception.create('unable to open file in read-only mode (2)');
+      l2:=fileopen('tfile2.dat',fmopenread);
+      if (l2 >= 0) then
+        begin
+          fileclose(l2);
+          raise exception.create('opening two files as read-only without sharing specified succeeded (should not, file is by default locked)');
+        end;
+      l2:=fileopen('tfile2.dat',fmopenread or fmShareDenyWrite);
+      if (l2 >= 0) then
+        begin
+          fileclose(l2);
+          raise exception.create('opening two files as read-only with fmShareDenyWrite succeeded (should not, file is by default locked)');
+        end;
+      fileclose(l);
+
+
+      { should be same as no locking specified }
+      l:=fileopen('tfile2.dat',fmopenread or fmShareCompat);
+      if (l<0) then
+        raise exception.create('unable to open file in read-only mode (3)');
+      l2:=fileopen('tfile2.dat',fmopenread or fmShareCompat);
+      if (l2 >= 0) then
+        begin
+          fileclose(l2);
+          raise exception.create('opening two files as read-only with fmShareCompat succeeded (should be locked)');
+        end;
+      l2:=fileopen('tfile2.dat',fmopenread or fmShareDenyWrite);
+      if (l2 >= 0) then
+        begin
+          fileclose(l2);
+          raise exception.create('opening file first as read-only fmShareCompat (should not have any effect), and then again as fmopenread with fmShareDenyWrite succeeded');
+        end;
+      fileclose(l);
+
+
+      l:=fileopen('tfile2.dat',fmopenread or fmShareDenyNone);
+      if (l<0) then
+        raise exception.create('unable to open file in read-only mode and fmShareDenyNone mode');
+      l2:=fileopen('tfile2.dat',fmopenread or fmShareDenyNone);
+      if (l2 < 0) then
+        raise exception.create('opening two files as read-only with fmShareDenyNone failed');
+      fileclose(l2);
+      l2:=fileopen('tfile2.dat',fmopenread or fmShareDenyWrite);
+      if (l2 < 0) then
+        raise exception.create('opening two files as read-only with fmShareDenyNone and then fmShareDenyWrite failed');
+      fileclose(l2);
+{ on Windows, fmShareExclusive checks whether the file is already open in any way by the current
+  or another process. On Unix, that is not the case, and we also cannot check against a
+  fmShareDenyNone mode
+}
+{$ifndef unix}
+      l2:=fileopen('tfile2.dat',fmopenread or fmShareExclusive);
+      if (l2 >= 0) then
+        begin
+          fileclose(l2);
+          raise exception.create('opening two files as read-only with fmShareDenyNone and then fmShareExclusive succeeded');
+        end;
+{$endif}
+      fileclose(l);
+
+      l:=fileopen('tfile2.dat',fmopenread or fmShareDenyWrite);
+      if (l<0) then
+        raise exception.create('unable to open file in read-only mode and fmShareDenyWrite mode (2)');
+      l2:=fileopen('tfile2.dat',fmopenread or fmShareDenyNone);
+      if (l2 < 0) then
+        raise exception.create('opening files as read-only with fmShareDenyWrite and then fmShareDenyNone failed');
+      fileclose(l2);
+      fileclose(l);
+
+
+      l:=fileopen('tfile2.dat',fmopenwrite or fmShareDenyNone);
+      if (l<0) then
+        raise exception.create('unable to open file in write-only mode and fmShareDenyNone mode');
+      l2:=fileopen('tfile2.dat',fmopenread or fmShareDenyNone);
+      if (l2 < 0) then
+        raise exception.create('opening two files as read/write-only with fmShareDenyNone failed');
+      fileclose(l2);
+
+    except
+      on e: exception do
+        begin
+          writeln(e.message);
+          exitcode:=1;
+        end;
+    end;
+  finally
+    if (l>=0) then
+      fileclose(l);
+    deletefile('tfile2.dat');
+  end;
+end.

rtl/test/utfilename.pp

@@ -0,0 +1,120 @@
+unit utfilename;
+
+{$IFDEF FPC}
+{$mode objfpc}{$H+}
+{$ENDIF}
+interface
+
+uses
+  SysUtils;
+
+implementation
+
+uses punit, utrtl;
+
+Function TestFuncs(testidx:integer;const res,expected: string) : Boolean;
+begin
+  Result:=AssertEquals('Failure at '+IntToStr(TestIdx),expected,res);
+end;
+
+Function TestFileName : String;
+
+begin
+  Result:='';
+  // Default Unix
+  AllowDirectorySeparators:=['/','\'];
+  AllowDriveSeparators:=[];
+  If not TestFuncs(1,ExtractFilePath('./:'),'./') then exit;
+  If not TestFuncs(2,ExtractFileName('./:'),':') then exit;
+  If not TestFuncs(3,ExtractFileDrive('./:'),'') then exit;
+
+  If not TestFuncs(4,ExtractFilePath('C:/blah:blah'),'C:/') then exit;
+  If not TestFuncs(5,ExtractFileName('C:/blah:blah'),'blah:blah') then exit;
+  If not TestFuncs(6,ExtractFileDrive('C:/blah:blah'),'') then exit;
+
+  If not TestFuncs(7,ExtractFilePath('./\'),'./\') then exit;
+  If not TestFuncs(8,ExtractFileName('./\'),'') then exit;
+  If not TestFuncs(9,ExtractFileDrive('./\'),'') then exit;
+
+  If not TestFuncs(10,ExtractFilePath('./c:'),'./') then exit;
+  If not TestFuncs(11,ExtractFileName('./c:'),'c:') then exit;
+  If not TestFuncs(12,ExtractFileDrive('./c:'),'') then exit;
+
+  If not TestFuncs(13,ExtractFilePath('\\server\share\file'),'\\server\share\') then exit;
+  If not TestFuncs(14,ExtractFileName('\\server\share\file'),'file') then exit;
+  If not TestFuncs(15,ExtractFileDrive('\\server\share\file'),'\\server\share') then exit;
+
+  // Kylix compatibility mode
+  AllowDirectorySeparators:=['/'];
+  AllowDriveSeparators:=[];
+  If not TestFuncs(101,ExtractFilePath('./:'),'./') then exit;
+  If not TestFuncs(102,ExtractFileName('./:'),':') then exit;
+  If not TestFuncs(103,ExtractFileDrive('./:'),'') then exit;
+
+  If not TestFuncs(104,ExtractFilePath('C:/blah:blah'),'C:/') then exit;
+  If not TestFuncs(105,ExtractFileName('C:/blah:blah'),'blah:blah') then exit;
+  If not TestFuncs(106,ExtractFileDrive('C:/blah:blah'),'') then exit;
+
+  If not TestFuncs(107,ExtractFilePath('./\'),'./') then exit;
+  If not TestFuncs(108,ExtractFileName('./\'),'\') then exit;
+  If not TestFuncs(109,ExtractFileDrive('./\'),'') then exit;
+
+  If not TestFuncs(110,ExtractFilePath('./c:'),'./') then exit;
+  If not TestFuncs(111,ExtractFileName('./c:'),'c:') then exit;
+  If not TestFuncs(112,ExtractFileDrive('./c:'),'') then exit;
+
+  If not TestFuncs(113,ExtractFilePath('\\server\share\file'),'') then exit;
+  If not TestFuncs(114,ExtractFileName('\\server\share\file'),'\\server\share\file') then exit;
+  If not TestFuncs(115,ExtractFileDrive('\\server\share\file'),'') then exit;
+
+  // Default Windows/DOS/SO2
+  AllowDirectorySeparators:=['/','\'];
+  AllowDriveSeparators:=[':'];
+  If not TestFuncs(201,ExtractFilePath('./:'),'./:') then exit;
+  If not TestFuncs(202,ExtractFileName('./:'),'') then exit;
+  If not TestFuncs(203,ExtractFileDrive('./:'),'') then exit;
+
+  If not TestFuncs(204,ExtractFilePath('C:/blah:blah'),'C:/blah:') then exit;
+  If not TestFuncs(205,ExtractFileName('C:/blah:blah'),'blah') then exit;
+  If not TestFuncs(206,ExtractFileDrive('C:/blah:blah'),'C:') then exit;
+
+  If not TestFuncs(207,ExtractFilePath('./\'),'./\') then exit;
+  If not TestFuncs(208,ExtractFileName('./\'),'') then exit;
+  If not TestFuncs(209,ExtractFileDrive('./\'),'') then exit;
+
+  If not TestFuncs(210,ExtractFilePath('./c:'),'./c:') then exit;
+  If not TestFuncs(211,ExtractFileName('./c:'),'') then exit;
+  If not TestFuncs(212,ExtractFileDrive('./c:'),'') then exit;
+
+  If not TestFuncs(213,ExtractFilePath('\\server\share\file'),'\\server\share\') then exit;
+  If not TestFuncs(214,ExtractFileName('\\server\share\file'),'file') then exit;
+  If not TestFuncs(215,ExtractFileDrive('\\server\share\file'),'\\server\share') then exit;
+
+  // Windows/DOS/SO2 Delphi Compatibility
+  AllowDirectorySeparators:=['\'];
+  AllowDriveSeparators:=[':'];
+  If not TestFuncs(301,ExtractFilePath('./:'),'./:') then exit;
+  If not TestFuncs(302,ExtractFileName('./:'),'') then exit;
+  If not TestFuncs(303,ExtractFileDrive('./:'),'') then exit;
+
+  If not TestFuncs(304,ExtractFilePath('C:/blah:blah'),'C:/blah:') then exit;
+  If not TestFuncs(305,ExtractFileName('C:/blah:blah'),'blah') then exit;
+  If not TestFuncs(306,ExtractFileDrive('C:/blah:blah'),'C:') then exit;
+
+  If not TestFuncs(307,ExtractFilePath('./\'),'./\') then exit;
+  If not TestFuncs(308,ExtractFileName('./\'),'') then exit;
+  If not TestFuncs(309,ExtractFileDrive('./\'),'') then exit;
+
+  If not TestFuncs(310,ExtractFilePath('./c:'),'./c:') then exit;
+  If not TestFuncs(311,ExtractFileName('./c:'),'') then exit;
+  If not TestFuncs(312,ExtractFileDrive('./c:'),'') then exit;
+
+  If not TestFuncs(313,ExtractFilePath('\\server\share\file'),'\\server\share\') then exit;
+  If not TestFuncs(314,ExtractFileName('\\server\share\file'),'file') then exit;
+  If not TestFuncs(315,ExtractFileDrive('\\server\share\file'),'\\server\share') then exit;
+end;
+  
+begin
+  SysutilsTest('TestFileName',@TestFileName);
+end.
+

rtl/test/utfloattostr.pp

@@ -0,0 +1,226 @@
+unit utfloattostr;
+
+{$mode objfpc}
+{$h+}
+interface
+
+{ Test for FloatToStr and CurrToStr functions. }
+
+uses sysutils;
+
+implementation
+
+uses punit, utrtl;
+
+const
+  MaxCurrency : currency = 922337203685477.5807;
+  MinCurrency : currency = -922337203685477.5807;
+
+var
+  ErrCount: longint;
+
+Function CheckVal(nr,step,cycle : Integer; f: Extended) : Boolean;
+var
+  s,v1,v2,tn: string;
+  f1: Extended;
+
+begin
+  TN:='Cycle nr '+intToStr(Nr)+' step :'+INtToStr(Step)+' cycle : '+IntToStr(Cycle)+' : ';
+  Result:=True;
+  s := FloatToStr(f);
+  f1 := StrToFloat(s);
+  if (f<>f1) and (Abs(f-f1)/Abs(f) > 6e-15) then
+    begin
+    Str(Abs(f-f1)/Abs(f),v1);
+    Str(f,V2);
+    Fail(TN+'Error (Double):'+V1+ ' Input:'+V2+' Output:'+s);
+    Exit(False);
+    end;
+  f := Single(f);
+  s := FloatToStr(Single(f));
+  f1 := StrToFloat(s);
+  if (f<>f1) and (Abs(f-f1)/Abs(f) > 6e-10) then
+    begin
+    Str(Abs(f-f1)/Abs(f),v1);
+    Str(f,V2);
+    Fail(TN+'Error (Single):'+V1+ ' Input:'+v2+' Output:'+s);
+    Exit(False);
+    end;
+end;
+
+Function Cycle(nr,step : Integer; f: Extended) : Boolean;
+
+var
+  i: Integer;
+begin
+  Result:=True;
+  for i := 1 to 50 do
+    begin
+    if not CheckVal(nr,step,i,f) then exit(False);
+    if not CheckVal(nr,step,i,-f) then exit(False);
+    f := f/10;
+    end;
+end;
+
+Function CycleInc(Nr : Integer; f, increment: Extended) : Boolean;
+
+var
+  i: Integer;
+begin
+  Result:=True;
+  if not Cycle(NR,-1,f) then Exit(False);
+  for i := 0 to 30 do
+    begin
+    if not Cycle(Nr,I,f+increment) then exit(False);
+    if not Cycle(Nr,I,f-increment) then exit(False);
+    increment := increment/10;
+    end;
+end;
+
+Function CheckResult(Nr : Integer; const s, ref: string) : Boolean;
+begin
+  Result:=AssertEquals('Test '+IntToStr(Nr),Ref,S);
+end;
+
+Function TestFloatToStr : String;
+
+var
+  e: extended;
+  d: double;
+  s: single;
+  c: currency;
+  i: Integer;
+  tests: array [0..4] of Double = (123456789123456789., 1e20, 1.6e20, 5e20, 9e20);
+  CS,DSep,TSep : String;
+
+begin
+  Result:='';
+  DSep:=DefaultFormatSettings.DecimalSeparator;
+  TSep:=DefaultFormatSettings.ThousandSeparator;
+  e:=1234567890123.4;
+  d:=12345.12345;
+  s:=12345.12;
+  c:=12345.1234;
+  if not CheckResult(1,FloatToStrF(e,ffExponent,15,1), '1'+DSep+'23456789012340E+12') then exit;
+  If not CheckResult(2,FloatToStrF(d,ffExponent,11,0), '1'+DSep+'2345123450E+4') then exit;
+  If not CheckResult(3,FloatToStrF(s,ffExponent,8,0), '1'+DSep+'2345120E+4') then exit;
+  If not CheckResult(4,FloatToStrF(s,ffExponent,8,7), '1'+DSep+'2345120E+0004') then exit;
+  If not CheckResult(5,FloatToStrF(e,ffExponent,8,3), '1'+DSep+'2345679E+012') then exit;
+  If not CheckResult(6,FloatToStrF(c,ffExponent,10,0), '1'+DSep+'234512340E+4') then exit;
+  If not CheckResult(7,FloatToStrF(c,ffExponent,11,2), '1'+DSep+'2345123400E+04') then exit;
+  If not CheckResult(8,FloatToStrF(c,ffExponent,10,4), '1'+DSep+'234512340E+0004') then exit;
+  If not CheckResult(9,FloatToStrF(-12345.12345,ffExponent,11,0), '-1'+DSep+'2345123450E+4') then exit;
+  If not CheckResult(10,FloatToStrF(-0.00000123,ffGeneral,15,0), '-1'+DSep+'23E-6') then exit;
+  If not CheckResult(11,FloatToStrF(-12345.12345,ffGeneral,7,0), '-12345'+DSep+'12') then exit;
+  If not CheckResult(12,CurrToStr(-12345.1234), '-12345'+DSep+'1234') then exit;
+  If not CheckResult(13,CurrToStr(MaxCurrency), '922337203685477'+DSep+'5807') then exit;
+  If not CheckResult(14,CurrToStr(MinCurrency), '-922337203685477'+DSep+'5807') then exit;
+  DefaultFormatSettings.NegCurrFormat:=8;
+  CS:=DefaultFormatSettings.CurrencyString;
+  If not CheckResult(15,FloatToStrF(-12345.1234,ffCurrency,19,4), '-12' + TSep + '345'+DSep+'1234 ' + CS) then exit;
+  If not CheckResult(16,FloatToStrF(MinCurrency,ffCurrency,19,4), '-922' + TSep + '337' + TSep + '203' + Tsep + '685' + Tsep + '477'+DSep+'5807 ' + CS) then exit;
+  for i := 0 to High(tests) do
+    begin
+    e := tests[i];
+    if not CycleInc(I*10+1,e,1e20) then exit;
+    if not CycleInc(I*10+2,e,9e20) then exit;
+    if not CycleInc(I*10+3,e,e) then exit;
+    if not CycleInc(I*10+3,e,e/2) then exit;
+    if not CycleInc(I*10+3,e,e/3) then exit;
+    end;
+end;
+
+Function TestFormatFloat : TTestString;
+
+Var
+  CT : Integer;
+
+  Function Check(aCount : Integer; AExpected,AActual : String): Boolean;
+
+  begin
+    Result:=AssertEquals('Check '+IntToStr(aCount),AExpected,AActual);
+    CT:=aCount;
+  end;
+
+
+  function TestIt(CR : Extended; Fmt,Expected : String) : Boolean;
+
+  begin
+    Result:=Check(CT+1,Expected,FormatFloat(Fmt,CR));
+  end;
+
+begin
+  Result:='';
+  DefaultFormatSettings.ThousandSeparator:=',';
+  DefaultFormatSettings.DecimalSeparator:='.';
+
+  if not Check(1,'1.23',FormatFloat('#.##',1.23)) then exit;
+  If not Check(3,'1.23',FormatFloat('0.##',1.23)) then exit;
+  If not Check(5,'1.23',FormatFloat('#.0#',1.23)) then exit;
+  If not Check(7,'1.2',FormatFloat('#.0#',1.2)) then exit;
+  If not Check(9,'1.23',FormatFloat('0.0#',1.23)) then exit;
+  If not Check(11,'1.23',FormatFloat('0.00',1.23)) then exit;
+  If not Check(11,'001.23',FormatFloat('000.00',1.23)) then exit;
+  If not Check(13,'1.20',FormatFloat('0.00',1.2)) then exit;
+
+  If not Check(14,'1235',FormatFloat('#####',1234.567)) then exit;
+  If not Check(15,'01235',FormatFloat('00000',1234.567)) then exit;
+  If not Check(16,'1235',FormatFloat('0',1234.567)) then exit;
+  If not Check(17,'1,235',FormatFloat('#,##0',1234.567)) then exit;
+  If not Check(18,'1,235',FormatFloat(',0',1234.567)) then exit;
+  // Include the decimal value
+  If not Check(19,'1234.567',FormatFloat('0.####', 1234.567)) then exit;
+  If not Check(20,'1234.5670',FormatFloat('0.0000', 1234.567)) then exit;
+  // IsScientific format
+  If not Check(22,'1.2345670E+03',FormatFloat('0.0000000E+00', 1234.567)) then exit;
+  If not Check(23,'1.2345670E03',FormatFloat('0.0000000E-00', 1234.567)) then exit;
+  If not Check(24,'1.234567E3',FormatFloat('#.#######E-##', 1234.567)) then exit;
+
+  // Include freeform text
+  If not Check(25,'Value = 1234.6',FormatFloat('"Value = "0.0', 1234.567)) then exit;
+
+  // Different formatting for negative numbers
+  If not Check(26,'-1234.6',FormatFloat('0.0', -1234.567)) then exit;
+  If not Check(27,'1234.6 DB',FormatFloat('0.0 "CR";0.0 "DB"', -1234.567)) then exit;
+  If not Check(28,'1234.6 CR',FormatFloat('0.0 "CR";0.0 "DB"',  1234.567)) then exit;
+
+  // Different format for zero value
+  If not Check(29,'0.0',FormatFloat('0.0', 0.0)) then exit;
+  If not Check(30,'Nothing',FormatFloat('0.0;-0.0;"Nothing"', 0.0)) then exit;
+  If not Check(-30,'Nothing',formatfloat('0.0;-0.0;"Nothing"', 0.0)) then exit;
+  // Thousand separators
+  // bug 30950
+  If not Check(31,'449,888.06',FormatFloat('#,###,##0.00', 449888.06)) then exit;
+  // Bug  29781
+  If not Check(32,'2,222.00',FormatFloat('###,##0.00', 2222.0)) then exit;
+  // tw10519
+  if not check(33, '5.22480E+0004', FormatFloat('0.00000E+0000',52247.9532745)) then exit;
+  // tw11711
+  if not check(34,'-001.000',formatFloat('000.000',-1)) then exit;
+  // tw13552
+  DefaultFormatSettings.ThousandSeparator:=#0;
+  if not Check(35,'1000.00',formatfloat('#,0.00',1000.0)) then exit;
+  DefaultFormatSettings.ThousandSeparator:=',';
+  // tw15308
+  if not Check(36,'1.0500E+002',formatFloat('0.0000E+000', 1.05e2)) then exit;
+  if not Check(37,'1.0600E+002',formatFloat('0.0000E+000', 1.06e2)) then exit;
+  // tw 12385
+  If not Testit(1234.567,'00000000.00','00001234.57') then exit;
+  If not Testit(-1234.567,'00000000.00','-00001234.57') then exit;
+  If not Testit(-1234.567,'000.00','-1234.57') then exit;
+  If not Testit(-1,'000.000','-001.000') then exit;
+  If not Testit(-80,'#,##0.00','-80.00') then exit;
+  If not Testit(-140,'#,##0.00','-140.00') then exit;
+  If not Testit(140,'#,##0.00','140.00') then exit;
+  If not Testit(80,'#,##0.00','80.00') then exit;
+  If not Testit(-2.45,'#,##0.00','-2.45') then exit;
+  If not Testit(-1400,'#,##0.00','-1,400.00') then exit;
+  If not Testit(-1400,'##,##0.00','-1,400.00') then exit;
+  // tw13076
+  if not TestIt(-10,'###,###,##0.00','-10.00') then exit;
+end;
+
+begin
+  SysutilsTest('testfloattostr',@TestFloatToStr);
+  SysutilsTest('TestFormatFloat',@TestFormatFloat);
+end.

rtl/test/utformat.pp

@@ -0,0 +1,23 @@
+unit utformat;
+{$mode objfpc}{$h+}
+
+interface
+
+uses sysutils;
+
+implementation
+
+uses punit, utrtl;
+
+function testformat : string;
+
+begin
+  Result:='';
+  if not AssertEquals('Test 1','>         def<', format('>%1:*s<',[0, 12,'def',-15])) then exit;
+  if not AssertEquals('Test 2','>         abc< >       def<',format('>%1:*s< >%*s<', [0, 12, 'abc', 10, 'def'])) then exit;
+  if not AssertEquals('Test 3','>       abc< >   def<',format('>%1:*.*s< >%*.*s<', [0, 10,10,'abc', 6,6,'def'])) then exit;
+end;
+    
+begin
+  SysutilsTest('format',@testformat);
+end.

rtl/test/utfsearch.pp

@@ -0,0 +1,75 @@
+{
+    This file is part of the Free Pascal test suite.
+    Copyright (c) 1999-2003 by the Free Pascal development team.
+
+    Test for possible bugs in Dos.FSearch
+
+    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}
+
+unit utfsearch;
+
+interface
+
+uses punit, utrtl;
+
+implementation
+
+uses
+ Dos;
+
+const
+  TestDir: string = 'TESTDIR';
+  TestFile: string = 'testfile';
+  {$IFDEF MACOS}
+  RelPathPrefix = ':';
+  {$ELSE}
+  RelPathPrefix = '';
+  {$ENDIF}
+
+Function DoTestFSearch : TTestString;
+
+var
+  R,S: string;
+  F: file;
+
+begin
+  Result:='';
+  S := FSearch (TestDir, '');
+  If not AssertEquals('FSearch should only find files, not directories!!','',S) then exit;
+  // Create test file
+  Assign (F, RelPathPrefix + TestDir + DirectorySeparator + TestFile);
+  Rewrite (F);
+  Close (F);
+  S:=FSearch (TestFile, TestDir);
+  // expected result
+  R:=RelPathPrefix + TestDir + DirectorySeparator + TestFile;
+  If not AssertEquals('FSearch didn''t find the test file!!',R,S) then exit;
+end;
+
+Function TestFSearch : TTestString;
+
+var
+  F: file;
+
+begin
+  MkDir (TestDir);
+  Result:=DoTestFSearch;
+  // Clean up
+{$i-}
+  Assign (F, RelPathPrefix + TestDir + DirectorySeparator + TestFile);
+  Erase (F);
+  RmDir (TestDir);
+{$i+}
+end;
+
+begin
+  AddTest('TestFSearch',@TestFsearch,EnsureSuite('Dos'));
+end.

rtl/test/utmath.pp

@@ -0,0 +1,19 @@
+unit utmath;
+
+interface
+
+uses punit, utrtl;
+
+implementation
+
+uses math;
+
+Function TestFMod : TTestString;
+
+Begin
+  Result:='';
+end;
+
+Begin
+  AddTest('TestFMod',@TestFMod,EnsureSuite('Math'));
+end.

rtl/test/utrtl.pp

@@ -0,0 +1,51 @@
+unit utrtl;
+
+{$mode objfpc}
+
+interface
+
+uses punit;
+
+
+Function SysUtilsTest(Const ATestName : ShortString; ARun : TTestRun) : PTest;
+Function DosTest(Const ATestName : ShortString; ARun : TTestRun) : PTest;
+Function EnsureSuite(Const AName : ShortString) : PSuite;
+Function ShowDebugOutput : Boolean;
+
+implementation
+
+function DosTest(const ATestName: ShortString; ARun: TTestRun): PTest;
+begin
+  Result:=AddTest(ATestName,ARun,EnsureSuite('Dos'));
+end;
+
+Function EnsureSuite(Const AName : ShortString) : PSuite;
+
+begin
+  Result:=GetSuite(AName);
+  if Result=Nil then
+    Result:=AddSuite(AName);
+end;
+
+Function SysUtilsTest(Const ATestName : ShortString; ARun : TTestRun) : PTest;
+
+begin
+  Result:=AddTest(ATestName,ARun,EnsureSuite('SysUtils'));
+end;
+
+Var
+  ReadDebug : Boolean;
+  ShowDebug : Boolean;
+
+function ShowDebugOutput: Boolean;
+begin
+  if Not ReadDebug then
+    begin
+    ReadDebug:=True;
+    ShowDebug:=SysGetSetting('debug')='true';
+    end;
+  Result:=ShowDebug;
+end;
+
+end.
+

rtl/test/utrwsync.pp

@@ -0,0 +1,222 @@
+unit utrwsync;
+
+{$ifdef fpc}
+{$mode objfpc}
+{$h+}
+{$endif}
+
+interface
+
+uses
+{$ifdef unix}
+  cthreads,
+{$endif}
+  SysUtils, Classes;
+
+implementation
+
+uses punit, utrtl;
+
+var
+  lock: TMultiReadExclusiveWriteSynchronizer;
+  gcount: longint;
+  waiting: boolean;
+  errorstring : string;
+
+type
+  terrorcheck = class(tthread)
+    procedure execute; override;
+  end;
+
+  tcounter = class(tthread)
+   private
+    flock: TMultiReadExclusiveWriteSynchronizer;
+    flocalcount: longint;
+   public
+    constructor create;
+    property localcount: longint read flocalcount;
+  end;
+
+  treadcounter = class(tcounter)
+    procedure execute; override;
+  end;
+  
+  twritecounter = class(tcounter)
+    procedure execute; override;
+  end;
+  
+constructor tcounter.create;
+  begin
+    { create suspended }
+    inherited create(true);
+    freeonterminate:=false;
+    flock:=lock;
+    flocalcount:=0;
+  end;
+  
+procedure treadcounter.execute;
+  var
+    i: longint;
+    l: longint;
+    r: longint;
+  begin
+    for i:=1 to 100000 do
+      begin
+        lock.beginread;
+        inc(flocalcount);
+        l:=gcount;
+        { guarantee at least one sleep }
+        if i=50000 then
+          sleep(20+random(30))
+        else if (random(10000)=0) then
+          sleep(20);
+        { this must cause data races/loss at some point }
+        gcount:=l+1;
+        lock.endread;
+        r:=random(30000);
+        if (r=0) then
+          sleep(30);
+      end;
+  end;
+
+
+procedure twritecounter.execute;
+  var
+    i: longint;
+    l: longint;
+    r: longint;
+  begin
+    for i:=1 to 500 do
+      begin
+        lock.beginwrite;
+        inc(flocalcount);
+        l:=gcount;
+        { guarantee at least one sleep }
+        if i=250 then
+          sleep(20+random(30))
+        else if (random(100)=0) then
+          sleep(20);
+        { we must be exclusive }
+        if gcount<>l then
+          begin
+            writeln('error 1');
+            halt(1);
+          end;
+        gcount:=l+1;
+        lock.endwrite;
+        r:=random(30);
+        if (r>28) then
+          sleep(r);
+      end;
+  end;
+  
+procedure terrorcheck.execute;
+begin
+  { make sure we don't exit before this thread has initialised, since    }
+  { it can allocate memory in its initialisation, which would cause      }
+  { problems for heaptrc as it goes over the memory map in its exit code }
+  waiting:=true;
+  { avoid deadlocks/bugs from causing this test to never quit }
+  sleep(1000*15);
+  errorstring:='error 4';
+end;
+
+Function trwsync : string;
+
+var
+  r1,r2,r3,r4,r5,r6: treadcounter;
+  w1,w2,w3,w4: twritecounter;
+  
+begin
+  if SysGetSetting('nosync')='true' then
+    begin
+    Ignore('Excluded by config');
+    exit;
+    end;
+  waiting:=false;
+  terrorcheck.create(false);
+  randomize;
+  lock:=TMultiReadExclusiveWriteSynchronizer.create;
+  { verify that the lock is recursive }
+  lock.beginwrite;
+  lock.beginwrite;
+  lock.endwrite;
+  lock.endwrite;
+
+  { first try some writers }
+  w1:=twritecounter.create;
+  w2:=twritecounter.create;
+  w3:=twritecounter.create;
+  w4:=twritecounter.create;
+  w1.start;
+  w2.start;
+  w3.start;
+  w4.start;
+  w1.waitfor;
+  w2.waitfor;
+  w3.waitfor;
+  w4.waitfor;
+  
+  { must not have caused any data races }
+  if (gcount<>w1.localcount+w2.localcount+w3.localcount+w4.localcount) then
+    Result:='error 2';
+
+  w1.free;
+  w2.free;
+  w3.free;
+  w4.free;
+
+  if Result='' then
+    begin
+    { now try some mixed readers/writers }
+    gcount:=0;
+    r1:=treadcounter.create;
+    r2:=treadcounter.create;
+    r3:=treadcounter.create;
+    r4:=treadcounter.create;
+    r5:=treadcounter.create;
+    r6:=treadcounter.create;
+    w1:=twritecounter.create;
+    w2:=twritecounter.create;
+    
+    r1.start;
+    r2.start;
+    r3.start;
+    r4.start;
+    r5.start;
+    r6.start;
+    w1.start;
+    w2.start;
+    
+    r1.waitfor;
+    r2.waitfor;
+    r3.waitfor;
+    r4.waitfor;
+    r5.waitfor;
+    r6.waitfor;
+    w1.waitfor;
+    w2.waitfor;
+    
+    { updating via the readcount must have caused data races }
+    if (gcount>=r1.localcount+r2.localcount+r3.localcount+r4.localcount+r5.localcount+r6.localcount+w1.localcount+w2.localcount) then
+      Result:='Error 3';
+    r1.free;
+    r2.free;
+    r3.free;
+    r4.free;
+    r5.free;
+    r6.free;
+    w1.free;
+    w2.free;
+     end;
+  lock.free;
+
+  while not waiting do
+    sleep(20);
+  if Result='' then
+    Result:=errorstring;
+end;
+
+begin
+    SysutilsTest('trwsync',@trwsync);
+end.

rtl/test/utscanf.pp

@@ -0,0 +1,31 @@
+unit utscanf;
+
+{$mode objfpc}
+{$h+}
+interface
+
+uses
+  sysutils;
+  
+implementation
+
+uses utrtl, punit;
+
+Function utsscanf : string;
+
+var
+  e : extended;
+  s : string;
+  l : longint;
+begin
+  Result:='';
+  sscanf('asdf 1'+DecimalSeparator+'2345 1234','%s %f %d',[@s,@e,@l]);
+  if AssertEquals('Detected float',1.2345,e) then
+    If AssertEquals('Detected integer',1234,l) then
+      AssertEquals('Detected string','asdf',s) 
+end;
+
+begin
+  SysutilsTest('utsscanf',@utsscanf);
+end.
+

rtl/test/utstrcmp.pp

@@ -0,0 +1,142 @@
+unit utstrcmp;
+{ based on string/tester.c of glibc 2.3.6
+
+* Tester for string functions.
+   Copyright (C) 1995-2000, 2001, 2003 Free Software Foundation, Inc.
+   This file is part of the GNU C Library.
+
+   The GNU C Library is free software; you can redistribute it and/or
+   modify it under the terms of the GNU Lesser General Public
+   License as published by the Free Software Foundation; either
+   version 2.1 of the License, or (at your option) any later version.
+
+   The GNU C Library 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.  See the GNU
+   Lesser General Public License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with the GNU C Library; if not, write to the Free
+   Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
+   02111-1307 USA.  */
+}
+
+{$ifdef fpc}
+{$mode delphi}
+{$endif fpc}
+
+interface
+
+uses
+{$ifdef unix}
+  {$ifdef darwin}iosxwstr{$else}cwstring{$endif},
+{$endif unix}
+  SysUtils;
+
+implementation
+
+uses punit, utrtl;
+
+Var
+  GotError : Boolean;
+
+procedure check(b: boolean; testnr: longint);
+
+begin
+  if Not GotError then
+    begin
+    GotError:=B;
+    AssertTrue('Error nr '+IntToStr(testNr),B);
+    end;
+end;
+
+Function teststricomp : String;
+begin
+  GotError:=False;
+  Result:='';
+  check(stricomp('a', 'a') = 0, 1);
+  check(stricomp('a', 'A') = 0, 2);
+  check(stricomp('A', 'a') = 0, 3);
+  check(stricomp('a', 'b') < 0, 4);
+  check(stricomp('c', 'b') > 0, 5);
+  check(stricomp('abc', 'AbC') = 0, 6);
+  check(stricomp('0123456789', '0123456789') = 0, 7);
+  check(stricomp('', '0123456789') < 0, 8);
+  check(stricomp('AbC', '') > 0, 9);
+  check(stricomp('AbC', 'A') > 0, 10);
+  check(stricomp('AbC', 'Ab') > 0, 11);
+  check(stricomp('AbC', 'ab') > 0, 12);
+  check(stricomp('Ab'#0'C', 'ab'#0) = 0, 13);
+end;
+
+
+Function teststrlcomp : string;
+
+begin
+  GotError:=False;
+  Result:='';
+  check (strlcomp ('', '', 0) = 0, 1); { Trivial case. }
+  check (strlcomp ('a', 'a', 1) = 0, 2);       { Identity. }
+  check (strlcomp ('abc', 'abc', 3) = 0, 3);   { Multicharacter. }
+  check (strlcomp ('abc'#0, 'abcd', 4) < 0, 4);   { Length unequal. }
+  check (strlcomp ('abcd', 'abc'#0, 4) > 0, 5);
+  check (strlcomp ('abcd', 'abce', 4) < 0, 6);  { Honestly unequal. }
+  check (strlcomp ('abce', 'abcd', 4) > 0, 7);
+  check (strlcomp ('abce', 'abcd', 3) = 0, 10); { Count limited. }
+  check (strlcomp ('abce', 'abc', 3) = 0, 11);  { Count = length. }
+  check (strlcomp ('abcd', 'abce', 4) < 0, 12);  { Nudging limit. }
+  check (strlcomp ('abc', 'def', 0) = 0, 13);   { Zero count. }
+  check (strlcomp ('abc'#0'e', 'abc'#0'd', 5) = 0, 14);
+end;
+
+
+Function teststrcomp : String;
+begin
+  GotError:=False;
+  Result:='';
+  check (strcomp ('', '') = 0, 1);              { Trivial case. }
+  check (strcomp ('a', 'a') = 0, 2);            { Identity. }
+  check (strcomp ('abc', 'abc') = 0, 3);        { Multicharacter. }
+  check (strcomp ('abc', 'abcd') < 0, 4);        { Length mismatches. }
+  check (strcomp ('abcd', 'abc') > 0, 5);
+  check (strcomp ('abcd', 'abce') < 0, 6);       { Honest miscompares. }
+  check (strcomp ('abce', 'abcd') > 0, 7);
+  check (strcomp ('abc'#0'e', 'abc'#0'd') = 0, 8);
+end;
+
+
+function teststrlicomp : string;
+
+begin
+  GotError:=False;
+  Result:='';
+  check(strlicomp('a', 'a', 1) = 0, 1);
+  check(strlicomp('a', 'A', 1) = 0, 2);
+  check(strlicomp('A', 'a', 1) = 0, 3);
+  check(strlicomp('a', 'b', 1) < 0, 4);
+  check(strlicomp('c', 'b', 1) > 0, 5);
+  check(strlicomp('abc', 'AbC', 3) = 0, 6);
+  check(strlicomp('0123456789', '0123456789', 10) = 0, 7);
+  check(strlicomp(#0'123456789', #0'123456799', 10) = 0, 8);
+  check(strlicomp(#0'bD', #0'bC', 3) = 0, 9);
+  check(strlicomp('AbC', 'A'#0#0,3) > 0, 10);
+  check(strlicomp('AbC', 'Ab'#0, 3) > 0, 11);
+  check(strlicomp('AbC', 'ab'#0, 3) > 0, 12);
+  check(strlicomp('0123456789', 'AbC', 0) = 0, 13);
+  check(strlicomp('AbC', 'abc', 1) = 0, 14);
+  check(strlicomp('AbC', 'abc', 2) = 0, 15);
+  check(strlicomp('AbC', 'abc', 3) = 0, 16);
+  check(strlicomp('AbC', 'abcd', 3) = 0, 17);
+  check(strlicomp('AbCc', 'abcd', 4) < 0, 18);
+  check(strlicomp('ADC', 'abcd', 1) = 0, 19);
+  check(strlicomp('ADC', 'abcd', 2) > 0, 20);
+  check(strlicomp('abc'#0'e', 'abc'#0'd', 5) = 0, 21);
+end;
+
+
+begin
+  SysutilsTest('TestStrIComp',@teststricomp);
+  SysutilsTest('TestStrLComp',@teststrlcomp);
+  SysutilsTest('TestStrComp',@teststrcomp);
+  SysutilsTest('TestStrLIComp',@teststrlicomp);
+end.

rtl/test/utstrcopy.pp

@@ -0,0 +1,51 @@
+unit utstrcopy;
+
+interface
+
+uses punit,utrtl;
+
+implementation
+
+uses strings;
+
+function test_strcopy : TTeststring;
+
+Type
+  TCharArray = array[0..256] of char;
+  TLongCharArray = array[0..512] of char;
+
+var
+  p: pchar;
+  s: TCharArray;
+  buf: TLongCharArray;
+  i, j, l: longint;
+  id : string;
+  
+begin
+  Result:='';
+  s:=Default(TCharArray);
+  buf:=Default(TLongCharArray);
+  for i := 0 to 256 do
+    begin
+      Str(i,ID);
+      fillchar(s,sizeof(s),'b');
+      s[i] := #0;
+      for j := 0 to 3 do
+        begin
+          fillchar(buf,sizeof(buf),'a');
+          p := strcopy(@buf[j+32],@s[0]);
+          if not AssertEquals('Error 0',@buf[j+32],P) then exit;
+          for l := 0 to j+31 do
+            If not assertEquals('Error 1 (i='+id+')','a',buf[l]) then exit;
+          for l := j+32 to j+32+i-1 do
+            If not assertEquals('Error 2 (i='+id+')','b',buf[l]) then exit;
+          if not AssertEquals('Error 3 (i='+id+')',#0,buf[j+i+32]) then exit;
+          for l := j+i+32+1 to 512 do
+            If not assertEquals('Error 4 (i='+id+')','a',buf[l]) then exit;
+        end;
+    end;
+end;
+
+begin
+  AddTest('test_strcopy',@test_strcopy,EnsureSuite('Strings'));
+end.

rtl/test/utstringbuild.pp

@@ -0,0 +1,1034 @@
+{$IFNDEF SBUNICODE}
+unit utstringbuild;
+{$ENDIF}
+
+{$mode objfpc}
+{$h+}
+{$IFDEF SBUNICODE}
+{$modeswitch unicodestrings}
+{$ENDIF}
+
+interface
+
+uses
+  SysUtils;
+
+implementation
+
+uses punit, utrtl;
+
+Type
+{$IFDEF SBUNICODE}
+  TCharArray = Array of WideChar;
+  TStringBuilder = TUnicodeStringBuilder;
+{$ENDIF}
+
+  { TTestObject }
+
+  TTestObject = Class(TObject)
+  Public
+    Function ToString: ansistring; override;
+  end;
+
+Var
+  SB : TStringBuilder;
+
+Procedure InitSB(ASB : TStringBuilder);
+
+begin
+  SB:=ASB;
+  If (SB=Nil) then
+    SB:=TStringBuilder.Create('');
+end;
+
+Procedure DoneSB;
+
+begin
+  FreeAndNil(SB);
+end;
+
+function TearDownSB: TTestString;
+begin
+  FreeAndNil(SB);
+  Result:='';
+end;
+
+function SetupSB: TTestString;
+begin
+  Result:='';
+  InitSB(Nil);
+end;
+
+
+Function TestCreateCapacity : TTestString;
+
+begin
+  Result:='';
+  DoneSB;
+  InitSB(TStringBuilder.Create(12));
+  If not AssertEquals('Correct capacity',12,SB.Capacity) then exit;
+  If not AssertEquals('Correct length',0,SB.Length) then exit;
+  If not AssertEquals('Maxcapacity',MaxInt,SB.MaxCapacity) then exit;
+end;
+
+Function TestCreateCapacityMaxCapacity : TTestString;
+
+begin
+  Result:='';
+  DoneSB;
+  InitSB(TStringBuilder.Create(12,23));
+  If not AssertEquals('Correct capacity',12,SB.Capacity) then exit;
+  If not AssertEquals('Correct length',0,SB.Length) then exit;
+  If not AssertEquals('Maxcapacity',23,SB.MaxCapacity) then exit;
+end;
+
+Function TestCreateCapacityMaxCapacityExceeded : TTestString;
+
+begin
+  Result:='';
+  DoneSB;
+  ExpectException('Capacity exceeds max capacity',ERangeError);
+  InitSB(TStringBuilder.Create(23,12));
+end;
+
+Function TestCreateCapacityString : TTestString;
+
+begin
+  Result:='';
+  DoneSB;
+  InitSB(TStringBuilder.Create('123',23));
+  If not AssertEquals('Correct capacity',23,SB.Capacity) then exit;
+  If not AssertEquals('Correct length',3,SB.Length) then exit;
+  If not AssertEquals('Char 0','1',SB.Chars[0]) then exit;
+  If not AssertEquals('Char 1','2',SB.Chars[1]) then exit;
+  If not AssertEquals('Char 2','3',SB.Chars[2]) then exit;
+end;
+
+Function TestCreateString : TTestString;
+
+begin
+  Result:='';
+  DoneSB;
+  InitSB(TStringBuilder.Create('123'));
+  If not AssertEquals('Correct capacity',64,SB.Capacity) then exit;
+  If not AssertEquals('Correct length',3,SB.Length) then exit;
+  If not AssertEquals('Char 0','1',SB.Chars[0]) then exit;
+  If not AssertEquals('Char 1','2',SB.Chars[1]) then exit;
+  If not AssertEquals('Char 2','3',SB.Chars[2]) then exit;
+end;
+
+Function TestToString : TTestString;
+
+begin
+  Result:='';
+  DoneSB;
+  InitSB(TStringBuilder.Create('12345'));
+  If not AssertEquals('Correct asstring','12345',SB.ToString) then exit;
+  If not AssertEquals('Correct asstring','234',SB.ToString(1,3)) then exit;
+end;
+
+Function TestCreateStringIndexCount : TTestString;
+
+begin
+  Result:='';
+  DoneSB;
+  InitSB(TStringBuilder.Create('aaa1234bbb',3,4,33));
+  If not AssertEquals('Correct capacity',33,SB.Capacity) then exit;
+  If not AssertEquals('Correct length',4,SB.Length) then exit;
+  If not AssertEquals('Char 0','1',SB.Chars[0]) then exit;
+  If not AssertEquals('Char 1','2',SB.Chars[1]) then exit;
+  If not AssertEquals('Char 2','3',SB.Chars[2]) then exit;
+  If not AssertEquals('Char 2','4',SB.Chars[3]) then exit;
+end;
+
+function TestAppendString: TTestString;
+begin
+  Result:='';
+  if Not AssertSame('Return self 1',SB,SB.Append(AnsiString('ABC'))) then exit;
+  If not AssertEquals('Empty','ABC',SB.ToString) then exit;
+  if Not AssertSame('Return self 2',SB,SB.Append(AnsiString('DEF'))) then exit;
+  If not AssertEquals('After append','ABCDEF',SB.ToString) then exit;
+  if Not AssertSame('Return self 3',SB,SB.Append(AnsiString('ZGHIJKLM'),1,3)) then exit;
+  If not AssertEquals('After append','ABCDEFGHI',SB.ToString) then exit;
+end;
+
+function TestAppendArrayOfChar: TTestString;
+
+Var
+  A1,A2,A3 : TCharArray;
+
+begin
+  Result:='';
+  A1:=TCharArray.Create('A','B','C');
+  A2:=TCharArray.Create('D','E','F');
+  A3:=TCharArray.Create('Z','G','H','I','J','K','L','M');
+  if Not AssertSame('Return self 1',SB,SB.Append(A1)) then exit;
+  If not AssertEquals('Empty','ABC',SB.ToString) then exit;
+  if Not AssertSame('Return self 2',SB,SB.Append(A2)) then exit;
+  If not AssertEquals('After append','ABCDEF',SB.ToString) then exit;
+  if Not AssertSame('Return self 3',SB,SB.Append(A3,1,3)) then exit;
+  If not AssertEquals('After append 2','ABCDEFGHI',SB.ToString) then exit;
+  A3[1]:=#0;
+  if Not AssertSame('Return self 4',SB,SB.Append(A3)) then exit;
+  If not AssertEquals('After append 3, null char terminates','ABCDEFGHIZ',SB.ToString) then exit;
+end;
+
+function TestClear : TTestString;
+
+begin
+  Result:='';
+  SB.Append('abc');
+  If not AssertEquals('Not empty',3,SB.Length) then exit;
+  SB.Clear;
+  If not AssertEquals('Empty',0,SB.Length) then exit;
+end;
+
+function TestAppendFormat : TTestString;
+
+begin
+  Result:='';
+  if Not AssertSame('Return self 1',SB,SB.Append('%d',[1])) then exit;
+  If not AssertEquals('Correctly formatted','1',SB.ToString) then exit;
+  if Not AssertSame('Return self 2',SB,SB.AppendFormat('%d',[2])) then exit;
+  If not AssertEquals('Correctly formatted','12',SB.ToString) then exit;
+end;
+
+function TestAppendByte : TTestString;
+
+Var
+  B : Byte = 123;
+
+begin
+  Result:='';
+  if Not AssertSame('Return self',SB,SB.Append(b)) then exit;
+  If Not AssertEquals('Correctly transformed to string','123',SB.ToString) then exit;
+end;
+
+function TestAppendBoolean : TTestString;
+
+
+begin
+  Result:='';
+  if Not AssertSame('Return self',SB,SB.Append(True)) then exit;
+  If Not AssertEquals('Correctly transformed to string','True',SB.ToString) then exit;
+end;
+
+function TestAppendChar : TTestString;
+
+Var
+  C : Char = 'd';
+
+begin
+  Result:='';
+  if Not AssertSame('Return self',SB,SB.Append(c)) then exit;
+  If Not AssertEquals('Correctly transformed to string','d',SB.ToString) then exit;
+end;
+
+function TestAppendCurrency : TTestString;
+
+Var
+  C : Currency = 1.25;
+
+begin
+  Result:='';
+  if Not AssertSame('Return self',SB,SB.Append(c)) then exit;
+  If Not AssertEquals('Correctly transformed to string',CurrToStr(C),SB.ToString) then exit;
+end;
+
+function TestAppendDouble : TTestString;
+
+Var
+  C : Double = 1.25;
+
+begin
+  Result:='';
+  if Not AssertSame('Return self',SB,SB.Append(c)) then exit;
+  If Not AssertEquals('Correctly transformed to string',FloatToStr(C),SB.ToString) then exit;
+end;
+
+function TestAppendSingle : TTestString;
+
+Var
+  C : Single = 1.25;
+
+begin
+  Result:='';
+  if Not AssertSame('Return self',SB,SB.Append(c)) then exit;
+  If Not AssertEquals('Correctly transformed to string',FloatToStr(C),SB.ToString) then exit;
+end;
+
+
+function TestAppendSmallint : TTestString;
+
+Var
+  C : Smallint = 125;
+
+begin
+  Result:='';
+  if Not AssertSame('Return self',SB,SB.Append(c)) then exit;
+  If Not AssertEquals('Correctly transformed to string','125',SB.ToString) then exit;
+end;
+
+function TestAppendInteger : TTestString;
+
+Var
+  C : Integer = $FFFFFF;
+
+begin
+  Result:='';
+  if Not AssertSame('Return self',SB,SB.Append(c)) then exit;
+  If Not AssertEquals('Correctly transformed to string',IntToStr(C),SB.ToString) then exit;
+end;
+
+function TestAppendInt64 : TTestString;
+
+Var
+  C : Int64 = $FFFFFFFFFF;
+
+begin
+  Result:='';
+  if Not AssertSame('Return self',SB,SB.Append(c)) then exit;
+  If Not AssertEquals('Correctly transformed to string',IntToStr(C),SB.ToString) then exit;
+end;
+
+function TestAppendShortInt : TTestString;
+
+Var
+  C : ShortInt = $1F;
+
+begin
+  Result:='';
+  if Not AssertSame('Return self',SB,SB.Append(c)) then exit;
+  If Not AssertEquals('Correctly transformed to string',IntToStr($1F),SB.ToString) then exit;
+end;
+
+function TestAppendQWord : TTestString;
+
+Var
+  C : QWord = $FFFFFFFFFF;
+
+begin
+  Result:='';
+  if Not AssertSame('Return self',SB,SB.Append(c)) then exit;
+  If Not AssertEquals('Correctly transformed to string',IntToStr(C),SB.ToString) then exit;
+end;
+
+function TestAppendWord : TTestString;
+
+Var
+  C : Word = $FFFF;
+
+begin
+  Result:='';
+  if Not AssertSame('Return self',SB,SB.Append(c)) then exit;
+  If Not AssertEquals('Correctly transformed to string',IntToStr(C),SB.ToString) then exit;
+end;
+
+function TestAppendCardinal : TTestString;
+
+Var
+  C : Cardinal = $FFFFFF;
+
+begin
+  Result:='';
+  if Not AssertSame('Return self',SB,SB.Append(c)) then exit;
+  If Not AssertEquals('Correctly transformed to string',IntToStr(C),SB.ToString) then exit;
+end;
+
+function TestAppendCharRepeat : TTestString;
+
+Var
+  C : Char;
+
+begin
+  Result:='';
+  C:='*';
+  if Not AssertSame('Return self',SB,SB.Append(c,5)) then exit;
+  If Not AssertEquals('Correctly transformed to string','*****',SB.ToString) then exit;
+end;
+
+function TestAppendPAnsiChar : TTestString;
+
+Var
+  C : Array[0..5] of AnsiChar;
+  P : PAnsiChar;
+
+begin
+  Result:='';
+  C[0]:='1';
+  C[1]:='2';
+  C[2]:='3';
+  C[3]:='4';
+  C[4]:='5';
+  C[5]:=#0;
+  P:=@C[0];
+  if Not AssertSame('Return self',SB,SB.Append(P)) then exit;
+  If Not AssertEquals('Correctly transformed to string','12345',SB.ToString) then exit;
+end;
+
+function TestAppendObject : TTestString;
+
+Var
+  C : TTestObject;
+
+begin
+  Result:='';
+  C:=TTestObject.Create;
+  try
+    if Not AssertSame('Return self',SB,SB.Append(C)) then exit;
+    If Not AssertEquals('Correctly transformed to string','some string',SB.ToString) then exit;
+  finally
+    C.free;
+  end;
+end;
+
+function TestInsertByte : TTestString;
+
+Var
+  B : Byte = 123;
+
+begin
+  Result:='';
+  SB.Append('abcdef');
+  if Not AssertSame('Return self',SB,SB.Insert(3,b)) then exit;
+  If Not AssertEquals('Correctly transformed to string','abc123def',SB.ToString) then exit;
+end;
+
+function TestInsertBoolean : TTestString;
+
+
+begin
+  Result:='';
+  SB.Append('abcdef');
+  if Not AssertSame('Return self',SB,SB.Insert(3,True)) then exit;
+  If Not AssertEquals('Correctly transformed to string','abcTruedef',SB.ToString) then exit;
+end;
+
+function TestInsertChar : TTestString;
+
+Var
+  C : Char = 'q';
+
+begin
+  Result:='';
+  SB.Append('abcdef');
+  if Not AssertSame('Return self',SB,SB.Insert(3,c)) then exit;
+  If Not AssertEquals('Correctly transformed to string','abcqdef',SB.ToString) then exit;
+end;
+
+function TestInsertCurrency : TTestString;
+
+Var
+  C : Currency = 1.25;
+
+begin
+  Result:='';
+  SB.Append('abcdef');
+  if Not AssertSame('Return self',SB,SB.Insert(3,c)) then exit;
+  If Not AssertEquals('Correctly transformed to string','abc'+CurrToStr(C)+'def',SB.ToString) then exit;
+end;
+
+function TestInsertDouble : TTestString;
+
+Var
+  C : Double = 1.25;
+
+begin
+  Result:='';
+  SB.Append('abcdef');
+  if Not AssertSame('Return self',SB,SB.Insert(3,c)) then exit;
+  If Not AssertEquals('Correctly transformed to string','abc'+FloatToStr(C)+'def',SB.ToString) then exit;
+end;
+
+function TestInsertSingle : TTestString;
+
+Var
+  C : Single = 1.25;
+
+begin
+  Result:='';
+  SB.Append('abcdef');
+  if Not AssertSame('Return self',SB,SB.Insert(3,c)) then exit;
+  If Not AssertEquals('Correctly transformed to string','abc'+FloatToStr(C)+'def',SB.ToString) then exit;
+end;
+
+
+function TestInsertSmallint : TTestString;
+
+Var
+  C : Smallint = 125;
+
+begin
+  Result:='';
+  SB.Append('abcdef');
+  if Not AssertSame('Return self',SB,SB.Insert(3,c)) then exit;
+  If Not AssertEquals('Correctly transformed to string','abc125def',SB.ToString) then exit;
+end;
+
+function TestInsertInteger : TTestString;
+
+Var
+  C : Integer = $FFFFFF;
+
+begin
+  Result:='';
+  SB.Append('abcdef');
+  if Not AssertSame('Return self',SB,SB.Insert(3,c)) then exit;
+  If Not AssertEquals('Correctly transformed to string','abc'+IntToStr(C)+'def',SB.ToString) then exit;
+end;
+
+function TestInsertInt64 : TTestString;
+
+Var
+  C : Int64 = $FFFFFFFFFF;
+
+begin
+  Result:='';
+  SB.Append('abcdef');
+  if Not AssertSame('Return self',SB,SB.Insert(3,c)) then exit;
+  If Not AssertEquals('Correctly transformed to string','abc'+IntToStr(C)+'def',SB.ToString) then exit;
+end;
+
+function TestInsertShortInt : TTestString;
+
+Var
+  C : ShortInt = $1F;
+
+begin
+  Result:='';
+  SB.Append('abcdef');
+  if Not AssertSame('Return self',SB,SB.Insert(3,c)) then exit;
+  If Not AssertEquals('Correctly transformed to string','abc'+IntToStr($1F)+'def',SB.ToString) then exit;
+end;
+
+function TestInsertQWord : TTestString;
+
+Var
+  C : QWord = $FFFFFFFFFF;
+
+begin
+  Result:='';
+  SB.Append('abcdef');
+  if Not AssertSame('Return self',SB,SB.Insert(3,c)) then exit;
+  If Not AssertEquals('Correctly transformed to string','abc'+IntToStr(C)+'def',SB.ToString) then exit;
+end;
+
+function TestInsertWord : TTestString;
+
+Var
+  C : Word = $FFFF;
+
+begin
+  Result:='';
+  SB.Append('abcdef');
+  if Not AssertSame('Return self',SB,SB.Insert(3,c)) then exit;
+  If Not AssertEquals('Correctly transformed to string','abc'+IntToStr(C)+'def',SB.ToString) then exit;
+end;
+
+function TestInsertCardinal : TTestString;
+
+Var
+  C : Cardinal = $FFFFFF;
+
+begin
+  Result:='';
+  SB.Append('abcdef');
+  if Not AssertSame('Return self',SB,SB.Insert(3,c)) then exit;
+  If Not AssertEquals('Correctly transformed to string','abc'+IntToStr(C)+'def',SB.ToString) then exit;
+end;
+
+function TestInsertCharRepeat : TTestString;
+
+Var
+  C : Char;
+
+begin
+  Result:='';
+  C:='*';
+  SB.Append('abcdef');
+  if Not AssertSame('Return self',SB,SB.Insert(3,c,5)) then exit;
+  If Not AssertEquals('Correctly transformed to string','abc*****def',SB.ToString) then exit;
+end;
+
+function TestInsertPAnsiChar : TTestString;
+
+Var
+  C : Array[0..5] of AnsiChar;
+  P : PAnsiChar;
+
+begin
+  Result:='';
+  C[0]:='1';
+  C[1]:='2';
+  C[2]:='3';
+  C[3]:='4';
+  C[4]:='5';
+  C[5]:=#0;
+  P:=@C[0];
+  SB.Append('abcdef');
+  if Not AssertSame('Return self',SB,SB.Insert(3,P)) then exit;
+  If Not AssertEquals('Correctly transformed to string','abc12345def',SB.ToString) then exit;
+end;
+
+function TestInsertObject : TTestString;
+
+Var
+  C : TTestObject;
+
+begin
+  Result:='';
+  SB.Append('abcdef');
+  C:=TTestObject.Create;
+  try
+    if Not AssertSame('Return self',SB,SB.Insert(3,C)) then exit;
+    If Not AssertEquals('Correctly transformed to string','abcsome stringdef',SB.ToString) then exit;
+  finally
+    C.free;
+  end;
+end;
+
+function TestInsertIndexNegative: TTestString;
+begin
+  Result:='';
+  SB.Append('abcdef');
+  ExpectException('No negatice index allowed',ERangeError);
+  SB.Insert(-3,'abc')
+end;
+
+function TestInsertIndexTooBig: TTestString;
+begin
+  Result:='';
+  SB.Append('abcdef');
+  ExpectException('Maximum index exceeded',ERangeError);
+  SB.Insert(6,'abc');
+end;
+
+function TestInsertString: TTestString;
+begin
+  Result:='';
+  SB.Append('abcdef');
+  if Not AssertSame('Return self',SB,SB.Insert(3,'123')) then exit;
+  If Not AssertEquals('Correctly transformed to string','abc123def',SB.ToString) then exit;
+end;
+
+function TestInsertArrayOfChar: TTestString;
+
+Var
+  A : TCharArray;
+
+begin
+  Result:='';
+  A:=TCharArray.Create('1','2','3');
+  SB.Append('abcdef');
+  if Not AssertSame('Return self',SB,SB.Insert(3,A)) then exit;
+  If Not AssertEquals('Correctly transformed to string','abc123def',SB.ToString) then exit;
+end;
+
+function TestInsertArrayOfCharIndexNegative: TTestString;
+Var
+  A : TCharArray;
+
+begin
+  Result:='';
+  A:=TCharArray.Create('1','2','3');
+  Result:='';
+  SB.Append('abcdef');
+  ExpectException('No negatice index allowed',ERangeError);
+  SB.Insert(-3,A)
+end;
+
+function TestInsertArrayOfCharIndexTooBig: TTestString;
+
+Var
+  A : TCharArray;
+
+begin
+  Result:='';
+  A:=TCharArray.Create('1','2','3');
+  SB.Append('abcdef');
+  ExpectException('Maximum index exceeded',ERangeError);
+  SB.Insert(6,A);
+end;
+
+function TestAppendLineString: TTestString;
+
+begin
+  Result:='';
+  SB.Append('abc');
+  if Not AssertSame('Return self',SB,SB.AppendLine('def')) then exit;
+  If Not AssertEquals('Correctly transformed to string','abcdef'+sLineBreak,SB.ToString) then exit;
+end;
+
+function TestAppendLine: TTestString;
+begin
+  Result:='';
+  SB.Append('abc');
+  if Not AssertSame('Return self',SB,SB.AppendLine()) then exit;
+  If Not AssertEquals('Correctly transformed to string','abc'+sLineBreak,SB.ToString) then exit;
+end;
+
+function TestCopyTo: TTestString;
+
+Var
+  C : TCharArray;
+  I : Integer;
+
+begin
+  C:=Default(TCharArray);
+  Result:='';
+  SB.Append('abcdef');
+  SetLength(C,12);
+  For I:=0 to 11 do
+    C[I]:='a';
+  SB.CopyTo(1,C,0,3);
+  if not AssertEquals('Correct copy','bcda',C[0]+C[1]+C[2]+c[3]) then exit;
+  SB.CopyTo(4,C,3,2);
+  if not AssertEquals('Correct copy','bcdef',C[0]+C[1]+C[2]+c[3]+c[4]) then exit;
+end;
+
+function TestCopyToNegativeSourceIndex: TTestString;
+
+Var
+  C : TCharArray;
+  I : Integer;
+
+begin
+  C:=Default(TCharArray);
+  Result:='';
+  SB.Append('abcdef');
+  SetLength(C,12);
+  For I:=0 to 11 do
+    C[I]:='a';
+  ExpectException('Cannot pass negative source index',ERangeError);
+  SB.CopyTo(-1,C,0,3);
+end;
+
+function TestCopyToNegativeCount: TTestString;
+
+Var
+  C : TCharArray;
+  I : Integer;
+
+begin
+  C:=Default(TCharArray);
+  Result:='';
+  SB.Append('abcdef');
+  SetLength(C,12);
+  For I:=0 to 11 do
+    C[I]:='a';
+  ExpectException('Cannot pass negative count',ERangeError);
+  SB.CopyTo(0,C,0,-3);
+end;
+
+function TestCopyToWrongRange: TTestString;
+
+Var
+  C : TCharArray;
+  I : Integer;
+
+begin
+  C:=Default(TCharArray);
+  Result:='';
+  SB.Append('abcdef');
+  SetLength(C,12);
+  For I:=0 to 11 do
+    C[I]:='a';
+  ExpectException('Cannot pass negative count',ERangeError);
+  SB.CopyTo(0,C,7,6); // 7+6=13
+end;
+
+function TestCopyToMaxRange: TTestString;
+
+Var
+  C : TCharArray;
+  I : Integer;
+
+begin
+  Result:='';
+  C:=Default(TCharArray);
+  SB.Append('abcdef');
+  SetLength(C,12);
+  For I:=0 to 11 do
+    C[I]:='a';
+  SB.CopyTo(0,C,7,5); // 7+5=12
+  if not AssertEquals('Correct copy','abcde',C[7]+C[8]+C[9]+c[10]+c[11]) then exit;
+end;
+
+function TestEquals: TTestString;
+
+Var
+  B : TStringBuilder;
+
+begin
+  Result:='';
+  SB.Append('abc');
+  AssertFalse('Nil is unequal',SB.Equals(Nil));
+  B:=TStringBuilder.Create('a');
+  try
+    AssertFalse('Unequal length is unequal',SB.Equals(B));
+    FreeAndNil(B);
+    B:=TStringBuilder.Create('ade');
+    AssertFalse('Equal length, unequal chars is unequal',SB.Equals(B));
+    FreeAndNil(B);
+    B:=TStringBuilder.Create('abc');
+    AssertTrue('Equal length, equal chars is equal',SB.Equals(B));
+    B:=TStringBuilder.Create(3,6);
+    B.Append('abc');
+    AssertFalse('Equal length, equal chars, unequal maxcapacity is unequal',SB.Equals(B));
+  finally
+    B.Free;
+  end;
+end;
+
+function TestCapacity: TTestString;
+
+Var
+  C : Integer;
+
+begin
+  Result:='';
+  SB.Append('abc');
+  C:=SB.Capacity+10;
+  If not AssertEquals('Returns new capacity',C,SB.EnsureCapacity(C)) then exit;
+  If not AssertEquals('Returns new capacity, less than returns old',C,SB.EnsureCapacity(C-20)) then exit;
+  ExpectException('No negative capacity',ERangeError);
+  SB.EnsureCapacity(-1);
+end;
+
+function TestCapacityNegative: TTestString;
+
+begin
+  Result:='';
+  FreeAndNil(SB);
+  SB:=TStringBuilder.Create(10,20);
+  ExpectException('Capacity less than maxcapacity',ERangeError);
+  SB.EnsureCapacity(30);
+end;
+
+function TestAppendExceedsMaxCapacity: TTestString;
+begin
+  Result:='';
+  FreeAndNil(SB);
+  SB:=TStringBuilder.Create(10,20);
+  ExpectException('Capacity exceeds maxcapacity on add',ERangeError);
+  SB.Append(StringOfChar('*',30));
+end;
+
+function TestInsertExceedsMaxCapacity: TTestString;
+
+begin
+  Result:='';
+  FreeAndNil(SB);
+  SB:=TStringBuilder.Create(10,20);
+  SB.Append('abcdef');
+  ExpectException('Capacity exceeds maxcapacity on add',ERangeError);
+  SB.Insert(3,StringOfChar('*',30));
+end;
+
+function TestInsertEqualsMaxCapacity: TTestString;
+
+begin
+  Result:='';
+  FreeAndNil(SB);
+  SB:=TStringBuilder.Create(10,20);
+  SB.Append('abcdef');
+  SB.Insert(3,StringOfChar('*',14));
+  If not AssertEquals('Correctly added','abc**************def',SB.ToString) then exit;
+end;
+
+function TestAppendEqualsMaxCapacity: TTestString;
+
+begin
+  Result:='';
+  FreeAndNil(SB);
+  SB:=TStringBuilder.Create(10,20);
+  SB.Append('abcdef');
+  SB.Append(StringOfChar('*',14));
+  If not AssertEquals('Correctly added','abcdef**************',SB.ToString) then exit;
+end;
+
+function TestRemove: TTestString;
+
+begin
+  Result:='';
+  SB.Append('abcdef');
+  if Not AssertSame('Return self 1',SB,SB.Remove(2,2)) then exit;
+  If not AssertEquals('Correctly removed 2,2','abef',SB.ToString) then exit;
+  if Not AssertSame('Return self 2',SB,SB.Remove(0,1)) then exit;
+  If not AssertEquals('Correctly removed 0,1','bef',SB.ToString) then exit;
+  if Not AssertSame('Return self 3',SB,SB.Remove(0,0)) then exit;
+  If not AssertEquals('Correctly removed nothing','bef',SB.ToString) then exit;
+  ExpectException('Negative length',ERangeError);
+  SB.Remove(0,-1);
+end;
+
+function TestRemoveNegativeIndex: TTestString;
+
+begin
+  Result:='';
+  SB.Append('abcdef');
+  ExpectException('Negative startindex',ERangeError);
+  SB.Remove(-1,1);
+end;
+
+function TestRemoveIndexTooBig: TTestString;
+
+begin
+  Result:='';
+  SB.Append('abcdef');
+  ExpectException('Startindex too big',ERangeError);
+  SB.Remove(6,1);
+end;
+
+function TestRemoveIndexPluslengthTooBig: TTestString;
+
+begin
+  Result:='';
+  SB.Append('abcdef');
+  ExpectException('Startindex+Length too big',ERangeError);
+  SB.Remove(4,3);
+end;
+
+function TestReplaceChar : TTestString;
+
+Var
+  Cold,CNew : Char;
+
+begin
+  Result:='';
+  SB.Append('abcaedefa');
+  Cold:='a';
+  CNew:='z';
+  if Not AssertSame('Return self 1',SB,SB.Replace(Cold,CNew)) then exit;
+  If not AssertEquals('Correctly replaced 2 instances','zbczedefz',SB.ToString) then exit;
+  Cold:='e';
+  CNew:='z';
+  if Not AssertSame('Return self 1',SB,SB.Replace(Cold,CNew,4,2)) then exit;
+  If not AssertEquals('Correctly replaced 1 instance, bounded','zbczzdefz',SB.ToString) then exit;
+end;
+
+function TestReplaceString : TTestString;
+
+Var
+  Cold,CNew : String;
+
+begin
+  Result:='';
+  SB.Append('aabcaaedeafaa');
+  Cold:='aa';
+  CNew:='zz';
+  if Not AssertSame('Return self 1',SB,SB.Replace(Cold,CNew)) then exit;
+  If not AssertEquals('Correctly replaced 2 instances','zzbczzedeafzz',SB.ToString) then exit;
+  Cold:='e';
+  CNew:='';
+  if Not AssertSame('Return self 1',SB,SB.Replace(Cold,CNew,6,2)) then exit;
+  If not AssertEquals('Correctly replaced 1 instance, bounded','zzbczzdeafzz',SB.ToString) then exit;
+  SB.Clear;
+  SB.Append('zzbczzedeafzz');
+  Cold:='e';
+  CNew:='qqqq';
+  if Not AssertSame('Return self 1',SB,SB.Replace(Cold,CNew,6,3)) then exit;
+  If not AssertEquals('Correctly replaced 2 instances, bounded','zzbczzqqqqdqqqqafzz',SB.ToString) then exit;
+end;
+
+Procedure RegisterStringBuilderTests;
+
+Var
+  P : PSuite;
+
+begin
+{$IFDEF SBUNICODE}
+  P:=AddSuite('UnicodeStringBuilder',EnsureSuite('SysUtils'));
+{$ELSE}
+  P:=AddSuite('AnsiStringBuilder',EnsureSuite('SysUtils'));
+{$ENDIF}
+  P^.Options:=[soSetupTearDownPerTest];
+  P^.Setup:=@SetupSB;
+  P^.Teardown:=@TearDownSB;
+  AddTest('TestCreateCapacity',@TestCreateCapacity,P);
+  AddTest('TestCreateCapacityMaxCapacity',@TestCreateCapacityMaxCapacity,P);
+  AddTest('TestCreateCapacityMaxCapacityExceeded',@TestCreateCapacityMaxCapacityExceeded,P);
+  AddTest('TestCreateCapacityString',@TestCreateCapacityString,P);
+  AddTest('TestCreateString',@TestCreateString,P);
+  AddTest('TestCreateStringIndexCount',@TestCreateStringIndexCount,P);
+  AddTest('TestToString',@TestToString,P);
+  AddTest('TestClear',@TestClear,P);
+  AddTest('TestAppendString',@TestAppendString,P);
+  AddTest('TestAppendArrayOfChar',@TestAppendArrayOfChar,P);
+  AddTest('TestAppendFormat',@TestAppendFormat,P);
+  AddTest('TestAppendExceedsMaxCapacity',@TestAppendExceedsMaxCapacity,P);
+  AddTest('TestAppendEqualsMaxCapacity',@TestAppendEqualsMaxCapacity,P);
+  AddTest('TestAppendByte',@TestAppendByte,P);
+  AddTest('TestAppendSmallInt',@TestAppendSmallint,P);
+  AddTest('TestAppendWord',@TestAppendWord,P);
+  AddTest('TestAppendInteger',@TestAppendInteger,P);
+  AddTest('TestAppendCardinal',@TestAppendCardinal,P);
+  AddTest('TestAppendInt64',@TestAppendInt64,P);
+  AddTest('TestAppendQWord',@TestAppendQWord,P);
+  AddTest('TestAppendShortInt',@TestAppendShortInt,P);
+  AddTest('TestAppendBoolean',@TestAppendBoolean,P);
+  AddTest('TestAppendChar',@TestAppendChar,P);
+  AddTest('TestAppendCharRepeat',@TestAppendCharRepeat,P);
+  AddTest('TestAppendCurrency',@TestAppendCurrency,P);
+  AddTest('TestAppendDouble',@TestAppendDouble,P);
+  AddTest('TestAppendSingle',@TestAppendSingle,P);
+  AddTest('TestAppendPansiChar',@TestAppendPansiChar,P);
+  AddTest('TestAppendObject',@TestAppendObject,P);
+  AddTest('TestAppendLine',@TestAppendLine,P);
+  AddTest('TestAppendLineString',@TestAppendLineString,P);
+  AddTest('TestInsertString',@TestInsertString,P);
+  AddTest('TestInsertExceedsMaxCapacity',@TestInsertExceedsMaxCapacity,P);
+  AddTest('TestInsertEqualsMaxCapacity',@TestInsertEqualsMaxCapacity,P);
+  AddTest('TestInsertArrayOfChar',@TestInsertArrayOfChar,P);
+  AddTest('TestInsertByte',@TestInsertByte,P);
+  AddTest('TestInsertSmallInt',@TestInsertSmallint,P);
+  AddTest('TestInsertWord',@TestInsertWord,P);
+  AddTest('TestInsertInteger',@TestInsertInteger,P);
+  AddTest('TestInsertCardinal',@TestInsertCardinal,P);
+  AddTest('TestInsertInt64',@TestInsertInt64,P);
+  AddTest('TestInsertQWord',@TestInsertQWord,P);
+  AddTest('TestInsertShortInt',@TestInsertShortInt,P);
+  AddTest('TestInsertBoolean',@TestInsertBoolean,P);
+  AddTest('TestInsertChar',@TestInsertChar,P);
+  AddTest('TestInsertCharRepeat',@TestInsertCharRepeat,P);
+  AddTest('TestInsertCurrency',@TestInsertCurrency,P);
+  AddTest('TestInsertDouble',@TestInsertDouble,P);
+  AddTest('TestInsertSingle',@TestInsertSingle,P);
+  AddTest('TestInsertPansiChar',@TestInsertPansiChar,P);
+  AddTest('TestInsertObject',@TestInsertObject,P);
+  AddTest('TestInsertIndexNegative',@TestInsertIndexNegative,P);
+  AddTest('TestInsertIndexTooBig',@TestInsertIndexTooBig,P);
+  AddTest('TestInsertArrayOfCharIndexNegative',@TestInsertArrayOfCharIndexNegative,P);
+  AddTest('TestInsertArrayOfCharIndexTooBig',@TestInsertArrayOfCharIndexTooBig,P);
+  AddTest('TestCopyTo',@TestCopyTo,P);
+  AddTest('TestCopyToNegativeIndex',@TestCopyToNegativeSourceIndex,P);
+  AddTest('TestCopyToNegativeCount',@TestCopyToNegativeCount,P);
+  AddTest('TestCopyToWrongRange',@TestCopyToWrongRange,P);
+  AddTest('TestCopyToMaxRange',@TestCopyToMaxRange,P);
+  AddTest('TestEquals',@TestEquals,P);
+  AddTest('TestEnsureCapacity',@TestCapacity,P);
+  AddTest('TestEnsureCapacityNegative',@TestCapacityNegative,P);
+  AddTest('TestRemove',@TestRemove,P);
+  AddTest('TestRemoveNegativeIndex',@TestRemoveNegativeIndex,P);
+  AddTest('TestRemoveIndexTooBig',@TestRemoveIndexTooBig,P);
+  AddTest('TestRemoveIndexPlusLengthTooBig',@TestRemoveIndexPlusLengthTooBig,P);
+  AddTest('TestReplaceChar',@TestReplaceChar,P);
+  AddTest('TestReplaceString',@TestReplaceString,P);
+{
+Function Replace(const OldValue: string; const NewValue: string): TStringBuilder;
+Function Replace(const OldValue: string; const NewValue: string; StartIndex: Integer; Count: Integer): TStringBuilder;
+
+}
+end;
+
+{ TTestObject }
+
+function TTestObject.ToString: ansistring;
+begin
+  Result:='some string';
+end;
+
+initialization
+  RegisterStringBuilderTests;
+end.
+

rtl/test/utstringhelp.pp

@@ -0,0 +1,1264 @@
+unit utstringhelp;
+
+{$mode objfpc}{$H+}
+//{$modeswitch advancedrecords}
+//{$modeswitch typehelpers}
+
+interface
+
+uses
+  Classes, SysUtils;
+
+implementation
+
+uses punit, utrtl;
+
+Const
+  TBI = 'To be implemented';
+
+Function TestCompare : String;
+
+Var
+  r : Integer;
+
+begin
+  Result:='';
+  // Simple cases
+  R:=AnsiString.Compare('A','B');
+  if not AssertTrue('1. Simple Compare strings (A,B) :'+IntToStr(R)+'<0',R<0) then exit;
+  R:=AnsiString.Compare('B','A');
+  if not AssertTrue('2. Simple Compare strings (B,A) :'+IntToStr(R)+'>0',R>0) then exit;
+  R:=AnsiString.Compare('A','A');
+  if not AssertTrue('3. Simple Compare strings (A,A) :'+IntToStr(R)+'=0',R=0) then exit;
+  R:=AnsiString.Compare('A','a', true);
+  if not AssertTrue('4. Simple ignore case Compare strings (A,a) : '+IntToStr(R)+'=0',R=0) then exit;
+  R:=AnsiString.Compare('b','a',True);
+  if not AssertTrue('5. Simple ignore case Compare strings (b,a) : '+IntToStr(R)+'>0',R>0) then exit;
+  R:=AnsiString.Compare('A','a',[coIgnoreCase]);
+  if not AssertTrue('6. [coIgnoreCase] Compare strings (A,a) : '+IntToStr(R)+'=0',R=0) then exit;
+  R:=AnsiString.Compare('b','a',[coIgnoreCase]);
+  if not AssertTrue('7. [coIgnoreCase] Compare strings (b,a) : '+IntToStr(R)+'>0',R>0) then exit;
+  // Check whether index is observed.
+  R:=AnsiString.Compare('AA',1,'AB',1,1);
+  if not AssertTrue('8. Compare(''AA'',1,''AB'',1,1) :'+IntToStr(R)+'<0',R<0) then exit;
+  R:=AnsiString.Compare('AB',1,'AA',1,1);
+  if not AssertTrue('9. Compare(''AB'',1,''AA'',1,1) :'+IntToStr(R)+'>0',R>0) then exit;
+  R:=AnsiString.Compare('AA',1,'AA',1,1);
+  if not AssertTrue('10. Compare(''AA'',1,''AA'',1,1) :'+IntToStr(R)+'=0',R=0) then exit;
+  // Make sure only len chars are used.
+  R:=AnsiString.Compare('AAC',1,'ABD',1,1);
+  if not AssertTrue('11. Compare(''AAC'',1,''ABD'',1,1) :'+IntToStr(R)+'<0',R<0) then exit;
+  R:=AnsiString.Compare('ABC',1,'AAD',1,1);
+  if not AssertTrue('12 Compare(''ABC'',1,''AAD'',1,1) :'+IntToStr(R)+'>0',R>0) then exit;
+  R:=AnsiString.Compare('AAC',1,'AAD',1,1);
+  if not AssertTrue('13. Compare(''AAC'',1,''AAD'',1,1) :'+IntToStr(R)+'=0',R=0) then exit;
+  // Index, case insensitive
+  R:=AnsiString.Compare('AA',1,'Aa',1,1,true);
+  if not AssertTrue('14. Compare(''AA'',1,''Aa'',1,1,true) : '+IntToStr(R)+'=0',R=0) then exit;
+  R:=AnsiString.Compare('Ab',1,'Aa',1,1,True);
+  if not AssertTrue('15. Compare(''Ab'',1,''Aa'',1,1,True) : '+IntToStr(R)+'>0',R>0) then exit;
+  R:=AnsiString.Compare('A',1,'a',1,1,[coIgnoreCase]);
+  if not AssertTrue('16. Compare(''A'',1,''a'',1,1,[coIgnoreCase]) : '+IntToStr(R)+'=0',R=0) then exit;
+  // Index, maxlen, case insensitive
+  R:=AnsiString.Compare('AAC',1,'AaD',1,1,true);
+  if not AssertTrue('17. Compare(''AAC'',1,''AaD'',1,1,true) : '+IntToStr(R)+'=0',R=0) then exit;
+  R:=AnsiString.Compare('AbC',1,'AaD',1,1,True);
+  if not AssertTrue('18. Compare(''AbC'',1,''AaD'',1,1,True) : '+IntToStr(R)+'>0',R>0) then exit;
+  R:=AnsiString.Compare('AAC',1,'AaD',1,1,[coIgnoreCase]);
+  if not AssertTrue('19. Compare(''AAC'',1,''AaD'',1,1,[coIgnoreCase]) : '+IntToStr(R)+'=0',R=0) then exit;
+end;
+
+Function TestCompareOrdinal : String;
+
+Var
+  r : Integer;
+
+begin
+  Result:='';
+  // Simple
+  R:=AnsiString.CompareOrdinal('A','B');
+  if not AssertTrue('1. Simple Compare strings (A,B) :'+IntToStr(R)+'<0',R<0) then exit;
+  R:=AnsiString.CompareOrdinal('B','A');
+  if not AssertTrue('2. Simple Compare strings (B,A) :'+IntToStr(R)+'>0',R>0) then exit;
+  R:=AnsiString.CompareOrdinal('A','A');
+  if not AssertTrue('3. Simple Compare strings (A,A) :'+IntToStr(R)+'=0',R=0) then exit;
+  // Index
+  R:=AnsiString.CompareOrdinal('AA',1,'AB',1,1);
+  if not AssertTrue('4. Simple Compare strings (AA,1,AB,1,1) :'+IntToStr(R)+'<0',R<0) then exit;
+  R:=AnsiString.CompareOrdinal('AB',1,'AA',1,1);
+  if not AssertTrue('5. Simple Compare strings (AB,1,AA,1,1) :'+IntToStr(R)+'>0',R>0) then exit;
+  R:=AnsiString.CompareOrdinal('AA',1,'AA',1,1);
+  if not AssertTrue('6. Simple Compare strings (AA,1,AA,1,1) :'+IntToStr(R)+'=0',R=0) then exit;
+  // Index, maxlen
+  R:=AnsiString.CompareOrdinal('AAC',1,'ABD',1,1);
+  if not AssertTrue('7. Simple Compare strings (AAC,1,ABD,1,1) :'+IntToStr(R)+'<0',R<0) then exit;
+  R:=AnsiString.CompareOrdinal('ABC',1,'AAD',1,1);
+  if not AssertTrue('8. Simple Compare strings (ABC,1,AAD,1,1) :'+IntToStr(R)+'>0',R>0) then exit;
+  R:=AnsiString.CompareOrdinal('AAD',1,'AAD',1,1);
+  if not AssertTrue('9. Simple Compare strings (AAC,1,AAD,1,1) :'+IntToStr(R)+'=0',R=0) then exit;
+end;
+
+Function TestCompareText : String;
+
+Var
+  r : Integer;
+
+begin
+  Result:='';
+  R:=AnsiString.CompareText('A','B');
+  if not AssertTrue('1. Simple Compare strings (A,B) :'+IntToStr(R)+'<0',R<0) then exit;
+  R:=AnsiString.CompareText('B','A');
+  if not AssertTrue('Simple Compare strings (B,A) :'+IntToStr(R)+'>0',R>0) then exit;
+  R:=AnsiString.CompareText('A','A');
+  if not AssertTrue('Simple Compare strings (A,A) :'+IntToStr(R)+'=0',R=0) then exit;
+  //
+  R:=AnsiString.CompareText('A','b');
+  if not AssertTrue('Simple Compare strings (A,b) :'+IntToStr(R)+'<0',R<0) then exit;
+  R:=AnsiString.CompareText('B','a');
+  if not AssertTrue('Simple Compare strings (B,a) :'+IntToStr(R)+'>0',R>0) then exit;
+  R:=AnsiString.CompareText('A','a');
+  if not AssertTrue('Simple Compare strings (A,a) :'+IntToStr(R)+'=0',R=0) then exit;
+end;
+
+Function TestCopy : String;
+
+var
+  A,S : String;
+
+begin
+  Result:='';
+  A:=TBI;
+  S:=AnsiString.Copy(A);
+  if not AssertEquals('Copy creates equal copy',A,S) then exit;
+end;
+
+Function TestCreate : String;
+
+Var
+  A : String;
+
+begin
+  Result:='';
+  A:=AnsiString.Create('*',5);
+  if not AssertEquals('Create with char and length','*****',A) then exit;
+  A:=AnsiString.Create(['a','b','c','d','e']);
+  if not AssertEquals('Create with array of char','abcde',A) then exit;
+  A:=AnsiString.Create(['a','b','c','d','e'],1,3);
+  if not AssertEquals('Create with array of char and index, len','bcd',A) then exit;
+end;
+
+Function TestEndsText : String;
+
+begin
+  Result:='';
+  if not AssertTrue('1. EndsText, correct',AnsiString.EndsText('be','to be or not to be')) then exit;
+  if not AssertTrue('2. EndsText, correct, case insensitive',AnsiString.EndsText('BE','to be or not to be')) then exit;
+  if not AssertFalse('3. EndsText, not correct',AnsiString.EndsText('de','to be or not to be')) then exit;
+  if not AssertFalse('4. EndsText, empty',Ansistring.EndsText('','to be or not to be')) then exit;
+end;
+
+Function TestEquals : String;
+
+Var
+  A,B : String;
+
+begin
+  Result:='';
+  A:='Yes';
+  B:='No';
+  if not AssertFalse('1. Equals(A,B)',AnsiString.Equals(A,B)) then exit;
+  B:='Yes';
+  if not AssertTrue('2. Equals(A,B)',AnsiString.Equals(A,B)) then exit;
+  B:='No';
+  if not AssertFalse('3. A.Equals(B)',A.Equals(B)) then exit;
+  B:='Yes';
+  if not AssertTrue('4. A.Equals(B)',A.Equals(B)) then exit;
+end;
+
+Function TestFormat : String;
+
+
+begin
+  Result:='';
+  if not AssertEquals('1. Format as class function','A1 BC', AnsiString.Format('A%d B%s',[1,'C'])) then exit;
+  if not AssertEquals('2. Format function','A1 BC', 'A%d B%s'.Format([1,'C'])) then exit;
+end;
+
+Function TestIsNullOrEmpty : String;
+
+begin
+  Result:='';
+  If Not AssertTrue('1. Empty string returns true',AnsiString.IsNullOrEmpty('')) then exit;
+end;
+
+Function IsNullOrWhiteSpace : String;
+
+Var
+  C : Char;
+begin
+  Result:='';
+  If Not AssertTrue('2. Empty string returns true',AnsiString.IsNullOrEmpty('')) then exit;
+  For C:=#1 to #32 do
+    If Not AssertTrue('Char '+IntToStr(Ord(C))+' string returns true',AnsiString.IsNullOrEmpty(C)) then exit;
+end;
+
+Function TestJoin : String;
+
+Var
+  C : Char;
+  Cu : Currency;
+  I6 : Int64;
+  Q : QWord;
+  F : Extended;
+  W : Widestring;
+  U : UnicodeString;
+  S : AnsiString;
+  P : PChar;
+  PW : PWideChar;
+// Variants unit used when enabling this.
+//  V : Variant;
+
+
+
+begin
+  Result:='';
+  C:='3';
+  Cu:=12.3;
+  I6:=1234;
+  F:=1234.5;
+  Q:=123456;
+  S:='AS';
+  W:='WS';
+  U:='US';
+  P:=PChar(S);
+  PW:=PWideChar(U);
+//  V:='Var';
+  if not AssertEquals('1 element','ABC',AnsiString.Join(' ',['ABC'])) then exit;
+  if not AssertEquals('2 elements','ABC DEF',AnsiString.Join(' ',['ABC','DEF'])) then exit;
+  if not AssertEquals('3 elements','ABC DEF GHI',AnsiString.Join(' ',['ABC','DEF','GHI'])) then exit;
+  if not AssertEquals('5 elements, index','ABC DEF GHI',AnsiString.Join(' ',['NONO','ABC','DEF','GHI','nono'],1,3)) then exit;
+{   if not AssertEquals('Array of const','ABC 1 True 3 12.3 1234 '+FloatToStr(F)+' 123456 AS US WS AS US Var',
+                      AnsiString.Join(' ',['ABC',1,True,C,CU,I6,F,Q,S,U,W,P,PW,V])) then exit;}
+end;
+
+Function TestLowerCase : String;
+
+begin
+  Result:='';
+  if not AssertEquals('1. Simple Lowercase','abc',AnsiString.Lowercase('ABC')) then exit;
+end;
+
+Function TestParse : String;
+
+Var
+  E : Extended;
+begin
+  Result:='';
+  E:=12.3;
+  if not AssertEquals('Boolean','-1',AnsiString.Parse(True))then exit;
+  if not AssertEquals('Integer','12',AnsiString.Parse(Integer(12)))then exit;
+  if not AssertEquals('Int64','45',AnsiString.Parse(Int64(45)))then exit;
+  if not AssertEquals('Extended',FloatToStr(E),AnsiString.Parse(E)) then exit;
+end;
+
+Function TestToBoolean : String;
+
+begin
+  Result:='';
+  If not AssertTrue('Class function, true',AnsiString.ToBoolean('True')) then exit;
+  If not AssertTrue('function 1',AnsiString.ToBoolean('1')) then exit;
+  If not AssertFalse('Class function false',AnsiString.ToBoolean('False')) then exit;
+  If not AssertFalse('function 0',AnsiString.ToBoolean('0')) then exit;
+end;
+
+Function TestToDouble : String;
+
+begin
+  Result:='';
+  If not AssertEquals('Class function, 0',0.0,AnsiString.ToDouble('0.0')) then exit;
+  If not AssertEquals('Class function, 1.2',1.2,AnsiString.ToDouble('1.2')) then exit;
+  If not AssertEquals('function, 0',0.0,'0.0'.ToDouble) then exit;
+  If not AssertEquals('function, 1.2',1.2,'1.2'.ToDouble) then exit;
+end;
+
+Function TestToExtended : String;
+
+begin
+  Result:='';
+  If not AssertEquals('Class function, 0',0.0,AnsiString.ToExtended('0.0')) then exit;
+  If not AssertEquals('Class function, 1.2',1.2,AnsiString.ToExtended('1.2')) then exit;
+  If not AssertEquals('function, 0',0.0,'0.0'.ToExtended) then exit;
+  If not AssertEquals('function, 1.2',1.2,'1.2'.ToExtended) then exit;
+end;
+
+Function TestToInt64 : String;
+
+begin
+  Result:='';
+  If not AssertEquals('Class function, 0',0,AnsiString.ToInt64('0')) then exit;
+  If not AssertEquals('Class function, 12',12,AnsiString.ToInt64('12')) then exit;
+  If not AssertEquals('Class function, 1234567890123',1234567890123,AnsiString.ToInt64('1234567890123')) then exit;
+  // 2 characters because it does not work on length 1, compiler assumes Char as in Delphi
+  If not AssertEquals('Class function, 0',0,'00'.ToInt64) then exit;
+  If not AssertEquals('Class function, 12',12,'12'.ToInt64) then exit;
+  If not AssertEquals('Class function, 1234567890123',1234567890123,'1234567890123'.ToInt64) then exit;
+end;
+
+Function TestToInteger : String;
+
+begin
+  Result:='';
+  If not AssertEquals('Class function, 0',0,AnsiString.ToInteger('0')) then exit;
+  If not AssertEquals('Class function, 12',12,AnsiString.ToInteger('12')) then exit;
+  If not AssertEquals('Class function, 123456789',123456789,AnsiString.ToInteger('123456789')) then exit;
+  // 2 characters because it does not work on length 1, compiler assumes Char as in Delphi
+  If not AssertEquals('Class function, 0',0,'00'.ToInteger) then exit;
+  If not AssertEquals('Class function, 12',12,'12'.ToInteger) then exit;
+  If not AssertEquals('Class function, 123456789',123456789,'123456789'.ToInteger) then exit;
+end;
+
+Function TestToSingle : String;
+
+begin
+  Result:='';
+  If not AssertEquals('Class function, 0',Single(0.0),AnsiString.ToSingle('0.0')) then exit;
+  If not AssertEquals('Class function, 1.2',Single(1.2),AnsiString.ToSingle('1.2')) then exit;
+  If not AssertEquals('function, 0',Single(0.0),'0.0'.ToSingle) then exit;
+  If not AssertEquals('function, 1.2',Single(1.2),'1.2'.ToSingle) then exit;
+end;
+
+Function TestUppercase : String;
+
+begin
+  Result:='';
+  if not AssertEquals('1. Simple Lowercase','ABC',AnsiString.UpperCase('abc')) then exit;
+end;
+
+Function TestCompareTo : String;
+
+begin
+  Result:='';
+  // 2 characters because it does not work on length 1, compiler assumes Char as in Delphi
+  if not AssertTrue('1. A<B','AA'.CompareTo('AB')<0) then exit;
+  if not AssertTrue('1. A=A','AA'.CompareTo('AA')=0) then exit;
+  if not AssertTrue('1. B>A','AB'.CompareTo('AA')>0) then exit;
+end;
+
+Function TestContains : String;
+
+begin
+  Result:='';
+  if not AssertTrue('ABC contains AB','ABC'.Contains('AB')) then exit;
+  if not AssertTrue('ABC contains BC','ABC'.Contains('BC')) then exit;
+  if not AssertTrue('ABC contains B','ABC'.Contains('B')) then exit;
+  if not AssertFalse('ABC does not contain empty','ABC'.Contains('')) then exit;
+  if not AssertFalse('ABC does not contain DEF','ABC'.Contains('DEF')) then exit;
+  if not AssertFalse('ABC does not contain a','ABC'.Contains('a')) then exit;
+end;
+
+Function TestCopyTo : String;
+
+Type
+  TCharArray = Array Of Char;
+
+Const
+  Res1 : Array[0..4] of Char = ('T','o',' ','b','e');
+
+Var
+  S : AnsiString;
+  A : TCharArray;
+  I : Integer;
+
+begin
+  Result:='';
+  A:=Default(TCharArray);
+  S:=TBI;
+  SetLength(A,5);
+  S.CopyTo(0,A,0,5);
+  For I:=0 to 4 do
+    if not AssertEquals('Zero indexes, Char '+IntToStr(i),Res1[I],A[I]) then exit;
+  S:='AB'+S;
+  S.CopyTo(2,A,0,5);
+  For I:=0 to 4 do
+    if not AssertEquals('Source index, zero dest index, Char '+IntToStr(i),Res1[I],A[I]) then exit;
+  SetLength(A,8);
+  S.CopyTo(2,A,3,5);
+  For I:=0 to 4 do
+    if not AssertEquals('Source index, dest index, Char '+IntToStr(i),Res1[I],A[I+3]) then exit;
+end;
+
+Function TestCountChar : String;
+
+begin
+  Result:='';
+  if not AssertEquals('Empty string',0,''.CountChar(' ')) then exit;
+  if not AssertEquals('Start and end ',2,' ** '.CountChar(' ')) then exit;
+  if not AssertEquals('Middle',2,'*  *'.CountChar(' ')) then exit;
+end;
+
+Function TestDeQuotedString : String;
+
+Const
+  C =  TBI;
+  C2 =  'To be ''implemented';
+  C3 =  'To be "implemented';
+
+Var
+  S : String;
+
+begin
+  Result:='';
+  S:=''''+C+'''';
+  If Not AssertEquals('Simple case of '+S,C,S.DequotedString) then exit;
+  S:=''''+StringReplace(C2,'''','''''',[rfReplaceAll])+'''';
+  If Not AssertEquals('Quoted case of '+S,C2,S.DequotedString) then exit;
+  S:='"'+C+'"';
+  If Not AssertEquals('Simple case of '+S,C,S.DequotedString('"')) then exit;
+  S:='"'+StringReplace(C3,'"','""',[rfReplaceAll])+'"';
+  If Not AssertEquals('Quoted case of '+S,C3,S.DequotedString('"')) then exit;
+end;
+
+Function TestEndsWith : String;
+
+Var
+  S : AnsiString;
+
+begin
+  Result:='';
+  S:=TBI;
+  If not AssertTrue('length 0', S.EndsWith('')) then exit;
+  If not AssertTrue('length 1', S.EndsWith('d')) then exit;
+  If not AssertTrue('length 2', S.EndsWith('ed')) then exit;
+  If not AssertTrue('equal length (same)', S.EndsWith(S)) then exit;
+  If not AssertFalse('length+2', S.EndsWith(S+'ed')) then exit;
+  If not AssertFalse('Random string', S.EndsWith('erd')) then exit;
+  If not AssertTrue('match case ', S.EndsWith('ed',False)) then exit;
+  If not AssertFalse('match case, no match ', S.EndsWith('eD',False)) then exit;
+  If not AssertTrue('no match case, match ', S.EndsWith('ED',True)) then exit;
+  If not AssertFalse('no match case, no match ', S.EndsWith('DED',True)) then exit;
+end;
+Function TestGetHashCode : String;
+{
+Function GetHashCode: Integer;
+}
+
+Var
+  S : AnsiString;
+
+begin
+  Result:='';
+  S:=TBI;
+  if not AssertTrue('Nonzero hashcode',S.GetHashCode<>0) then exit;
+  // A more meaningful test would be nice...
+end;
+
+Function TestIndexOf : String;
+
+Var
+  S : String;
+
+begin
+  Result:='';
+  S:=TBI+' To perfection';
+  // Char based.
+  If not AssertEquals('Char, Nonexisting returns -1',-1,S.IndexOf('a')) then exit;
+  If not AssertEquals('Char, Existing, zero based',0,S.IndexOf('T')) then exit;
+  If not AssertEquals('Char, Case sensitive',-1,S.IndexOf('I')) then exit;
+  If not AssertEquals('Char, using start index',10,S.IndexOf('e',5)) then exit;
+  If not AssertEquals('Char, using start index and count, not found',-1,S.IndexOf('e',5,5)) then exit;
+  If not AssertEquals('Char, using start index and count,found',10,S.IndexOf('e',5,6)) then exit;
+  // String based.
+  If not AssertEquals('String, Nonexisting returns -1',-1,S.IndexOf('a')) then exit;
+  If not AssertEquals('String, zero based',0,S.IndexOf('T')) then exit;
+  If not AssertEquals('String, case sensitive',-1,S.IndexOf('I')) then exit;
+  If not AssertEquals('String, using start index',18,S.IndexOf('To',2)) then exit;
+  If not AssertEquals('String, using start index and count ',-1,S.IndexOf('To be',2,4)) then exit;
+  If not AssertEquals('String, using start index and count (partial overlap)',-1,S.IndexOf('To be',16,4)) then exit;
+end;
+
+Function TestIndexOfAny : String;
+
+Var
+  S : String;
+  ES : Array of Char;
+begin
+  Result:='';
+  S:=TBI;
+  es:=[];
+  // Just a set
+  SetLength(ES,0);
+  if not AssertEquals('Empty set',-1,S.IndexOfAny(ES)) then exit;
+  if not AssertEquals('Single char in set, no match',-1,S.IndexOfAny(['a'])) then exit;
+  if not AssertEquals('Single char in set, no match (wrong case)',-1,S.IndexOfAny(['O'])) then exit;
+  if not AssertEquals('2 chars in set, no match',-1,S.IndexOfAny(['a','z'])) then exit;
+  if not AssertEquals('Single char in set, match',4,S.IndexOfAny(['e'])) then exit;
+  if not AssertEquals('2 chars in set, 2nd matches',3,S.IndexOfAny(['a','b'])) then exit;
+  // Start index
+  if not AssertEquals('StartIndex, Empty set',-1,S.IndexOfAny(ES,2)) then exit;
+  if not AssertEquals('StartIndex, Single char in set, no match',-1,S.IndexOfAny(['a'],2)) then exit;
+  if not AssertEquals('StartIndex, Single char in set, no match (wrong case)',-1,S.IndexOfAny(['O'],1)) then exit;
+  if not AssertEquals('StartIndex, Single char in set, no match (index too big)',-1,S.IndexOfAny(['o'],2)) then exit;
+  if not AssertEquals('StartIndex, 2 chars in set, no match',-1,S.IndexOfAny(['a','z'],4)) then exit;
+  if not AssertEquals('StartIndex, Single char in set, match',4,S.IndexOfAny(['e'],3)) then exit;
+  if not AssertEquals('StartIndex, 2 chars in set, 2nd matches',3,S.IndexOfAny(['a','b'],2)) then exit;
+  // Start index, count
+  if not AssertEquals('StartIndex, count, Empty set',-1,S.IndexOfAny(ES,2,3)) then exit;
+  if not AssertEquals('StartIndex, count, Single char in set, no match',-1,S.IndexOfAny(['a'],2)) then exit;
+  if not AssertEquals('StartIndex, count, Single char in set, no match (wrong case)',-1,S.IndexOfAny(['O'],1)) then exit;
+  if not AssertEquals('StartIndex, count, Single char in set, no match (index too big)',-1,S.IndexOfAny(['o'],2,4)) then exit;
+  if not AssertEquals('StartIndex, count, Single char in set, no match (index too big, count too small)',-1,S.IndexOfAny(['o'],5,5)) then exit;
+  if not AssertEquals('StartIndex, count, 2 chars in set, no match',-1,S.IndexOfAny(['a','z'],4,3)) then exit;
+  if not AssertEquals('StartIndex, count, Single char in set, match',4,S.IndexOfAny(['e'],3,4)) then exit;
+  if not AssertEquals('StartIndex, count, Single char in set, match in range',10,S.IndexOfAny(['e'],5,6)) then exit;
+  if not AssertEquals('StartIndex, count, 2 chars in set, 2nd matches',3,S.IndexOfAny(['a','b'],2,3)) then exit;
+end;
+
+Function TestIndexOfAnyString : String;
+
+Var
+  S : String;
+  ES : Array of String;
+begin
+  Result:='';
+  S:=TBI;
+  ES:=[];
+  // Just a set
+  SetLength(ES,0);
+  if not AssertEquals('Empty set',-1,S.IndexOfAny(ES)) then exit;
+  if not AssertEquals('Single string in set, no match',-1,S.IndexOfAny(['ab'])) then exit;
+  if not AssertEquals('Single string in set, no match (wrong case)',-1,S.IndexOfAny(['TO'])) then exit;
+  if not AssertEquals('2 strings in set, no match',-1,S.IndexOfAny(['ab','yz'])) then exit;
+  if not AssertEquals('Single string in set, match',4,S.IndexOfAny(['e '])) then exit;
+  if not AssertEquals('2 strings in set, 2nd matches',3,S.IndexOfAny(['ee','be'])) then exit;
+  // Start index
+  if not AssertEquals('StartIndex, Empty set',-1,S.IndexOfAny(ES,2)) then exit;
+  if not AssertEquals('StartIndex, Single string in set, no match',-1,S.IndexOfAny(['aa'],2)) then exit;
+  if not AssertEquals('StartIndex, Single string in set, no match (wrong case)',-1,S.IndexOfAny(['TO'],1)) then exit;
+  if not AssertEquals('StartIndex, Single string in set, no match (index too big)',-1,S.IndexOfAny(['To'],2)) then exit;
+  if not AssertEquals('StartIndex, 2 strings in set, no match',-1,S.IndexOfAny(['aa','zz'],4)) then exit;
+  if not AssertEquals('StartIndex, Single string in set, match',4,S.IndexOfAny(['e '],3)) then exit;
+  if not AssertEquals('StartIndex, 2 strings in set, 2nd matches',3,S.IndexOfAny(['aa','be'],2)) then exit;
+  // Start index, count
+  if not AssertEquals('StartIndex, count, Empty set',-1,S.IndexOfAny(ES,2,3)) then exit;
+  if not AssertEquals('StartIndex, count, Single string in set, no match',-1,S.IndexOfAny(['aa'],2)) then exit;
+  if not AssertEquals('StartIndex, count, Single string in set, no match (wrong case)',-1,S.IndexOfAny(['tO'],1)) then exit;
+  if not AssertEquals('StartIndex, count, Single string in set, no match (index too big)',-1,S.IndexOfAny(['To'],2,4)) then exit;
+  if not AssertEquals('StartIndex, count, Single string in set, no match (index too big, count too small)',-1,S.IndexOfAny(['To'],5,5)) then exit;
+  if not AssertEquals('StartIndex, count, 2 strings in set, no match',-1,S.IndexOfAny(['aa','zz'],4,3)) then exit;
+  if not AssertEquals('StartIndex, count, Single string in set, match',4,S.IndexOfAny(['e '],3,4)) then exit;
+  if not AssertEquals('StartIndex, count, Single string in set, match in range',10,S.IndexOfAny(['em'],5,7)) then exit;
+  if not AssertEquals('StartIndex, count, 2 strings in set, 2nd matches',3,S.IndexOfAny(['aa','be'],2,3)) then exit;
+end;
+
+Function TestIndexOfUnquoted : String;
+
+Var
+  S : String;
+
+begin
+  // Tests created from special cases in Embarcadero docs.
+  Result:='';
+  S:='"Thias" ias iat';
+  If not AssertEquals('Simple case, match',8,S.IndexOfUnquoted('ia','"','"')) then exit;
+  S:='"This  is"  it';
+  If not AssertEquals('Simple case, match',10,S.IndexOfUnquoted('  ','"','"')) then exit;
+  S:='"Thias ias iat';
+  If not AssertEquals('Opening but not closed',-1,S.IndexOfAnyUnquoted('ia','"','"')) then exit;
+  S:='"Thias" "ias" "iat"';
+  If not AssertEquals('Only spaces unquoted',-1,S.IndexOfAnyUnquoted('ia','"','"')) then exit;
+  S:='<Thias <ias>> iat';
+  If not AssertEquals('Different start/end quotes',14,S.IndexOfAnyUnquoted('ia','<','>')) then exit;
+  S:='"Thias" ias iat';
+  If not AssertEquals('Start index',3,S.IndexOfAnyUnquoted('ia','"','"',1)) then exit;
+  S:='Thias" "ias" "iat';
+  If not AssertEquals('Start index',-1,S.IndexOfAnyUnquoted('ia','"','"',6)) then exit;
+end;
+
+Function TestIndexOfAnyUnquoted : String;
+
+Var
+  S : String;
+
+begin
+  // Tests created from special cases in Embarcadero docs.
+  Result:='';
+  S:='"This" is it';
+  If not AssertEquals('Simple case, match',7,S.IndexOfAnyUnquoted(['i'],'"','"')) then exit;
+  If not AssertEquals('Simple case 2, match',7,S.IndexOfAnyUnquoted(['a','i'],'"','"')) then exit;
+  S:='"This is it';
+  If not AssertEquals('Opening but not closed',-1,S.IndexOfAnyUnquoted(['i'],'"','"')) then exit;
+  S:='"This" "is" "it"';
+  If not AssertEquals('Only spaces unquoted',-1,S.IndexOfAnyUnquoted(['i'],'"','"')) then exit;
+  S:='<This <is>> it';
+  If not AssertEquals('Different start/end quotes',12,S.IndexOfAnyUnquoted(['i'],'<','>')) then exit;
+  S:='"This" is it';
+  // The documentation is WRONG on this one. Delphi prints 3, not 2 as in the docs.
+  If not AssertEquals('Start index',3,S.IndexOfAnyUnquoted(['i'],'"','"',1)) then exit;
+  S:='This" "is" "it';
+  If not AssertEquals('Start index',-1,S.IndexOfAnyUnquoted(['i'],'"','"',5)) then exit;
+end;
+
+Function TestInsert : String;
+
+Var
+  S : String;
+
+begin
+  Result:='';
+  S:=TBI;
+  If not AssertEquals('0 based (1) (result)','All To be implemented',S.Insert(0,'All ')) then exit;
+  If not AssertEquals('0 based (1) (self)','All To be implemented',S) then exit;
+  S:=TBI;
+  If not AssertEquals('0 based (2)','To be completely implemented',S.Insert(6,'completely ')) then exit;
+  S:=TBI;
+  If not AssertEquals('Negative index','completely '+TBI,S.Insert(-3,'completely ')) then exit;
+  S:=TBI;
+  If not AssertEquals('Too big index',TBI+'completely ',S.Insert(Length(S)+1,'completely ')) then exit;
+end;
+
+Function TestIsDelimiter : String;
+
+Var
+  S : String;
+
+begin
+  Result:='';
+  S:=TBI;
+  if not AssertTrue('Simple case, true',S.IsDelimiter('be',3)) then exit;
+  if not AssertFalse('Simple case, false',S.IsDelimiter('ba',4)) then exit;
+end;
+
+Function TestIsEmpty : String;
+
+Var
+  S : String;
+
+begin
+  Result:='';
+  S:='';
+  if not AssertTrue('Simple case, true',S.IsEmpty) then exit;
+  S:='abc';
+  if not AssertFalse('Simple case, false',S.IsEmpty) then exit;
+end;
+
+Function TestLastDelimiter : String;
+
+Var
+  S : String;
+begin
+  Result:='';
+  S:=TBI;
+  if not AssertEquals('Simple case, match, zero based ',0,S.LastDelimiter('T')) then exit;
+  if not AssertEquals('Simple case, no match ',-1,S.LastDelimiter('a')) then exit;
+  if not AssertEquals('Simple case',3,S.LastDelimiter('b')) then exit;
+  if not AssertEquals('Simple, check last match ',Length(TBI)-2,S.LastDelimiter('e')) then exit;
+  if not AssertEquals('Multi, no match ',-1,S.LastDelimiter('qy')) then exit;
+  if not AssertEquals('Multi, last match 1',Length(TBI)-1,S.LastDelimiter('ed')) then exit;
+  if not AssertEquals('Multi, last match 2',Length(TBI)-2,S.LastDelimiter('eb')) then exit;
+end;
+
+Function TestLastIndexOf : String;
+
+Var
+  S : String;
+
+begin
+  Result:='';
+  S:=TBI;
+  if not AssertEquals('Simple case, no match',-1,S.LastIndexOf('a')) then exit;
+  if not AssertEquals('Simple case, zero based',0,S.LastIndexOf('T')) then exit;
+  if not AssertEquals('Simple case last',Length(TBI)-2,S.LastIndexOf('e')) then exit;
+  if not AssertEquals('Simple case, startindex too low',-1,S.LastIndexOf('e',3)) then exit;
+  if not AssertEquals('Simple case, startindex OK ',4,S.LastIndexOf('e',7)) then exit;
+  if not AssertEquals('Simple case, startindex OK, count too small ',-1,S.LastIndexOf('e',7,3)) then exit;
+  if not AssertEquals('Simple case, startindex OK, count border',4,S.LastIndexOf('e',7,4)) then exit;
+end;
+
+Function TestLastIndexOfString : String;
+
+Var
+  S : String;
+
+begin
+  Result:='';
+  S:=TBI;
+  if not AssertEquals('Simple case, no match',-1,S.LastIndexOf('aa')) then exit;
+  if not AssertEquals('Simple case, zero based',0,S.LastIndexOf('To')) then exit;
+  if not AssertEquals('Simple case last',Length(TBI)-2,S.LastIndexOf('ed')) then exit;
+  if not AssertEquals('Simple case, startindex too low',-1,S.LastIndexOf('ed',3)) then exit;
+  if not AssertEquals('Simple case, startindex OK ',3,S.LastIndexOf('be',7)) then exit;
+  if not AssertEquals('Simple case, startindex OK, count too small ',-1,S.LastIndexOf('be',7,3)) then exit;
+  if not AssertEquals('Simple case, startindex OK, count border',3,S.LastIndexOf('be',7,4)) then exit;
+end;
+
+Function TestLastIndexOfAny : String;
+
+Var
+  S : String;
+
+begin
+  Result:='';
+  S:=TBI;
+  if not AssertEquals('Simple case, no match',-1,S.LastIndexOfAny(['x'])) then exit;
+  if not AssertEquals('Double case, no match',-1,S.LastIndexOfAny(['a','x'])) then exit;
+  if not AssertEquals('Simple case, zero based',0,S.LastIndexOfAny(['T'])) then exit;
+  if not AssertEquals('Double case, zero based',0,S.LastIndexOfAny(['T','q'])) then exit;
+  if not AssertEquals('Simple case last',Length(TBI)-2,S.LastIndexOf('e')) then exit;
+  if not AssertEquals('Simple case, startindex too low',-1,S.LastIndexOf('e',3)) then exit;
+  if not AssertEquals('Simple case, startindex OK ',4,S.LastIndexOf('e',7)) then exit;
+  if not AssertEquals('Simple case, startindex OK, count too small ',-1,S.LastIndexOf('e',7,3)) then exit;
+  if not AssertEquals('Simple case, startindex OK, count border',4,S.LastIndexOf('e',7,4)) then exit;
+end;
+
+Function TestPadLeft : String;
+
+Var
+  S : String;
+
+begin
+  Result:='';
+  S:='TBI';
+  if not AssertEquals('Default char','  TBI',S.PadLeft(5)) then exit;
+  if not AssertEquals('Length reached','TBI',S.PadLeft(3)) then exit;
+  if not AssertEquals('Length over','TBI',S.PadLeft(2)) then exit;
+  if not AssertEquals('Alternate char','**TBI',S.PadLeft(5,'*')) then exit;
+end;
+Function TestPadRight : String;
+
+Var
+  S : String;
+
+begin
+  Result:='';
+  S:='TBI';
+  if not AssertEquals('Default char','TBI  ',S.PadRight(5)) then exit;
+  if not AssertEquals('Original remains untouched','TBI',S) then exit;
+  if not AssertEquals('Length reached','TBI',S.PadRight(3)) then exit;
+  if not AssertEquals('Original remains untouched','TBI',S) then exit;
+  if not AssertEquals('Length over','TBI',S.PadRight(2)) then exit;
+  if not AssertEquals('Original remains untouched','TBI',S) then exit;
+  if not AssertEquals('Alternate char','TBI**',S.PadRight(5,'*')) then exit;
+  if not AssertEquals('Original remains untouched','TBI',S) then exit;
+end;
+
+Function TestQuotedString : String;
+
+Const
+  TII = '''This'' is it';
+  TII2 = '"This" is it';
+
+Var
+  S : String;
+
+begin
+  Result:='';
+  S:=TBI;
+  if not AssertEquals('Default case',''''+TBI+'''',S.QuotedString) then exit;
+  if not AssertEquals('Original remains untouched',TBI,S) then exit;
+  S:=TII;
+  if not AssertEquals('Quotes present, doubled','''''''This'''' is it''',S.QuotedString) then exit;
+  if not AssertEquals('Original remains untouched',TII,S) then exit;
+  // Other quote char
+  S:=TBI;
+  if not AssertEquals('Quote ", Default case','"'+TBI+'"',S.QuotedString('"')) then exit;
+  if not AssertEquals('Quote ", Original remains untouched',TBI,S) then exit;
+  S:=TII2;
+  if not AssertEquals('Quote ", Quotes present, doubled','"""This"" is it"',S.QuotedString('"')) then exit;
+  if not AssertEquals('Quote ", Original remains untouched',TII2,S) then exit;
+end;
+
+Function TestRemove : String;
+
+Var
+  S : String;
+
+begin
+  Result:='';
+  S:=TBI;
+  if not AssertEquals('Delete all','',S.Remove(0)) then exit;
+  if not AssertEquals('Delete all, original unchanged',TBI,S) then exit;
+  if not AssertEquals('Delete from index','To',S.Remove(2)) then exit;
+  if not AssertEquals('Delete all, original unchanged',TBI,S) then exit;
+  if not AssertEquals('Delete from negative index',TBI,S.Remove(-1)) then exit;
+  if not AssertEquals('Delete from negative, original unchanged',TBI,S) then exit;
+  // Count
+  if not AssertEquals('Delete N from start','be implemented',S.Remove(0,3)) then exit;
+  if not AssertEquals('Delete all, original unchanged',TBI,S) then exit;
+  if not AssertEquals('Delete from start index, count','To implemented',S.Remove(2,3)) then exit;
+  if not AssertEquals('Delete from start index, count, original unchanged',TBI,S) then exit;
+  if not AssertEquals('Delete from negative index, count',TBI,S.Remove(-1,4)) then exit;
+  if not AssertEquals('Delete from negative index, count, original unchanged',TBI,S) then exit;
+
+end;
+
+Function TestReplace : String;
+{
+Function Replace(OldChar: Char; NewChar: Char): string; overload;
+Function Replace(OldChar: Char; NewChar: Char; ReplaceFlags: TReplaceFlags): string; overload;
+Function Replace(const OldValue: string; const NewValue: string): string; overload;
+Function Replace(const OldValue: string; const NewValue: string; ReplaceFlags: TReplaceFlags): string; overload;
+}
+
+Var
+  S : String;
+
+begin
+  Result:='';
+  S:=TBI;
+  // Char
+  if not AssertEquals('Simple char','to be implemented',S.Replace('T','t')) then exit;
+  if not AssertEquals('Simple char, original unchanged',TBI,S) then exit;
+  if not AssertEquals('Simple char is case sensitive',TBI,S.Replace('t','t')) then exit;
+  if not AssertEquals('Simple char is replace all','To ba implamantad',S.Replace('e','a')) then exit;
+  if not AssertEquals('Simple char, case insensitive','to be implemented',S.Replace('t','t',[rfIgnoreCase])) then exit;
+  if not AssertEquals('Simple char, only first','To ba implemented',S.Replace('e','a',[])) then exit;
+  if not AssertEquals('Simple char, replace all','To ba implamantad',S.Replace('e','a',[rfReplaceAll])) then exit;
+  // String
+  if not AssertEquals('Simple string','ta be implemented',S.Replace('To','ta')) then exit;
+  if not AssertEquals('Simple string, case sensitive',TBI,S.Replace('to','ta')) then exit;
+  S:='AB AB';
+  if not AssertEquals('Simple string is replace all','cd cd',S.Replace('AB','cd')) then exit;
+  S:=TBI;
+  if not AssertEquals('Simple string, case insensitive','to be implemented',S.Replace('to','to',[rfIgnoreCase])) then exit;
+  S:='AB AB AB';
+  if not AssertEquals('Simple sting, only first','cd AB AB',S.Replace('AB','cd',[])) then exit;
+  S:='AB AB AB';
+  if not AssertEquals('Simple string, replace all','cd cd cd',S.Replace('AB','cd',[rfReplaceAll])) then exit;
+end;
+
+Function TestSplit : String;
+
+  Function TestArray(Msg : string; Aexpected : Array of string; AActual : TStringArray) : boolean;
+
+  Var
+    I : integer;
+
+  begin
+    Result:=False;
+    if not AssertEquals(Msg+': Length correct',Length(AExpected),Length(AActual)) then exit;
+    for I:=0 to Length(AExpected)-1 do
+      if not AssertEquals(Msg+': Element '+IntToStr(i)+' correct',AExpected[i],AActual[i]) then exit;
+    Result:=True;
+  end;
+
+Const
+  TII  = '"This is" it' ;
+  TII2 = '<This is> it' ;
+  TII3 = '<This is>  it' ;
+  CA: array[0..7] of string = ('F0;F1;F2', ';F1;F2', ';;F2', 'F0;;F2', ';;', 'F0;F1;', 'F0;;', ';F1;');
+
+Var
+  S : String;
+  C: TStringArray;
+
+begin
+  Result:='';
+  S:='a b';
+  C:=S.Split([' ']);
+  if not TestArray('One letter',['a','b'],C) then exit;
+  S:=TBI;
+  C:=S.Split([' ']);
+  if not TestArray('Simple case',['To','be','implemented'],C) then exit;
+  C:=S.Split([' '],2);
+  if not TestArray('Simple case, count',['To','be'],C) then exit;
+  S:=TII;
+  C:=S.Split([' ','"']);
+  if not TestArray('Quote and space',['','This','is','','it'],C) then exit;
+  C:=S.Split([' ','"'],TStringSplitOptions.ExcludeEmpty);
+  if not TestArray('Quote and space, exclude empty',['This','is','it'],C) then exit;
+  C:=S.Split([' '],2);
+  if not TestArray('Quote and space, count 2',['"This','is"'],C) then exit;
+  C:=S.Split([' ','"'],2,TStringSplitOptions.ExcludeEmpty);
+  if not TestArray('Quote and space, exclude empty,count 2',['This','is'],C) then exit;
+  C:=S.Split([' ','"'],1,TStringSplitOptions.ExcludeEmpty);
+  if not TestArray('Quote and space, exclude empty, count 1',['This'],C) then exit;
+  C:=S.Split([' '],'"','"');
+  if not TestArray('Quoted, space only',['"This is"','it'],C) then exit;
+  C:=S.Split([' '],'"','"',1);
+  if not TestArray('Quoted, space only; count',['"This is"'],C) then exit;
+  S:=TII2;
+  C:=S.Split([' '],'<','>');
+  if not TestArray('Quoted <>, space only',['<This is>','it'],C) then exit;
+  S:=TII3;
+  C:=S.Split([' '],'<','>');
+  if not TestArray('Quoted <>, space only, have space',['<This is>','','it'],C) then exit;
+  S:=TII3;
+  C:=S.Split([' '],'<','>',TStringSplitOptions.ExcludeEmpty);
+  if not TestArray('Quoted <>, space only, have space, exclude empty',['<This is>','it'],C) then exit;
+  for S in CA do
+    begin
+    C := S.Split([';']);
+    if Length(C)<>3 then
+      exit('Error : expect 3 elements when splitting string '+S);
+    end;
+end;
+
+Function TestSplitString : String;
+
+  Function TestArray(Msg : string; Aexpected : Array of string; AActual : TStringArray) : boolean;
+
+  Var
+    I : integer;
+
+  begin
+    Result:=False;
+    if not AssertEquals(Msg+': Length correct',Length(AExpected),Length(AActual)) then exit;
+    for I:=0 to Length(AExpected)-1 do
+      if not AssertEquals(Msg+': Element '+IntToStr(i)+' correct',AExpected[i],AActual[i]) then exit;
+    Result:=True;
+  end;
+
+Const
+  TII  = '"This  is"  it' ;
+  TII2 = '<This  is>  it' ;
+  TII3 = '<This  is>    it' ;
+
+Var
+  S : String;
+  C: TStringArray;
+
+begin
+  Result:='';
+  S:=StringReplace(TBI,' ','  ',[rfReplaceAll]);
+{  C:=S.Split(['  ']);
+  if not TestArray('Simple case',['To','be','implemented'],C) then exit;
+  C:=S.Split(['  '],2);
+  if not TestArray('Simple case, count',['To','be'],C) then exit;
+  S:=TII;
+  C:=S.Split(['  ','"']);
+  if not TestArray('Quote and space',['','This','is','','it'],C) then exit;
+  C:=S.Split(['  ','"'],ExcludeEmpty);
+  if not TestArray('Quote and space, exclude empty',['This','is','it'],C) then exit;
+  C:=S.Split(['  '],2);
+  if not TestArray('Quote and space, count 2',['"This','is"'],C) then exit;
+  C:=S.Split(['  ','"'],2,ExcludeEmpty);
+  if not TestArray('Quote and space, exclude empty,count 2',['This','is'],C) then exit;
+  C:=S.Split(['  ','"'],1,ExcludeEmpty);
+  if not TestArray('Quote and space, exclude empty, count 1',['This'],C) then exit;
+  }
+  S:=TII;
+  C:=S.Split(['  '],'"','"');
+  if not TestArray('Quoted, space only',['"This  is"','it'],C) then exit;
+  C:=S.Split(['  '],'"','"',1);
+  if not TestArray('Quoted, space only; count',['"This  is"'],C) then exit;
+  S:=TII2;
+  C:=S.Split(['  '],'<','>');
+  if not TestArray('Quoted <>, space only',['<This  is>','it'],C) then exit;
+  S:=TII3;
+  C:=S.Split(['  '],'<','>');
+  if not TestArray('Quoted <>, space only, have space',['<This  is>','','it'],C) then exit;
+  S:=TII3;
+  C:=S.Split(['  '],'<','>',TStringSplitOptions.ExcludeEmpty);
+  if not TestArray('Quoted <>, space only, have space, exclude empty',['<This  is>','it'],C) then exit;
+end;
+
+
+Function TestStartsWith : String;
+
+Var
+  S : String;
+
+begin
+  Result:='';
+  S:=TBI;
+  if not AssertTrue('Match empty',S.StartsWith('')) then exit;
+  if not AssertTrue('Match',S.StartsWith('To')) then exit;
+  if not AssertFalse('Match, case sensitive',S.StartsWith('to')) then exit;
+  if not AssertFalse('No Match',S.StartsWith('ab')) then exit;
+  if not AssertFalse('No Match, complete',S.StartsWith('To n')) then exit;
+  if not AssertFalse('Match, only start',S.StartsWith('be')) then exit;
+  if not AssertTrue('Match, case insensitive',S.StartsWith('To')) then exit;
+end;
+
+Function TestSubstring : String;
+
+Var
+  S : String;
+
+begin
+  Result:='';
+  S:=TBI;
+  // No length
+  if not AssertEquals('0 based','ed',S.SubString(Length(S)-2)) then exit;
+  if not AssertEquals('0 based, original untouched',TBI,S) then exit;
+  if not AssertEquals('Index too big','',S.SubString(Length(S)+2)) then exit;
+  if not AssertEquals('Index negative',TBI,S.SubString(-1)) then exit;
+  // Length
+  if not AssertEquals('0 based','To',S.SubString(0,2)) then exit;
+  if not AssertEquals('0 based, original untouched',TBI,S) then exit;
+  if not AssertEquals('Index too big','',S.SubString(Length(S)+2,3)) then exit;
+  if not AssertEquals('Index negative','To',S.SubString(-1,2)) then exit;
+  if not AssertEquals('Sub, index','be',S.SubString(3,2)) then exit;
+end;
+
+Function TestToCharArray : String;
+
+Var
+  S : String;
+  C : TCharArray;
+  I : integer;
+
+begin
+  Result:='';
+  S:=TBI;
+  C:=S.ToCharArray;
+  if not AssertEquals('No args, length',Length(S),Length(C)) then exit;
+  For I:=1 to Length(S) do
+    if not AssertEquals('No args, character (1-based) : '+IntToStr(i),S[i],C[i-1]) then exit;
+  C:=S.ToCharArray(3,Length(S)-3);
+  if not AssertEquals('No args, length',Length(S)-3,Length(C)) then exit;
+  For I:=4 to Length(S) do
+    if not AssertEquals('Args(3,len), character (1-based) : '+IntToStr(i),S[i],C[i-4]) then exit;
+end;
+
+Function TestToLower : String;
+
+Var
+  S : String;
+
+begin
+  Result:='';
+  S:=TBI;
+  if not AssertEquals('Lowercase','to be implemented',S.ToLower) then exit;
+  if not AssertEquals('Lowercase, original unmodified',TBI,S) then exit;
+end;
+
+Function TestToLowerInvariant : String;
+
+Var
+  S : String;
+
+begin
+  Result:='';
+  S:=TBI;
+  if not AssertEquals('Lowercase','to be implemented',S.ToLowerInvariant) then exit;
+  if not AssertEquals('Lowercase, original unmodified',TBI,S) then exit;
+  // This probably needs testing of some special cases.
+end;
+
+Function TestToUpper : String;
+
+Var
+  S : String;
+
+begin
+  Result:='';
+  S:=TBI;
+  if not AssertEquals('Lowercase','TO BE IMPLEMENTED',S.ToUpper) then exit;
+  if not AssertEquals('Lowercase, original unmodified',TBI,S) then exit;
+end;
+
+Function TestToUpperInvariant : String;
+
+Var
+  S : String;
+
+begin
+  Result:='';
+  S:=TBI;
+  if not AssertEquals('Lowercase','TO BE IMPLEMENTED',S.ToUpperInvariant) then exit;
+  if not AssertEquals('Lowercase, original unmodified',TBI,S) then exit;
+  // This probably needs testing of some special cases.
+end;
+
+Function TestTrim : String;
+Var
+  T,S : String;
+  C : Char;
+
+begin
+  Result:='';
+  S:=TBI;
+  For C:=#0 to #32 do
+    S:=C+S+C;
+  T:=S;
+  if not AssertEquals('By default all chars below #32 stripped',TBI,S.Trim) then exit;
+  if not AssertEquals('Original unmodified',T,S) then exit;
+  S:='lmn'+TBI+'lmn';
+  T:=S;
+  if not AssertEquals('Strip all indicated chars',TBI,S.Trim(['l','m','n'])) then exit;
+  if not AssertEquals('Strip all indicated chars, Original unmodified',T,S) then exit;
+end;
+
+Function TestTrimLeft : String;
+
+Var
+  O,T,S : String;
+  C : Char;
+
+begin
+  Result:='';
+  S:=TBI;
+  T:=TBI;
+  For C:=#0 to #32 do
+    begin
+    S:=C+S+C;
+    T:=T+C;
+    end;
+  O:=S;
+  if not AssertEquals('By default all chars below #32 stripped',T,S.TrimLeft) then exit;
+  if not AssertEquals('Original unmodified',O,S) then exit;
+  S:='lmn'+TBI+'lmn';
+  T:=TBI+'lmn';
+  O:=S;
+  if not AssertEquals('Strip all indicated chars',T,S.TrimLeft(['l','m','n'])) then exit;
+  if not AssertEquals('Strip all indicated chars, Original unmodified',O,S) then exit;
+end;
+
+Function TestTrimRight : String;
+
+Var
+  O,T,S : String;
+  C : Char;
+
+begin
+  Result:='';
+  S:=TBI;
+  T:=TBI;
+  For C:=#0 to #32 do
+    begin
+    S:=C+S+C;
+    T:=C+T;
+    end;
+  O:=S;
+  if not AssertEquals('By default all chars below #32 stripped',T,S.TrimRight) then exit;
+  if not AssertEquals('Original unmodified',O,S) then exit;
+  S:='lmn'+TBI+'lmn';
+  T:='lmn'+TBI;
+  O:=S;
+  if not AssertEquals('Strip all indicated chars',T,S.TrimRight(['l','m','n'])) then exit;
+  if not AssertEquals('Strip all indicated chars, Original unmodified',O,S) then exit;
+end;
+
+Function TestTrimEnd : String;
+
+Var
+  O,T,S : String;
+
+begin
+  Result:='';
+  S:='lmn'+TBI+'lmn';
+  T:='lmn'+TBI;
+  O:=S;
+  if not AssertEquals('Strip all indicated chars',T,S.TrimRight(['l','m','n'])) then exit;
+  if not AssertEquals('Strip all indicated chars, Original unmodified',O,S) then exit;
+end;
+
+Function TestTrimStart : String;
+
+Var
+  O,T,S : String;
+
+begin
+  Result:='';
+  S:='lmn'+TBI+'lmn';
+  T:=TBI+'lmn';
+  O:=S;
+  if not AssertEquals('Strip all indicated chars',T,S.TrimLeft(['l','m','n'])) then exit;
+  if not AssertEquals('Strip all indicated chars, Original unmodified',O,S) then exit;
+end;
+
+Function TestChars : String;
+
+Var
+  S : String;
+  I : Integer;
+begin
+  Result:='';
+  S:=TBI;
+  For I:=1 to Length(S) do
+    if not AssertEquals('Character (1-based)'+IntToStr(i),S[i],S.Chars[i-1]) then exit;
+end;
+
+Function TestLength : String;
+
+Var
+  S : String;
+
+begin
+  Result:='';
+  S:=TBI;
+  if not AssertEquals('Correct length',Length(TBI),S.Length) then exit;
+end;
+
+(* // Template code;
+Function Test : String;
+
+begin
+  Result:='To be implemented';
+end;
+*)
+
+Procedure RegisterStringHelperTests;
+
+Var
+  P : PSuite;
+
+begin
+  P:=AddSuite('StringHelper',EnsureSuite('SysUtils'));
+  AddTest('TestCompare',@TestCompare,P);
+  AddTest('TestCompareOrdinal',@TestCompareOrdinal,P);
+  AddTest('TestCompareText',@TestCompareText,P);
+  AddTest('TestCopy',@TestCopy,P);
+  AddTest('TestCreate',@TestCreate,P);
+  AddTest('TestEndsText',@TestEndsText,P);
+  AddTest('TestEquals',@TestEquals,P);
+  AddTest('TestFormat',@TestFormat,P);
+  AddTest('TestIsNullOrEmpty',@TestIsNullOrEmpty,P);
+  AddTest('TestJoin',@TestJoin,P);
+  AddTest('TestLowerCase',@TestLowerCase,P);
+  AddTest('TestParse',@TestParse,P);
+  AddTest('TestToBoolean',@TestToBoolean,P);
+  AddTest('TestToDouble',@TestToDouble,P);
+  AddTest('TestToExtended',@TestToExtended,P);
+  AddTest('TestToInt64',@TestToInt64,P);
+  AddTest('TestToInteger',@TestToInteger,P);
+  AddTest('TestToSingle',@TestToSingle,P);
+  AddTest('TestUppercase',@TestUppercase,P);
+  AddTest('TestCompareTo',@TestCompareTo,P);
+  AddTest('TestCopyTo',@TestCopyTo,P);
+  AddTest('TestContains',@TestContains,P);
+  AddTest('TestCountChar',@TestCountChar,P);
+  AddTest('TestDeQuotedString',@TestDeQuotedString,P);
+  AddTest('TestEndsWith',@TestEndsWith,P);
+  AddTest('TestGetHashCode',@TestGetHashCode,P);
+  AddTest('TestIndexOf',@TestIndexOf,P);
+  AddTest('TestIndexOfAny',@TestIndexOfAny,P);
+  AddTest('TestIndexOfAnyString',@TestIndexOfAnyString,P);
+  AddTest('TestIndexOfUnQuoted',@TestIndexOfUnQuoted,P);
+  AddTest('TestIndexOfAnyUnquoted',@TestIndexOfAnyUnquoted,P);
+  AddTest('TestInsert',@TestInsert,P);
+  AddTest('TestIsDelimiter',@TestIsDelimiter,P);
+  AddTest('TestIsEmpty',@TestIsEmpty,P);
+  AddTest('TestLastDelimiter',@TestLastDelimiter,P);
+  AddTest('TestLastIndexOf',@TestLastIndexOf,P);
+  AddTest('TestLastIndexOfString',@TestLastIndexOfString,P);
+  AddTest('TestLastIndexOfAny',@TestLastIndexOfAny,P);
+  AddTest('TestPadLeft',@TestPadLeft,P);
+  AddTest('TestPadRight',@TestPadRight,P);
+  AddTest('TestQuotedString',@TestQuotedString,P);
+  AddTest('TestRemove',@TestRemove,P);
+  AddTest('TestReplace',@TestReplace,P);
+  AddTest('TestSplit',@TestSplit,P);
+  AddTest('TestSplitString',@TestSplitString,P);
+  AddTest('TestStartsWith',@TestStartsWith,P);
+  AddTest('TestSubstring',@TestSubstring,P);
+  AddTest('TestToCharArray',@TestToCharArray,P);
+  AddTest('TestToLower',@TestToLower,P);
+  AddTest('TestToLowerInvariant',@TestToLowerInvariant,P);
+  AddTest('TestToUpper',@TestToUpper,P);
+  AddTest('TestToUpperInvariant',@TestToUpperInvariant,P);
+  AddTest('TestTrim',@TestTrim,P);
+  AddTest('TestTrimLeft',@TestTrimLeft,P);
+  AddTest('TestTrimRight',@TestTrimRight,P);
+  AddTest('TestTrimEnd',@TestTrimEnd,P);
+  AddTest('TestTrimStart',@TestTrimStart,P);
+  AddTest('TestChars',@TestChars,P);
+  AddTest('TestLength',@TestLength,P);
+//  AddTest('Test',@Test,P);
+end;
+
+initialization
+  RegisterStringHelperTests;
+end.
+

rtl/test/utstrings1.pp

@@ -0,0 +1,147 @@
+{ Basic test suite for the strings unit }
+{$mode objfpc}
+unit utstrings1;
+
+interface
+  
+uses punit, utrtl;
+
+implementation
+  
+uses
+  strings;
+
+Function teststrlen : TTestString;
+
+Const
+  P1 : PChar = '';
+  P2 : PChar = 'This is a constant pchar string';
+begin
+  Result:='';
+  If not AssertEquals('Empty string',0,strlen(P1)) then exit;
+  if not AssertEquals('Non-empty string',31,strlen(P2)) then exit;
+end;
+
+
+function teststrcomp : TTestString;
+
+Const
+  P1 : PChar = 'This is the first string.';
+  P2 : PCHar = 'This is the second string.';
+  P3 : PChar = 'This is the first string.';
+begin
+  Result:='';
+  If Not AssertTrue('Different strings',StrComp (P1,P2)<>0) then exit;
+  If Not AssertEquals('Equal strings different pointers',0,StrComp(P1,P3)) then exit;
+  If Not AssertTrue('First less than second',StrComp (P1,P2)<=0)  then exit;
+  If Not AssertTrue('Second bigger than first',StrComp (P2,P1)>0) then exit;
+end;
+
+Function teststrpas : TTestString;
+
+Const
+  P1 : PChar = 'This is a PCHAR string';
+  P2 : PChar = '';
+var
+  S : string;
+begin
+  Result:='';
+  S:=StrPas(P1);
+  if Not AssertEquals('Test strpas, non-nil','This is a PCHAR string',S) then exit;
+  S:=StrPas(P2);
+  if Not AssertEquals('Test strpas, nil','',S) then exit;
+end;
+
+
+Function teststrlcomp : TTestString;
+
+Const
+   P1 : PChar = 'This is the first string.';
+   P2 : PCHar = 'This is the second string.';
+   P3 : PChar = 'This is the first string.';
+Var
+  L : Longint;
+
+begin
+  Result:='';
+  L:=1;
+  While StrLComp(P1,P2,L)=0 do
+   inc (L);
+  if not AssertEquals('Max 13 chars equal',13,L) then exit;
+  if not AssertTrue('Different strings',StrLComp (P1,P2,255)<>0) then exit;
+  if not AssertEquals('Equal strings, different pointers',0,StrLComp (P1,P3,100)) then exit;
+  if not AssertTrue('P1<P2 negative',StrLComp (P1,P2,65535)<0) then exit;
+  if not AssertTrue('P2>P1, positive',StrLComp (P2,P1,12341234)>0) then exit;
+end;
+
+Function teststrpcopy : TTestString;
+
+Const
+   S1 = 'This is a normal string.';
+   S2 = '';
+
+Var
+  P : array[0..255] of char;
+
+begin
+  Result:='';
+  If not AssertEquals('Return value',@P,StrPCopy(P,S1)) then exit;
+  If not AssertEquals('Correct copy',0,StrComp(P,S1)) then exit;
+  if not AssertEquals('Return value 2',@P,StrPCopy(P,S2)) then
+  if not AssertEquals('Correct copy 2',0,StrComp(P,S2)) then exit;
+end;
+
+
+Function teststrend : TTestString;
+
+Const
+   P : PChar = 'This is a PCHAR string.';
+begin
+  Result:='';
+  If not AssertEquals('StrEnd, not empty',23,StrEnd(P)-P) then exit;
+end;
+
+
+Function teststrcopy : TTestString;
+
+Const
+  P1 : PChar = 'This a test string 012345678901234567890123456789012345678901234567890123456789';
+  P2 : PChar = '';
+
+var
+  Buf : array[0..255] of char;
+
+begin
+  Result:='';
+  If not AssertEquals('StrCopy non-empty Result',@Buf,StrCopy(Buf,P1)) then exit;
+  If not AssertEquals('StrCopy non-empty Resulting string',0,StrComp(Buf,P1)) then exit;
+  If not AssertEquals('StrCopy empty Result',@Buf,StrCopy(Buf,P2)) then exit;
+  If not AssertEquals('StrCopy empty Resulting string',0,StrComp(Buf,P2)) then exit;
+end;
+
+
+Function teststrscanstrrscan : TTestString;
+
+Const
+  P : PChar = 'This is a PCHAR string.';
+  S : Char = 's' ;
+begin
+  Result:='';
+  if Not AssertEquals('Not contained',0, StrComp(StrScan(P,s),'s is a PCHAR string.')) then exit;
+  if Not AssertTrue('Contained',StrComp(StrRScan(P,s),'string.')=0) then exit;
+end;
+
+
+Var
+  P : Psuite;
+begin
+  P:=EnsureSuite('Strings');
+  AddTest('teststrlen',@teststrlen,P);
+  AddTest('teststrcomp',@teststrcomp,P);
+  AddTest('teststrlcomp',@teststrlcomp,P);
+  AddTest('teststrpas', @teststrpas,P);
+  AddTest('teststrcopy', @teststrcopy,P);
+  AddTest('teststrpcopy',@teststrpcopy,P);
+  AddTest('teststrend', @teststrend,P);
+  AddTest('teststrscanstrrscan',@teststrscanstrrscan,P);
+end.

rtl/test/utstrtobool.pp

@@ -0,0 +1,97 @@
+unit utstrtobool;
+
+{$mode objfpc}
+
+Interface
+
+uses
+  sysutils;
+  
+implementation
+  
+uses utrtl, punit;
+
+Function TestStrToBool : AnsiString;
+  
+var
+  b : boolean;
+  FS : TFormatSettings;
+
+begin
+  Result:='';
+  if not TryStrToBool('true',b) then
+    exit('Test 1');
+  if not b then
+    exit('Test 2');
+  if not TryStrToBool('false',b) then
+    exit('Test 3');
+  if b then
+    exit('Test 4');
+
+  if not TryStrToBool('True',b) then
+    exit('Test 5');
+  if not b then
+    exit('Test 6');
+  if not TryStrToBool('False',b) then
+    exit('Test 7');
+  if b then
+    exit('Test 8');
+
+  if not TryStrToBool('truE',b) then
+    exit('Test 9');
+  if not b then
+    exit('Test 10');
+  if not TryStrToBool('falsE',b) then
+    exit('Test 11');
+  if b then
+    exit('Test 12');
+
+  if not TryStrToBool('TRUE',b) then
+    exit('Test 13');
+  if not b then
+    exit('Test 14');
+  if not TryStrToBool('FALSE',b) then
+    exit('Test 15');
+  if b then
+    exit('Test 16');
+
+  if not TryStrToBool('3.1415',b) then
+    exit('Test 17');
+  if not b then
+    exit('Test 18');
+  if not TryStrToBool('0.0',b) then
+    exit('Test 19');
+  if b then
+    exit('Test 19');
+
+  if TryStrToBool('',b) then
+    exit('Test 20');
+
+  if TryStrToBool('asdf',b) then
+    exit('Test 21');
+
+
+  b:=StrToBool('truE');
+  if not b then
+    exit('Test 22');
+  b:=StrToBool('falsE');
+  if b then
+    exit('Test 23');
+
+  if not(StrToBoolDef('',true)) then
+    exit('Test 24');
+
+  if StrToBoolDef('asdf',false) then
+    exit('Test 25');
+
+  FS:=DefaultFormatSettings;
+  FS.DecimalSeparator:=',';
+  If Not TryStrToBool('1,2',B,FS) then
+    Exit('test 26');
+
+end;
+
+
+begin
+  SysUtilsTest('TestStrToBool',@TestStrToBool);
+end.

rtl/test/utstrtotime.pp

@@ -0,0 +1,158 @@
+{$mode objfpc}
+{$h+}
+unit utstrtotime;
+
+Interface
+
+Function CheckStrToTime : String;
+
+Implementation
+
+uses sysutils, punit;
+
+Function CheckStrToTime : String;
+
+var
+  fmt : TFormatSettings;
+
+  Function Check(TestNo : Integer; inputstr : String;shouldfailstrtotime:boolean=false;shouldfailcomparison:boolean=false;resultstr:string='') : Boolean;
+
+  var 
+    dt :TDateTime;
+    outputstr:ansistring;
+    S : String;
+    
+  begin
+    Result:=True;
+    S:='Test '+IntToStr(TestNo)+': ';
+    if TryStrToTime(inputstr,dt,fmt) then
+     begin
+       if shouldfailstrtotime then
+         begin
+         Fail(S+' should fail on strtotime while it didn''t '+timetostr(dt,fmt));
+         Exit(False);
+         end
+       else
+         begin
+           outputstr:=TimeToStr(dt,fmt); // note because of this bugs can also be in timetostr
+           if resultstr<>'' then
+              begin
+                if outputstr<>resultstr then
+                  begin
+                    Fail(S+' should be "'+resultstr+'" is "'+outputstr+'"');
+                    Exit(False);
+                  end;
+                exit; // don't do other comparisons
+              end;
+
+           if inputstr<>outputstr then
+             begin
+              if not shouldfailcomparison then
+                begin
+                  Fail(S+' failed "'+inputstr+'" <> "'+outputstr+'"');
+                  Exit(False);
+                end;
+             end
+           else
+             begin
+              if shouldfailcomparison then
+                begin
+                  Fail(S+' succeeded "'+inputstr+'" = "'+outputstr+'", while it shouldn''t');
+                  exit(False);
+                end;
+             end;
+         end;
+     end
+    else
+      if not shouldfailstrtotime then
+       begin
+       Fail(S+' failed: '+inputstr);
+       Exit(False);
+      end;
+  end;
+
+  procedure setdecimalsep(c:char);
+  begin
+    fmt.DecimalSeparator:=c;
+    fmt.longtimeformat:='hh:nn:ss'+fmt.DecimalSeparator+'zzz';
+  end;
+
+begin
+  Result:='';
+  fmt:=defaultformatsettings;
+  fmt.TimeSeparator:=':';
+  fmt.TimeAmstring:='AM';
+  fmt.TimePmstring:='PM';
+
+  setdecimalsep('.');
+  If not Check( 0,'12:34:45.789',false,false) then exit;
+  If not Check( 1,'12:34:45,789',true,false) then exit;
+
+  setdecimalsep(',');
+  If not Check( 2,'12:34:45.789',true,false) then exit;
+  If not Check( 3,'12:34:45,789',false,false) then exit;
+
+  If not Check( 4,'12 am',false,false,'00:00:00,000') then exit;
+  If not Check( 5,'pm 12:34',false,false,'12:34:00,000') then exit;
+  If not Check( 6,'12::45',true,false) then exit;
+  If not Check( 7,'12:34:56 px',true,false) then exit;
+  If not Check( 8,'12:34:5x',true,false) then exit;
+  If not Check( 9,'12:34:56:78:90',true,false) then exit;
+  If not Check(10,'5 am',false,false,'05:00:00,000') then exit;
+  If not Check(11,'5 pm',false,false,'17:00:00,000') then exit;
+  If not Check(12,'am 5',false,false,'05:00:00,000') then exit;
+  If not Check(13,'pm 5',false,false,'17:00:00,000') then exit;
+  fmt.longtimeformat:='hh:nn:ss'+fmt.DecimalSeparator+'zzz am/pm';
+  If not Check(14,'5 am',false,false,'05:00:00,000 am') then exit;
+  If not Check(15,'5 pm',false,false,'05:00:00,000 pm') then exit;
+  If not Check(16,'am 5',false,false,'05:00:00,000 am') then exit;
+  If not Check(17,'pm 5',false,false,'05:00:00,000 pm') then exit;
+  fmt.TimeAmstring:='AM';
+  fmt.TimePmstring:='PM';
+  fmt.longtimeformat:='hh:nn:ss'+fmt.DecimalSeparator+'zzz a/p';
+  If not Check(18,'am 5',false,false,'05:00:00,000 a') then exit;
+  If not Check(19,'pm 5',false,false,'05:00:00,000 p') then exit;
+
+  fmt.TimeAMString:='a'; fmt.TimePMString:='p';
+
+  If not Check(20,'a 5',false,false,'05:00:00,000 a') then exit;
+  If not Check(21,'p 5',false,false,'05:00:00,000 p') then exit;
+  If not Check(22,'12:',True,false) then exit;
+  If not Check(23,'13:14:',True,false) then exit;
+  If not Check(24,'a 17:00',True,false) then exit;
+  If not Check(25,'p 19:00',True,false) then exit;
+  If not Check(26,'1:2:3',false,false,'01:02:03,000 a') then exit;
+  If not Check(27,'1:4',false,false,'01:04:00,000 a') then exit;
+  If not Check(28,'111:2:3',True,false) then exit;
+  If not Check(29,'1:444',True,false) then exit;
+  If not Check(30,'1:2:333',True,false) then exit;
+  If not Check(31,'1:4:55,4',False,false,'01:04:55,004 a') then exit;
+  If not Check(32,'1:4:55,12',False,false,'01:04:55,012 a') then exit;
+  If not Check(33,'1:4:55,004',False,false,'01:04:55,004 a') then exit;
+  If not Check(34,'1:4:55,0012',False,false,'01:04:55,012 a') then exit;
+  If not Check(35,'1:4:55,004'#9'am',true,false,'01:04:55,004'#9'am') then exit;
+  If not Check(36,#9'1:4:55,0012',true,false,'01:04:55,012 a') then exit;
+  If not Check(37,' 1:4:55,4',False,false,'01:04:55,004 a') then exit;
+  If not Check(38,'1: 4:55,12',False,false,'01:04:55,012 a') then exit;
+  If not Check(39,'1:4: 55,004',False,false,'01:04:55,004 a') then exit;
+  If not Check(40,'1:4:55, 2',False,false,'01:04:55,002 a') then exit;
+  If not Check(41,'1:4:55,   4',False,false,'01:04:55,004 a') then exit; // note more padding then needed
+  If not Check(42,'1:    4:55,   4',False,false,'01:04:55,004 a') then exit; // note more padding then needed
+  If not Check(43,'1:  4:   55,   4',False,false,'01:04:55,004 a') then exit; // note more padding then needed
+  If not Check(44,'1:  4:  55,   4',False,false,'01:04:55,004 a') then exit; // note more padding then needed
+  If not Check(45,'1 4 55 4',True,false) then exit;
+  fmt.timeseparator:=' ';
+  If not Check(46,'01 04 55',True,false) then exit;
+  If not Check(47,'a 01',false,false,'01 00 00,000 a') then exit;
+  If not Check(52,'a01',false,false,'01 00 00,000 a') then exit;
+  fmt.TimeSeparator:=':';
+  If not Check(48,'1:4:55,0000000000000000000000012',false,false,'01:04:55,012 a') then exit;
+  If not Check(49,'1:4:55,0000100012',True,false) then exit;
+  If not Check(50,'1:4:55,000001012',True,false) then exit;
+  If not Check(51,'12:034:00056',false,false,'12:34:56,000 p') then exit;
+end;
+
+begin
+  AddSuite('SysUtils');
+  AddTest('CheckStrToTime',@CheckStrToTime,'SysUtils');
+end.

rtl/test/utsyshelpers.pp

@@ -0,0 +1,1883 @@
+unit utsyshelpers;
+
+{$mode objfpc}{$h+}
+
+interface
+
+uses
+  Classes, SysUtils, Math;
+
+implementation
+
+uses punit, utrtl;
+
+Function TestByteHelper : String;
+
+Const
+  Value               = 123;
+  ValueAsString       = '123';
+  ValueAsHex          = '7B';
+  ValueAsHexDig       = 4;
+  ValueAsHexDigString = '007B';
+
+Var
+  V : Byte;
+begin
+  {$i tohelper.inc}
+end;
+
+Function TestShortIntHelper : String;
+
+Const
+  Value               = 123;
+  ValueAsString       = '123';
+  ValueAsHex          = '7B';
+  ValueAsHexDig       = 4;
+  ValueAsHexDigString = '007B';
+
+Var
+  V : ShortInt;
+begin
+  {$i tohelper.inc}
+end;
+
+Function TestNegShortIntHelper : String;
+
+Const
+  Value               = -123;
+  ValueAsString       = '-123';
+  ValueAsHex          = '85';
+  ValueAsHexDig       = 4;
+  ValueAsHexDigString = 'FF85';
+
+Var
+  V : ShortInt;
+begin
+  {$i tohelper.inc}
+end;
+
+Function TestWordHelper : String;
+
+Const
+  Value               = 1024;
+  ValueAsString       = '1024';
+  ValueAsHex          = '0400';
+  ValueAsHexDig       = 6;
+  ValueAsHexDigString = '000400';
+
+Var
+  V : Word;
+begin
+  {$i tohelper.inc}
+end;
+
+Function TestSmallintHelper : String;
+
+Const
+  Value               = 1024;
+  ValueAsString       = '1024';
+  ValueAsHex          = '0400';
+  ValueAsHexDig       = 6;
+  ValueAsHexDigString = '000400';
+
+Var
+  V : Smallint;
+begin
+  {$i tohelper.inc}
+end;
+
+Function TestNegSmallintHelper : String;
+
+Const
+  Value               = -1024;
+  ValueAsString       = '-1024';
+  ValueAsHex          = 'FC00';
+  ValueAsHexDig       = 6;
+  ValueAsHexDigString = 'FFFC00';
+
+Var
+  V : Smallint;
+begin
+  {$i tohelper.inc}
+end;
+
+Function TestCardinalHelper : String;
+
+Const
+  Value               = 131072;
+  ValueAsString       = '131072';
+  ValueAsHex          = '00020000';
+  ValueAsHexDig       = 10;
+  ValueAsHexDigString = '0000020000';
+
+Var
+  V : Cardinal;
+begin
+  {$i tohelper.inc}
+end;
+
+Function TestLongintHelper : String;
+
+Const
+  Value               = 131072;
+  ValueAsString       = '131072';
+  ValueAsHex          = '00020000';
+  ValueAsHexDig       = 10;
+  ValueAsHexDigString = '0000020000';
+
+Var
+  V : Longint;
+
+begin
+  {$i tohelper.inc}
+end;
+
+Function TestNegLongintHelper : String;
+
+Const
+  Value               = -131072;
+  ValueAsString       = '-131072';
+  ValueAsHex          = 'FFFE0000';
+  ValueAsHexDig       = 10;
+  ValueAsHexDigString = '00FFFE0000';
+
+Var
+  V : Longint;
+begin
+  {$i tohelper.inc}
+end;
+
+Function TestQWordHelper : String;
+
+Const
+  Value               = 17179869184; // 2^34
+  ValueAsString       = '17179869184';
+  ValueAsHex          = '0000000400000000';
+  ValueAsHexDig       = 18;
+  ValueAsHexDigString = '000000000400000000';
+
+Var
+  V : QWord;
+begin
+  {$i tohelper.inc}
+end;
+
+Function TestInt64Helper : String;
+
+Const
+  Value               = 17179869184; // 2^34
+  ValueAsString       = '17179869184';
+  ValueAsHex          = '0000000400000000';
+  ValueAsHexDig       = 18;
+  ValueAsHexDigString = '000000000400000000';
+
+Var
+  V : Int64;
+begin
+  {$i tohelper.inc}
+end;
+
+Function TestNegInt64Helper : String;
+
+Const
+  Value               = -17179869184; // 2^34
+  ValueAsString       = '-17179869184';
+  ValueAsHex          = 'FFFFFFFC00000000';
+  ValueAsHexDig       = 18;
+  ValueAsHexDigString = '00FFFFFFFC00000000';
+
+Var
+  V : Int64;
+begin
+  {$i tohelper.inc}
+end;
+
+Procedure GetGUID(out G : TGUID);
+
+Var
+  I : Integer;
+
+begin
+  G.Data1:=$DDCCBBAA;
+  G.Data2:=$EEFF;
+  G.Data3:=$CAAC;
+  For I:=0 to 7 do
+   G.Data4[i]:=(1 shl i) and $FF;
+end;
+
+Procedure EqualGUID(Msg : String;Expected,Actual : TGUID);
+
+Var
+  I : Integer;
+
+begin
+  AssertEquals(Msg+' D1 equal',Expected.D1,Actual.D1);
+  AssertEquals(Msg+' D2 equal',Expected.D2,Actual.D2);
+  AssertEquals(Msg+' D2 equal',Expected.D3,Actual.D3);
+  For I:=0 to 7 do
+   AssertEquals(Msg+' D4['+IntToStr(I)+'] equal',Expected.D4[i],Actual.D4[i]);
+end;
+
+Procedure EqualGUIDSwap(Msg : String;Expected,Actual : TGUID);
+
+Var
+  I : Integer;
+
+begin
+  AssertEquals(Msg+' D1 equal',SwapEndian(Expected.D1),Actual.D1);
+  AssertEquals(Msg+' D2 equal',SwapEndian(Expected.D2),Actual.D2);
+  AssertEquals(Msg+' D2 equal',SwapEndian(Expected.D3),Actual.D3);
+  For I:=0 to 7 do
+   AssertEquals(Msg+' D4['+IntToStr(I)+'] equal',Expected.D4[i],Actual.D4[i]);
+end;
+
+Function TestGUIDHelperCreateUntypedData : String;
+
+Var
+  Src,Dest : TGUID;
+
+begin
+  Result:='';
+  GetGUID(Src);
+  Dest:=TGUID.Create(Src, True);
+  if CPUEndian = TEndian.Big then
+    EqualGUID('BE CPU: Create(Data,True)',Src,Dest)
+  else
+    EqualGUIDSwap('LE CPU: Create(Data,True)',Src,Dest);
+  Dest:=TGUID.Create(Src, False);
+  if CPUEndian = TEndian.Big then
+    EqualGUIDSwap('BE CPU: Create(Data,False)',Src,Dest)
+  else
+    EqualGUID('LE CPU : Create(Data,False)',Src,Dest);
+end;
+
+Function TestGUIDHelperCreateUntypedDataEndian : String;
+
+Var
+  Src,Dest : TGUID;
+
+begin
+  Result:='';
+  GetGUID(Src);
+  Dest:=TGUID.Create(Src, TEndian.Big);
+  if CPUEndian = TEndian.Big then
+    EqualGUID('BE CPU: Create(Data,True)',Src,Dest)
+  else
+    EqualGUIDSwap('LE CPU: Create(Data,True)',Src,Dest);
+  Dest:=TGUID.Create(Src, TEndian.Little);
+  if CPUEndian = TEndian.Big then
+    EqualGUIDSwap('BE CPU: Create(Data,False)',Src,Dest)
+  else
+    EqualGUID('LE CPU : Create(Data,False)',Src,Dest);
+end;
+
+Function TestGUIDHelperCreateArrayOfByte : String;
+
+Var
+  Src,Dest : TGUID;
+  SrcBytes : Array of byte;
+
+begin
+  Result:='';
+  GetGUID(Src);
+  SrcBytes:=[];
+  SetLength(SrcBytes,SizeOf(TGUID));
+  Move(Src,SrcBytes[0],SizeOf(TGUID));
+  Dest:=TGUID.Create(SrcBytes[0], True);
+  if CPUEndian = TEndian.Big then
+    EqualGUID('BE CPU: Create(Data,True)',Src,Dest)
+  else
+    EqualGUIDSwap('LE CPU: Create(Data,True)',Src,Dest);
+  Dest:=TGUID.Create(SrcBytes[0], False);
+  if CPUEndian = TEndian.Big then
+    EqualGUIDSwap('BE CPU: Create(Data,False)',Src,Dest)
+  else
+    EqualGUID('LE CPU : Create(Data,False)',Src,Dest);
+end;
+
+Function TestGUIDHelperCreateTBytes : String;
+
+Var
+  Src,Dest : TGUID;
+  SrcBytes : TBytes;
+
+begin
+  Result:='';
+  GetGUID(Src);
+  SrcBytes:=[];
+  SetLength(SrcBytes,SizeOf(TGUID));
+  Move(Src,SrcBytes[0],SizeOf(TGUID));
+  Dest:=TGUID.Create(SrcBytes, TEndian.Big);
+  if CPUEndian = TEndian.Big then
+    EqualGUID('BE CPU: Create(Data,True)',Src,Dest)
+  else
+    EqualGUIDSwap('LE CPU: Create(Data,True)',Src,Dest);
+  Dest:=TGUID.Create(SrcBytes, TEndian.Little);
+  if CPUEndian = TEndian.Big then
+    EqualGUIDSwap('BE CPU: Create(Data,False)',Src,Dest)
+  else
+    EqualGUID('LE CPU : Create(Data,False)',Src,Dest);
+end;
+
+Function TestGUIDHelperCreateTBytesAtIndex : String;
+
+Var
+  Src,Dest : TGUID;
+  SrcBytes : TBytes;
+
+begin
+  Result:='';
+  GetGUID(Src);
+  SrcBytes:=[];
+  SetLength(SrcBytes,SizeOf(TGUID)*2);
+  Move(Src,SrcBytes[4],SizeOf(TGUID));
+  Dest:=TGUID.Create(SrcBytes, 4, TEndian.Big);
+  if CPUEndian = TEndian.Big then
+    EqualGUID('BE CPU: Create(Data,True)',Src,Dest)
+  else
+    EqualGUIDSwap('LE CPU: Create(Data,True)',Src,Dest);
+  Dest:=TGUID.Create(SrcBytes, 4, TEndian.Little);
+  if CPUEndian = TEndian.Big then
+    EqualGUIDSwap('BE CPU: Create(Data,False)',Src,Dest)
+  else
+    EqualGUID('LE CPU : Create(Data,False)',Src,Dest);
+end;
+
+Function TestGUIDHelperCreateString : String;
+
+Var
+  Src,Dest : TGUID;
+  SrcBytes : TBytes;
+
+begin
+  Result:='';
+  GetGUID(Src);
+  SrcBytes:=[];
+  SetLength(SrcBytes,SizeOf(TGUID)*2);
+  Move(Src,SrcBytes[4],SizeOf(TGUID));
+  Dest:=TGUID.Create(GUIDToString(Src));
+  EqualGUID('Check equals',Src,Dest);
+end;
+
+Function TestGUIDHelperCreateIntegerBytes : String;
+// Class Function Create(A: Integer; B: SmallInt; C: SmallInt; const D: TBytes): TGUID; overload; static;
+
+Var
+  A,I : Integer;
+  B,C : Smallint;
+  D : TBytes;
+  Dest : TGUID;
+
+begin
+  Result:='';
+  A:=1;
+  B:=2;
+  C:=3;
+  D:=Nil;
+  SetLength(D,8);
+  For I:=0 to 7 do
+    D[i]:=4+I;
+  Dest:=TGuid.Create(A,B,C,D);
+  AssertEquals('D1',1,Dest.D1);
+  AssertEquals('D2',2,Dest.D2);
+  AssertEquals('D3',3,Dest.D3);
+  For I:=0 to 7 do
+    AssertEquals('D4['+IntToStr(i)+']',I+4,Dest.D4[i]);
+end;
+
+Function TestGUIDHelperCreateWords : String;
+// Class Function Create(A: Cardinal; B: Word; C: Word; D, E, F, G, H, I, J, K: Byte): TGUID; overload; static;
+
+Var
+  A,I : Cardinal;
+  B,C : Word;
+  Dest : TGUID;
+
+begin
+  Result:='';
+  A:=1;
+  B:=Word($FFFE);
+  C:=Word($FFFF);
+  Dest:=TGuid.Create(A,B,C,4,5,6,7,8,9,10,11);
+  AssertEquals('D1',1,Dest.D1);
+  AssertEquals('D2',$FFFE,Dest.D2);
+  AssertEquals('D3',$FFFF,Dest.D3);
+  For I:=0 to 7 do
+    AssertEquals('D4['+IntToStr(i)+']',I+4,Dest.D4[i]);
+end;
+
+Function TestGUIDHelperCreateInteger : String;
+// Class Function Create(A: Integer; B: SmallInt; C: SmallInt; D, E, F, G, H, I, J, K: Byte): TGUID; overload; static;
+
+Var
+  A,I : Integer;
+  B,C : Smallint;
+  Dest : TGUID;
+
+begin
+  Result:='';
+  A:=1;
+  B:=Smallint($FFFE);
+  C:=Smallint($FFFF);
+  Dest:=TGuid.Create(A,B,C,4,5,6,7,8,9,10,11);
+  AssertEquals('D1',1,Dest.D1);
+  AssertEquals('D2',$FFFE,Dest.D2);
+  AssertEquals('D3',$FFFF,Dest.D3);
+  For I:=0 to 7 do
+    AssertEquals('D4['+IntToStr(i)+']',I+4,Dest.D4[i]);
+end;
+
+Function TestGUIDHelperCreateNew : String;
+// Class Function NewGuid: TGUID; static;
+
+Var
+  Src,Dest : TGuid;
+  I,J : integer;
+
+begin
+  Result:='';
+  // All we can do is check that you don't get the same GUID twice.
+  Src:=TGuid.NewGuid;
+  Dest:=TGuid.NewGuid;
+  I:=0;
+  Inc(I,Ord(Src.D1<>Dest.D1));
+  Inc(I,Ord(Src.D2<>Dest.D2));
+  Inc(I,Ord(Src.D3<>Dest.D3));
+  For J:=0 to 7 do
+    Inc(I,Ord(Src.D4[i]<>Dest.D4[i]));
+  AssertTrue('D1<>D2',I>0);
+end;
+
+Function TestGUIDHelperToByteArray : String;
+
+Var
+  Src,Dest : TGuid;
+  D : TBytes;
+
+begin
+  Result:='';
+  // All we can do is check that you don't get the same GUID twice.
+  Src:=TGuid.NewGuid;
+  D:=Src.ToByteArray(CPUEndian);
+  Dest:=TGUID.Create(D,CPUEndian);
+  EqualGUID('Check equals',Src,Dest);
+  if CPUEndian=TEndian.Big then
+    Dest:=TGUID.Create(D,TEndian.Little)
+  else
+    Dest:=TGUID.Create(D,TEndian.Big);
+  EqualGUIDSwap('Swapped, Check equals',Src,Dest);
+end;
+
+Function TestGUIDHelperToString: String;
+// Function ToString: string;
+
+Var
+  Src : TGuid;
+  S : String;
+begin
+  Result:='';
+  CreateGUID(Src);
+  S:=GuidToString(Src);
+  AssertEquals('Equal',S,Src.ToString);
+  Delete(S,1,1);
+  Delete(S,Length(S),1);
+  AssertEquals('Equal',S,Src.ToString(True));
+end;
+
+Function TestIsNanSingle : String;
+
+
+var
+  Value: Single;
+  ExMask: TFPUExceptionMask;
+  
+  
+begin  
+  Result:='';
+  ExMask := GetExceptionMask;
+  try
+    SetExceptionMask(ExMask + [exInvalidOp]);
+    Value := Single.NaN;
+    AssertEquals('Is Nan',True,Value.IsNan);
+  finally
+    SetExceptionMask(ExMask);
+  end;  
+end;    
+
+Function TestIsNanDouble : String;
+
+
+var
+  Value: Double;
+  ExMask: TFPUExceptionMask;
+begin  
+  Result:='';
+  ExMask := GetExceptionMask;
+  try
+    SetExceptionMask(ExMask + [exInvalidOp]);
+    Value := Double.NaN;
+    AssertEquals('Is Nan',True,Value.IsNan);
+  finally
+    SetExceptionMask(ExMask);
+  end;  
+end;    
+
+
+Function TestIsNanExtended : String;
+
+
+var
+  Value: Extended;
+  ExMask: TFPUExceptionMask;
+begin  
+  Result:='';
+  ExMask := GetExceptionMask;
+  try
+    SetExceptionMask(ExMask + [exInvalidOp]);
+    Value := Extended.NaN;
+    AssertEquals('Is Nan',True,Value.IsNan);
+  finally
+    SetExceptionMask(ExMask);
+  end;  
+end;    
+
+
+Function TestByteSetBit : String;
+var
+  Index: TByteBitIndex;
+  B: Byte;
+const
+  Expected: array[TByteBitIndex] of byte = ($01,$03,$07,$0F,$1F,$3F,$7F,$FF);
+begin
+  // writeln('TestByteSetBit Start');
+  B := 0;
+  for Index in TByteBitIndex do
+  begin
+    B.SetBit(Index);
+    if B <> Expected[Index] then
+      Exit('Bit '+IntToStr(Index)+': expected <'+IntToStr(Expected[Index])+'> got <'+IntToStr(B)+'>');
+  end;
+  // writeln('TestByteSetBit: OK');
+end;
+
+function TestByteToggleBit : string;
+var
+  Index: TByteBitIndex;
+  B: Byte;
+const
+  Expected: array[TByteBitIndex] of byte = ($01,$03,$07,$0F,$1F,$3F,$7F,$FF);
+begin
+  // writeln('TestByteToggleBit Start');
+  B := 0;
+  for Index in TByteBitIndex do
+  begin
+    B.ToggleBit(Index);
+    if B <> Expected[Index] then
+      Exit('Bit '+IntToStr(Index)+': expected <'+IntToStr(Expected[Index])+'> got <'+IntToStr(B)+'>');
+  end;
+  // writeln('TestByteToggleBit: OK');
+end;
+
+Function TestByteClearBit : string;
+var
+  Index: TByteBitIndex;
+  B: Byte;
+const
+  Expected: array[TByteBitIndex] of byte = ($FE,$FD,$FB,$F7,$EF,$DF,$BF,$7F);
+begin
+  // writeln('TestByteClearBit Start');
+  for Index in TByteBitIndex do
+  begin
+    B := High(Byte);
+    B.ClearBit(Index);
+    if B <> Expected[Index] then
+      Exit('Bit '+IntToStr(Index)+': expected <'+IntToStr(Expected[Index])+'> got <'+IntToStr(B)+'>');
+  end;
+  // writeln('TestByteClearBit: OK');
+end;
+
+Function TestByteTestBit : string;
+var
+  Index: TByteBitIndex;
+  B: Byte;
+const
+  Expected: array[TByteBitIndex] of Boolean = (True,False,True,False,True,False,True,False);
+begin
+  // writeln('TestByteTestBit Start');
+  B := $55;
+  for Index in TByteBitIndex do
+  begin
+    if B.TestBit(Index) <> Expected[Index] then
+      Exit('Bit '+IntToStr(Index)+': expected <'+BoolToStr(Expected[Index])+'> got <'+BoolToStr(B.TestBit(Index))+'>');
+  end;
+  // writeln('TestByteTestBit: OK');
+end;
+
+
+Function TestShortIntSetBit : string;
+var
+  Index: TShortIntBitIndex;
+  S: ShortInt;
+const
+  Expected: array[TByteBitIndex] of ShortInt = (
+    ShortInt($01),ShortInt($03),ShortInt($07),ShortInt($0F),
+    ShortInt($1F),ShortInt($3F),ShortInt($7F),ShortInt($FF));
+begin
+  // writeln('TestShortIntSetBit Start');
+  S := 0;
+  for Index in TShortIntBitIndex do
+  begin
+    S.SetBit(Index);
+    if S <> Expected[Index] then
+      Exit('Bit '+IntToStr(Index)+': expected <'+IntToStr(Expected[Index])+'> got <'+IntToStr(S)+'>');
+  end;
+  // writeln('TestShortIntSetBit: OK');
+end;
+
+Function TestShortIntToggleBit : string;
+var
+  Index: TShortIntBitIndex;
+  S: ShortInt;
+const
+  Expected: array[TByteBitIndex] of ShortInt = (
+    ShortInt($01),ShortInt($03),ShortInt($07),ShortInt($0F),
+    ShortInt($1F),ShortInt($3F),ShortInt($7F),ShortInt($FF));
+begin
+  // writeln('TestShortIntToggleBit Start');
+  S := 0;
+  for Index in TShortIntBitIndex do
+  begin
+    S.ToggleBit(Index);
+    if S <> Expected[Index] then
+      Exit('Bit '+IntToStr(Index)+': expected <'+IntToStr(Expected[Index])+'> got <'+IntToStr(S)+'>');
+  end;
+  // writeln('TestShortIntToggleBit: OK');
+end;
+
+Function TestShortIntClearBit : string;
+var
+  Index: TShortIntBitIndex;
+  S: ShortInt;
+const
+  Expected: array[TByteBitIndex] of ShortInt = (
+    ShortInt($FE),ShortInt($FD),ShortInt($FB),ShortInt($F7),
+    ShortInt($EF),ShortInt($DF),ShortInt($BF),ShortInt($7F));
+begin
+  // writeln('TestShortIntClearBit Start');
+  for Index in TShortIntBitIndex do
+  begin
+    S := ShortInt($FF);
+    S.ClearBit(Index);// was Togglebit ?
+    if S <> Expected[Index] then
+      Exit('Bit '+IntToStr(Index)+': expected <'+IntToStr(Expected[Index])+'> got <'+IntToStr(S)+'>');
+  end;
+  // writeln('TestShortIntClearBit: OK');
+end;
+
+Function TestShortIntTestBit : string;
+var
+  Index: TShortIntBitIndex;
+  S: ShortInt;
+const
+  Expected: array[TByteBitIndex] of Boolean = (True,False,True,False,True,False,True,False);
+begin
+  // writeln('TestShortIntTestBit Start');
+  S := ShortInt($55);
+  for Index in TShortIntBitIndex do
+  begin
+    if S.TestBit(Index) <> Expected[Index] then
+      Exit('Bit '+IntToStr(Index)+': expected <'+BoolToStr(Expected[Index])+'> got <'+BoolToStr(S.TestBit(Index))+'>');
+  end;
+  // writeln('TestShortIntTestBit: OK');
+end;
+
+
+function TestWordSetBit : string;
+var
+  Index: TWordBitIndex;
+  W: Word;
+const
+  Expected: array[TWordBitIndex] of Word = (
+    $0001,$0003,$0007,$000F,$001F,$003F,$007F,$00FF,
+    $01FF,$03FF,$07FF,$0FFF,$1FFF,$3FFF,$7FFF,$FFFF);
+begin
+  // writeln('TestWordSetBit Start');
+  W := 0;
+  for Index in TWordBitIndex do
+  begin
+    W.SetBit(Index);
+    if W <> Expected[Index] then
+      Exit('Bit '+IntToStr(Index)+': expected <'+IntToStr(Expected[Index])+'> got <'+IntToStr(W)+'>');
+  end;
+  // writeln('TestWordSetBit: OK');
+end;
+
+
+Function TestWordToggleBit : string;
+var
+  Index: TWordBitIndex;
+  W: Word;
+const
+  Expected: array[TWordBitIndex] of Word = (
+    $0001,$0003,$0007,$000F,$001F,$003F,$007F,$00FF,
+    $01FF,$03FF,$07FF,$0FFF,$1FFF,$3FFF,$7FFF,$FFFF);
+begin
+  // writeln('TestWordToggleBit Start');
+  W := 0;
+  for Index in TWordBitIndex do
+  begin
+    W.ToggleBit(Index);
+    if W <> Expected[Index] then
+      Exit('Bit '+IntToStr(Index)+': expected <'+IntToStr(Expected[Index])+'> got <'+IntToStr(W)+'>');
+  end;
+  // writeln('TestWordToggleBit: OK');
+end;
+
+
+Function TestWordClearBit : String;
+var
+  Index: TWordBitIndex;
+  W: Word;
+const
+  Expected: array[TWordBitIndex] of Word = (
+    $FFFE,$FFFD,$FFFB,$FFF7,$FFEF,$FFDF,$FFBF,$FF7F,
+    $FEFF,$FDFF,$FBFF,$F7FF,$EFFF,$DFFF,$BFFF,$7FFF);
+begin
+  // writeln('TestWordClearBit Start');
+  for Index in TWordBitIndex do
+  begin
+    W := High(Word);
+    W.ClearBit(Index);
+    if W <> Expected[Index] then
+      Exit('Bit '+IntToStr(Index)+': expected <'+IntToStr(Expected[Index])+'> got <'+IntToStr(W)+'>');
+  end;
+  // writeln('TestWordClearBit: OK');
+end;
+
+Function TestWordTestBit : string;
+var
+  Index: TWordBitIndex;
+  W: Word;
+const
+  Expected: array[TWordBitIndex] of Boolean = (True,False,True,False,True,False,True,False,
+                                               True,False,True,False,True,False,True,False);
+begin
+  // writeln('TestWordTestBit Start');
+  W := $5555;
+  for Index in TWordBitIndex do
+  begin
+    if W.TestBit(Index) <> Expected[Index] then
+      Exit('Bit '+IntToStr(Index)+': expected <'+BoolToStr(Expected[Index])+'> got <'+BoolToStr(W.TestBit(Index))+'>');
+  end;
+  // writeln('TestWordTestBit: OK');
+end;
+
+
+Function TestSmallIntSetBit : String;
+var
+  Index: TSmallIntBitIndex;
+  S: SmallInt;
+const
+  Expected: array[TSmallIntBitIndex] of SmallInt = (
+    SmallInt($0001),SmallInt($0003),SmallInt($0007),SmallInt($000F),
+    SmallInt($001F),SmallInt($003F),SmallInt($007F),SmallInt($00FF),
+    SmallInt($01FF),SmallInt($03FF),SmallInt($07FF),SmallInt($0FFF),
+    SmallInt($1FFF),SmallInt($3FFF),SmallInt($7FFF),SmallInt($FFFF));
+begin
+  // writeln('TestSmallIntSetBit Start');
+  S := 0;
+  for Index in TSmallIntBitIndex do
+  begin
+    S.SetBit(Index);
+    if S <> Expected[Index] then
+      Exit('Bit '+IntToStr(Index)+': expected <'+IntToStr(Expected[Index])+'> got <'+IntToStr(S)+'>');
+  end;
+  // writeln('TestSmallIntSetBit: OK');
+end;
+
+
+Function TestSmallIntToggleBit : String;
+var
+  Index: TSmallIntBitIndex;
+  S: SmallInt;
+const
+  Expected: array[TSmallIntBitIndex] of SmallInt = (
+    SmallInt($0001),SmallInt($0003),SmallInt($0007),SmallInt($000F),
+    SmallInt($001F),SmallInt($003F),SmallInt($007F),SmallInt($00FF),
+    SmallInt($01FF),SmallInt($03FF),SmallInt($07FF),SmallInt($0FFF),
+    SmallInt($1FFF),SmallInt($3FFF),SmallInt($7FFF),SmallInt($FFFF));
+begin
+  // writeln('TestSmallIntToggleBit Start');
+  S := 0;
+  for Index in TSmallIntBitIndex do
+  begin
+    S.ToggleBit(Index);
+    if S <> Expected[Index] then
+      Exit('Bit '+IntToStr(Index)+': expected <'+IntToStr(Expected[Index])+'> got <'+IntToStr(S)+'>');
+  end;
+  // writeln('TestSmallIntToggleBit: OK');
+end;
+
+
+Function TestSmallIntClearBit : string;
+var
+  Index: TSmallIntBitIndex;
+  S: SmallInt;
+const
+  Expected: array[TSmallIntBitIndex] of SmallInt = (
+    SmallInt($FFFE),SmallInt($FFFD),SmallInt($FFFB),SmallInt($FFF7),
+    SmallInt($FFEF),SmallInt($FFDF),SmallInt($FFBF),SmallInt($FF7F),
+    SmallInt($FEFF),SmallInt($FDFF),SmallInt($FBFF),SmallInt($F7FF),
+    SmallInt($EFFF),SmallInt($DFFF),SmallInt($BFFF),SmallInt($7FFF));
+begin
+  // writeln('TestSmallIntClearBit Start');
+  for Index in TSmallIntBitIndex do
+  begin
+    S := SmallInt($FFFF);
+    S.ClearBit(Index);
+    if S <> Expected[Index] then
+      Exit('Bit '+IntToStr(Index)+': expected <'+IntToStr(Expected[Index])+'> got <'+IntToStr(S)+'>');
+  end;
+  // writeln('TestSmallIntClearBit: OK');
+end;
+
+
+Function TestSmallIntTestBit : string;
+var
+  Index: TSmallIntBitIndex;
+  S: SmallInt;
+const
+  Expected: array[TSmallIntBitIndex] of Boolean = (True,False,True,False,True,False,True,False,
+                                                   True,False,True,False,True,False,True,False);
+begin
+  // writeln('TestSmallIntTestBit Start');
+  S := SMallInt($5555);
+  for Index in TSmallIntBitIndex do
+  begin
+    if S.TestBit(Index) <> Expected[Index] then
+      Exit('Bit '+IntToStr(Index)+': expected <'+BoolToStr(Expected[Index])+'> got <'+BoolToStr(S.TestBit(Index))+'>');
+  end;
+  // writeln('TestSmallIntTestBit: OK');
+end;
+
+
+Function TestCardinalSetBit : string;
+var
+  Index: TCardinalBitIndex;
+  C: Cardinal;
+const
+  Expected: array[TCardinalBitIndex] of Cardinal = (
+    $00000001,$00000003,$00000007,$0000000F,
+    $0000001F,$0000003F,$0000007F,$000000FF,
+    $000001FF,$000003FF,$000007FF,$00000FFF,
+    $00001FFF,$00003FFF,$00007FFF,$0000FFFF,
+    $0001FFFF,$0003FFFF,$0007FFFF,$000FFFFF,
+    $001FFFFF,$003FFFFF,$007FFFFF,$00FFFFFF,
+    $01FFFFFF,$03FFFFFF,$07FFFFFF,$0FFFFFFF,
+    $1FFFFFFF,$3FFFFFFF,$7FFFFFFF,$FFFFFFFF);
+begin
+  // writeln('TestCardinalSetBit Start');
+  C := 0;
+  for Index in TCardinalBitIndex do
+  begin
+    C.SetBit(Index);
+    if C <> Expected[Index] then
+      Exit('Bit '+IntToStr(Index)+': expected <'+IntToStr(Expected[Index])+'> got <'+IntToStr(C)+'>');
+  end;
+  // writeln('TestCardinalSetBit: OK');
+end;
+
+
+Function TestCardinalToggleBit : string;
+var
+  Index: TCardinalBitIndex;
+  C: Cardinal;
+const
+  Expected: array[TCardinalBitIndex] of Cardinal = (
+    $00000001,$00000003,$00000007,$0000000F,
+    $0000001F,$0000003F,$0000007F,$000000FF,
+    $000001FF,$000003FF,$000007FF,$00000FFF,
+    $00001FFF,$00003FFF,$00007FFF,$0000FFFF,
+    $0001FFFF,$0003FFFF,$0007FFFF,$000FFFFF,
+    $001FFFFF,$003FFFFF,$007FFFFF,$00FFFFFF,
+    $01FFFFFF,$03FFFFFF,$07FFFFFF,$0FFFFFFF,
+    $1FFFFFFF,$3FFFFFFF,$7FFFFFFF,$FFFFFFFF);
+begin
+  // writeln('TestCardinalToggleBit Start');
+  C := 0;
+  for Index in TCardinalBitIndex do
+  begin
+    C.ToggleBit(Index);
+    if C <> Expected[Index] then
+      Exit('Bit '+IntToStr(Index)+': expected <'+IntToStr(Expected[Index])+'> got <'+IntToStr(C)+'>');
+  end;
+  // writeln('TestCardinalToggleBit: OK');
+end;
+
+
+Function TestCardinalClearBit : string;
+var
+  Index: TCardinalBitIndex;
+  C: Cardinal;
+const
+  Expected: array[TCardinalBitIndex] of Cardinal = (
+    $FFFFFFFE,$FFFFFFFD,$FFFFFFFB,$FFFFFFF7,
+    $FFFFFFEF,$FFFFFFDF,$FFFFFFBF,$FFFFFF7F,
+    $FFFFFEFF,$FFFFFDFF,$FFFFFBFF,$FFFFF7FF,
+    $FFFFEFFF,$FFFFDFFF,$FFFFBFFF,$FFFF7FFF,
+    $FFFEFFFF,$FFFDFFFF,$FFFBFFFF,$FFF7FFFF,
+    $FFEFFFFF,$FFDFFFFF,$FFBFFFFF,$FF7FFFFF,
+    $FEFFFFFF,$FDFFFFFF,$FBFFFFFF,$F7FFFFFF,
+    $EFFFFFFF,$DFFFFFFF,$BFFFFFFF,$7FFFFFFF);
+begin
+  // writeln('TestCardinalClearBit Start');
+  for Index in TCardinalBitIndex do
+  begin
+    C := High(Cardinal);
+    C.ClearBit(Index);
+    if C <> Expected[Index] then
+      Exit('Bit '+IntToStr(Index)+': expected <'+IntToStr(Expected[Index])+'> got <'+IntToStr(C)+'>');
+  end;
+  // writeln('TestCardinalClearBit: OK');
+end;
+
+Function TestCardinalTestBit : string;
+var
+  Index: TCardinalBitIndex;
+  C: Cardinal;
+const
+  Expected: array[TCardinalBitIndex] of Boolean = (
+                                               True,False,True,False,True,False,True,False,
+                                               True,False,True,False,True,False,True,False,
+                                               True,False,True,False,True,False,True,False,
+                                               True,False,True,False,True,False,True,False);
+begin
+  // writeln('TestCardinalTestBit Start');
+  C := $55555555;
+  for Index in TCardinalBitIndex do
+  begin
+    if C.TestBit(Index) <> Expected[Index] then
+      Exit('Bit '+IntToStr(Index)+': expected <'+BoolToStr(Expected[Index])+'> got <'+BoolToStr(C.TestBit(Index))+'>');
+  end;
+  // writeln('TestCardinalTestBit: OK');
+end;
+
+
+Function TestLongintSetBit : string;
+
+var
+  Index: TLongintBitIndex;
+  L: Longint;
+
+const
+  Expected: array[TLongintBitIndex] of Longint = (
+    Longint($00000001),Longint($00000003),Longint($00000007),Longint($0000000F),
+    Longint($0000001F),Longint($0000003F),Longint($0000007F),Longint($000000FF),
+    Longint($000001FF),Longint($000003FF),Longint($000007FF),Longint($00000FFF),
+    Longint($00001FFF),Longint($00003FFF),Longint($00007FFF),Longint($0000FFFF),
+    Longint($0001FFFF),Longint($0003FFFF),Longint($0007FFFF),Longint($000FFFFF),
+    Longint($001FFFFF),Longint($003FFFFF),Longint($007FFFFF),Longint($00FFFFFF),
+    Longint($01FFFFFF),Longint($03FFFFFF),Longint($07FFFFFF),Longint($0FFFFFFF),
+    Longint($1FFFFFFF),Longint($3FFFFFFF),Longint($7FFFFFFF),Longint($FFFFFFFF));
+
+begin
+  // writeln('TestLongintSetBit Start');
+  L := 0;
+  for Index in TLongintBitIndex do
+  begin
+    L.SetBit(Index);
+    if L <> Expected[Index] then
+      Exit('Bit '+IntToStr(Index)+': expected <'+IntToStr(Expected[Index])+'> got <'+IntToStr(L)+'>');
+  end;
+  // writeln('TestLongintSetBit: OK');
+end;
+
+
+Function TestLongintToggleBit : string;
+var
+  Index: TLongintBitIndex;
+  L: Longint;
+const
+  Expected: array[TLongintBitIndex] of Longint = (
+    Longint($00000001),Longint($00000003),Longint($00000007),Longint($0000000F),
+    Longint($0000001F),Longint($0000003F),Longint($0000007F),Longint($000000FF),
+    Longint($000001FF),Longint($000003FF),Longint($000007FF),Longint($00000FFF),
+    Longint($00001FFF),Longint($00003FFF),Longint($00007FFF),Longint($0000FFFF),
+    Longint($0001FFFF),Longint($0003FFFF),Longint($0007FFFF),Longint($000FFFFF),
+    Longint($001FFFFF),Longint($003FFFFF),Longint($007FFFFF),Longint($00FFFFFF),
+    Longint($01FFFFFF),Longint($03FFFFFF),Longint($07FFFFFF),Longint($0FFFFFFF),
+    Longint($1FFFFFFF),Longint($3FFFFFFF),Longint($7FFFFFFF),Longint($FFFFFFFF));
+
+begin
+  // writeln('TestLongintToggleBit Start');
+  L := 0;
+  for Index in TLongintBitIndex do
+  begin
+    L.ToggleBit(Index);
+    if L <> Expected[Index] then
+      Exit('Bit '+IntToStr(Index)+': expected <'+IntToStr(Expected[Index])+'> got <'+IntToStr(L)+'>');
+  end;
+  // writeln('TestLongintToggleBit: OK');
+end;
+
+
+Function TestLongintClearBit : string;
+var
+  Index: TLongintBitIndex;
+  L: Longint;
+const
+  Expected: array[TLongintBitIndex] of Longint = (
+    Longint($FFFFFFFE),Longint($FFFFFFFD),Longint($FFFFFFFB),Longint($FFFFFFF7),
+    Longint($FFFFFFEF),Longint($FFFFFFDF),Longint($FFFFFFBF),Longint($FFFFFF7F),
+    Longint($FFFFFEFF),Longint($FFFFFDFF),Longint($FFFFFBFF),Longint($FFFFF7FF),
+    Longint($FFFFEFFF),Longint($FFFFDFFF),Longint($FFFFBFFF),Longint($FFFF7FFF),
+    Longint($FFFEFFFF),Longint($FFFDFFFF),Longint($FFFBFFFF),Longint($FFF7FFFF),
+    Longint($FFEFFFFF),Longint($FFDFFFFF),Longint($FFBFFFFF),Longint($FF7FFFFF),
+    Longint($FEFFFFFF),Longint($FDFFFFFF),Longint($FBFFFFFF),Longint($F7FFFFFF),
+    Longint($EFFFFFFF),Longint($DFFFFFFF),Longint($BFFFFFFF),Longint($7FFFFFFF));
+
+begin
+  // writeln('TestLongintClearBit Start');
+  for Index in TLongintBitIndex do
+  begin
+    L := Longint($FFFFFFFF);
+    L.ClearBit(Index);
+    if L <> Expected[Index] then
+      Exit('Bit '+IntToStr(Index)+': expected <'+IntToStr(Expected[Index])+'> got <'+IntToStr(L)+'>');
+  end;
+  // writeln('TestLongintClearBit: OK');
+end;
+
+
+Function TestLongintTestBit : string;
+
+var
+  Index: TLongintBitIndex;
+  L: Longint;
+const
+  Expected: array[TLongintBitIndex] of Boolean = (
+                                               True,False,True,False,True,False,True,False,
+                                               True,False,True,False,True,False,True,False,
+                                               True,False,True,False,True,False,True,False,
+                                               True,False,True,False,True,False,True,False);
+begin
+  // writeln('TestLongintTestBit Start');
+  L := Longint($55555555);
+  for Index in TLongintBitIndex do
+  begin
+    if L.TestBit(Index) <> Expected[Index] then
+      Exit('Bit '+IntToStr(Index)+': expected <'+BoolToStr(Expected[Index])+'> got <'+BoolToStr(L.TestBit(Index))+'>');
+  end;
+  // writeln('TestLongintTestBit: OK');
+end;
+
+
+
+Function TestQWordSetBit : string;
+var
+  Index: TQWordBitIndex;
+  Q: QWord;
+const
+  Expected: array[TQWordBitIndex] of QWord = (
+    $0000000000000001,$0000000000000003,$0000000000000007,$000000000000000F,
+    $000000000000001F,$000000000000003F,$000000000000007F,$00000000000000FF,
+    $00000000000001FF,$00000000000003FF,$00000000000007FF,$0000000000000FFF,
+    $0000000000001FFF,$0000000000003FFF,$0000000000007FFF,$000000000000FFFF,
+    $000000000001FFFF,$000000000003FFFF,$000000000007FFFF,$00000000000FFFFF,
+    $00000000001FFFFF,$00000000003FFFFF,$00000000007FFFFF,$0000000000FFFFFF,
+    $0000000001FFFFFF,$0000000003FFFFFF,$0000000007FFFFFF,$000000000FFFFFFF,
+    $000000001FFFFFFF,$000000003FFFFFFF,$000000007FFFFFFF,$00000000FFFFFFFF,
+    $00000001FFFFFFFF,$00000003FFFFFFFF,$00000007FFFFFFFF,$0000000FFFFFFFFF,
+    $0000001FFFFFFFFF,$0000003FFFFFFFFF,$0000007FFFFFFFFF,$000000FFFFFFFFFF,
+    $000001FFFFFFFFFF,$000003FFFFFFFFFF,$000007FFFFFFFFFF,$00000FFFFFFFFFFF,
+    $00001FFFFFFFFFFF,$00003FFFFFFFFFFF,$00007FFFFFFFFFFF,$0000FFFFFFFFFFFF,
+    $0001FFFFFFFFFFFF,$0003FFFFFFFFFFFF,$0007FFFFFFFFFFFF,$000FFFFFFFFFFFFF,
+    $001FFFFFFFFFFFFF,$003FFFFFFFFFFFFF,$007FFFFFFFFFFFFF,$00FFFFFFFFFFFFFF,
+    $01FFFFFFFFFFFFFF,$03FFFFFFFFFFFFFF,$07FFFFFFFFFFFFFF,$0FFFFFFFFFFFFFFF,
+    $1FFFFFFFFFFFFFFF,$3FFFFFFFFFFFFFFF,$7FFFFFFFFFFFFFFF,QWORD($FFFFFFFFFFFFFFFF));
+begin
+  // writeln('TestQWordSetBit Start');
+  Q := 0;
+  for Index in TQWordBitIndex do
+  begin
+    Q.SetBit(Index);
+    if Q <> Expected[Index] then
+      Exit('Bit '+IntToStr(Index)+': expected <'+IntToStr(Expected[Index])+'> got <'+IntToStr(Q)+'>');
+  end;
+  // writeln('TestQWordSetBit: OK');
+end;
+
+
+Function TestQWordToggleBit : string;
+var
+  Index: TQWordBitIndex;
+  Q: QWord;
+const
+  Expected: array[TQWordBitIndex] of QWord = (
+    $0000000000000001,$0000000000000003,$0000000000000007,$000000000000000F,
+    $000000000000001F,$000000000000003F,$000000000000007F,$00000000000000FF,
+    $00000000000001FF,$00000000000003FF,$00000000000007FF,$0000000000000FFF,
+    $0000000000001FFF,$0000000000003FFF,$0000000000007FFF,$000000000000FFFF,
+    $000000000001FFFF,$000000000003FFFF,$000000000007FFFF,$00000000000FFFFF,
+    $00000000001FFFFF,$00000000003FFFFF,$00000000007FFFFF,$0000000000FFFFFF,
+    $0000000001FFFFFF,$0000000003FFFFFF,$0000000007FFFFFF,$000000000FFFFFFF,
+    $000000001FFFFFFF,$000000003FFFFFFF,$000000007FFFFFFF,$00000000FFFFFFFF,
+    $00000001FFFFFFFF,$00000003FFFFFFFF,$00000007FFFFFFFF,$0000000FFFFFFFFF,
+    $0000001FFFFFFFFF,$0000003FFFFFFFFF,$0000007FFFFFFFFF,$000000FFFFFFFFFF,
+    $000001FFFFFFFFFF,$000003FFFFFFFFFF,$000007FFFFFFFFFF,$00000FFFFFFFFFFF,
+    $00001FFFFFFFFFFF,$00003FFFFFFFFFFF,$00007FFFFFFFFFFF,$0000FFFFFFFFFFFF,
+    $0001FFFFFFFFFFFF,$0003FFFFFFFFFFFF,$0007FFFFFFFFFFFF,$000FFFFFFFFFFFFF,
+    $001FFFFFFFFFFFFF,$003FFFFFFFFFFFFF,$007FFFFFFFFFFFFF,$00FFFFFFFFFFFFFF,
+    $01FFFFFFFFFFFFFF,$03FFFFFFFFFFFFFF,$07FFFFFFFFFFFFFF,$0FFFFFFFFFFFFFFF,
+    $1FFFFFFFFFFFFFFF,$3FFFFFFFFFFFFFFF,$7FFFFFFFFFFFFFFF,QWORD($FFFFFFFFFFFFFFFF));
+begin
+  // writeln('TestQWordToggleBit Start');
+  Q := 0;
+  for Index in TQWordBitIndex do
+  begin
+    Q.ToggleBit(Index);
+    if Q <> Expected[Index] then
+      Exit('Bit '+IntToStr(Index)+': expected <'+IntToStr(Expected[Index])+'> got <'+IntToStr(Q)+'>');
+  end;
+  // writeln('TestQWordToggleBit: OK');
+end;
+
+
+Function TestQWordClearBit : string;
+var
+  Index: TQWordBitIndex;
+  Q: QWord;
+const
+  Expected: array[TQWordBitIndex] of QWord = (
+    QWord($FFFFFFFFFFFFFFFE),QWord($FFFFFFFFFFFFFFFD),QWord($FFFFFFFFFFFFFFFB),QWord($FFFFFFFFFFFFFFF7),
+    QWord($FFFFFFFFFFFFFFEF),QWord($FFFFFFFFFFFFFFDF),QWord($FFFFFFFFFFFFFFBF),QWord($FFFFFFFFFFFFFF7F),
+    QWord($FFFFFFFFFFFFFEFF),QWord($FFFFFFFFFFFFFDFF),QWord($FFFFFFFFFFFFFBFF),QWord($FFFFFFFFFFFFF7FF),
+    QWord($FFFFFFFFFFFFEFFF),QWord($FFFFFFFFFFFFDFFF),QWord($FFFFFFFFFFFFBFFF),QWord($FFFFFFFFFFFF7FFF),
+    QWord($FFFFFFFFFFFEFFFF),QWord($FFFFFFFFFFFDFFFF),QWord($FFFFFFFFFFFBFFFF),QWord($FFFFFFFFFFF7FFFF),
+    QWord($FFFFFFFFFFEFFFFF),QWord($FFFFFFFFFFDFFFFF),QWord($FFFFFFFFFFBFFFFF),QWord($FFFFFFFFFF7FFFFF),
+    QWord($FFFFFFFFFEFFFFFF),QWord($FFFFFFFFFDFFFFFF),QWord($FFFFFFFFFBFFFFFF),QWord($FFFFFFFFF7FFFFFF),
+    QWord($FFFFFFFFEFFFFFFF),QWord($FFFFFFFFDFFFFFFF),QWord($FFFFFFFFBFFFFFFF),QWord($FFFFFFFF7FFFFFFF),
+    QWord($FFFFFFFEFFFFFFFF),QWord($FFFFFFFDFFFFFFFF),QWord($FFFFFFFBFFFFFFFF),QWord($FFFFFFF7FFFFFFFF),
+    QWord($FFFFFFEFFFFFFFFF),QWord($FFFFFFDFFFFFFFFF),QWord($FFFFFFBFFFFFFFFF),QWord($FFFFFF7FFFFFFFFF),
+    QWord($FFFFFEFFFFFFFFFF),QWord($FFFFFDFFFFFFFFFF),QWord($FFFFFBFFFFFFFFFF),QWord($FFFFF7FFFFFFFFFF),
+    QWord($FFFFEFFFFFFFFFFF),QWord($FFFFDFFFFFFFFFFF),QWord($FFFFBFFFFFFFFFFF),QWord($FFFF7FFFFFFFFFFF),
+    QWord($FFFEFFFFFFFFFFFF),QWord($FFFDFFFFFFFFFFFF),QWord($FFFBFFFFFFFFFFFF),QWord($FFF7FFFFFFFFFFFF),
+    QWord($FFEFFFFFFFFFFFFF),QWord($FFDFFFFFFFFFFFFF),QWord($FFBFFFFFFFFFFFFF),QWord($FF7FFFFFFFFFFFFF),
+    QWord($FEFFFFFFFFFFFFFF),QWord($FDFFFFFFFFFFFFFF),QWord($FBFFFFFFFFFFFFFF),QWord($F7FFFFFFFFFFFFFF),
+    QWord($EFFFFFFFFFFFFFFF),QWord($DFFFFFFFFFFFFFFF),QWord($BFFFFFFFFFFFFFFF),QWord($7FFFFFFFFFFFFFFF));
+begin
+  // writeln('TestQWordClearBit Start');
+  for Index in TQWordBitIndex do
+  begin
+    Q := High(QWord);
+    Q.ClearBit(Index);
+    if Q <> Expected[Index] then
+      Exit('Bit '+IntToStr(Index)+': expected <'+IntToStr(Expected[Index])+'> got <'+IntToStr(Q)+'>');
+  end;
+  // writeln('TestQWordClearBit: OK');
+end;
+
+
+Function TestQWordTestBit : string;
+var
+  Index: TQWordBitIndex;
+  Q: QWord;
+const
+  Expected: array[TQWordBitIndex] of Boolean = (True,False,True,False,True,False,True,False,
+                                                True,False,True,False,True,False,True,False,
+                                                True,False,True,False,True,False,True,False,
+                                                True,False,True,False,True,False,True,False,
+                                                True,False,True,False,True,False,True,False,
+                                                True,False,True,False,True,False,True,False,
+                                                True,False,True,False,True,False,True,False,
+                                                True,False,True,False,True,False,True,False);
+begin
+  // writeln('TestQWordTestBit Start');
+  Q := $5555555555555555;
+  for Index in TQWordBitIndex do
+  begin
+    if Q.TestBit(Index) <> Expected[Index] then
+      Exit('Bit '+IntToStr(Index)+': expected <'+BoolToStr(Expected[Index])+'> got <'+BoolToStr(Q.TestBit(Index))+'>');
+  end;
+  // writeln('TestQWordTestBit: OK');
+end;
+
+
+
+Function TestInt64SetBit : string;
+var
+  Index: TInt64BitIndex;
+  I64: Int64;
+const
+  Expected: array[TInt64BitIndex] of Int64 = (
+    Int64($0000000000000001),Int64($0000000000000003),Int64($0000000000000007),Int64($000000000000000F),
+    Int64($000000000000001F),Int64($000000000000003F),Int64($000000000000007F),Int64($00000000000000FF),
+    Int64($00000000000001FF),Int64($00000000000003FF),Int64($00000000000007FF),Int64($0000000000000FFF),
+    Int64($0000000000001FFF),Int64($0000000000003FFF),Int64($0000000000007FFF),Int64($000000000000FFFF),
+    Int64($000000000001FFFF),Int64($000000000003FFFF),Int64($000000000007FFFF),Int64($00000000000FFFFF),
+    Int64($00000000001FFFFF),Int64($00000000003FFFFF),Int64($00000000007FFFFF),Int64($0000000000FFFFFF),
+    Int64($0000000001FFFFFF),Int64($0000000003FFFFFF),Int64($0000000007FFFFFF),Int64($000000000FFFFFFF),
+    Int64($000000001FFFFFFF),Int64($000000003FFFFFFF),Int64($000000007FFFFFFF),Int64($00000000FFFFFFFF),
+    Int64($00000001FFFFFFFF),Int64($00000003FFFFFFFF),Int64($00000007FFFFFFFF),Int64($0000000FFFFFFFFF),
+    Int64($0000001FFFFFFFFF),Int64($0000003FFFFFFFFF),Int64($0000007FFFFFFFFF),Int64($000000FFFFFFFFFF),
+    Int64($000001FFFFFFFFFF),Int64($000003FFFFFFFFFF),Int64($000007FFFFFFFFFF),Int64($00000FFFFFFFFFFF),
+    Int64($00001FFFFFFFFFFF),Int64($00003FFFFFFFFFFF),Int64($00007FFFFFFFFFFF),Int64($0000FFFFFFFFFFFF),
+    Int64($0001FFFFFFFFFFFF),Int64($0003FFFFFFFFFFFF),Int64($0007FFFFFFFFFFFF),Int64($000FFFFFFFFFFFFF),
+    Int64($001FFFFFFFFFFFFF),Int64($003FFFFFFFFFFFFF),Int64($007FFFFFFFFFFFFF),Int64($00FFFFFFFFFFFFFF),
+    Int64($01FFFFFFFFFFFFFF),Int64($03FFFFFFFFFFFFFF),Int64($07FFFFFFFFFFFFFF),Int64($0FFFFFFFFFFFFFFF),
+    Int64($1FFFFFFFFFFFFFFF),Int64($3FFFFFFFFFFFFFFF),Int64($7FFFFFFFFFFFFFFF),Int64($FFFFFFFFFFFFFFFF));
+begin
+  // writeln('TestInt64SetBit Start');
+  I64 := 0;
+  for Index in TInt64BitIndex do
+  begin
+    I64.SetBit(Index);
+    if I64 <> Expected[Index] then
+      Exit('Bit '+IntToStr(Index)+': expected <'+IntToStr(Expected[Index])+'> got <'+IntToStr(I64)+'>');
+  end;
+  // writeln('TestInt64SetBit: OK');
+end;
+
+
+Function TestInt64ToggleBit : string;
+var
+  Index: TInt64BitIndex;
+  I64: Int64;
+const
+  Expected: array[TInt64BitIndex] of Int64 = (
+  Int64($0000000000000001),Int64($0000000000000003),Int64($0000000000000007),Int64($000000000000000F),
+  Int64($000000000000001F),Int64($000000000000003F),Int64($000000000000007F),Int64($00000000000000FF),
+  Int64($00000000000001FF),Int64($00000000000003FF),Int64($00000000000007FF),Int64($0000000000000FFF),
+  Int64($0000000000001FFF),Int64($0000000000003FFF),Int64($0000000000007FFF),Int64($000000000000FFFF),
+  Int64($000000000001FFFF),Int64($000000000003FFFF),Int64($000000000007FFFF),Int64($00000000000FFFFF),
+  Int64($00000000001FFFFF),Int64($00000000003FFFFF),Int64($00000000007FFFFF),Int64($0000000000FFFFFF),
+  Int64($0000000001FFFFFF),Int64($0000000003FFFFFF),Int64($0000000007FFFFFF),Int64($000000000FFFFFFF),
+  Int64($000000001FFFFFFF),Int64($000000003FFFFFFF),Int64($000000007FFFFFFF),Int64($00000000FFFFFFFF),
+  Int64($00000001FFFFFFFF),Int64($00000003FFFFFFFF),Int64($00000007FFFFFFFF),Int64($0000000FFFFFFFFF),
+  Int64($0000001FFFFFFFFF),Int64($0000003FFFFFFFFF),Int64($0000007FFFFFFFFF),Int64($000000FFFFFFFFFF),
+  Int64($000001FFFFFFFFFF),Int64($000003FFFFFFFFFF),Int64($000007FFFFFFFFFF),Int64($00000FFFFFFFFFFF),
+  Int64($00001FFFFFFFFFFF),Int64($00003FFFFFFFFFFF),Int64($00007FFFFFFFFFFF),Int64($0000FFFFFFFFFFFF),
+  Int64($0001FFFFFFFFFFFF),Int64($0003FFFFFFFFFFFF),Int64($0007FFFFFFFFFFFF),Int64($000FFFFFFFFFFFFF),
+  Int64($001FFFFFFFFFFFFF),Int64($003FFFFFFFFFFFFF),Int64($007FFFFFFFFFFFFF),Int64($00FFFFFFFFFFFFFF),
+  Int64($01FFFFFFFFFFFFFF),Int64($03FFFFFFFFFFFFFF),Int64($07FFFFFFFFFFFFFF),Int64($0FFFFFFFFFFFFFFF),
+  Int64($1FFFFFFFFFFFFFFF),Int64($3FFFFFFFFFFFFFFF),Int64($7FFFFFFFFFFFFFFF),Int64($FFFFFFFFFFFFFFFF));
+begin
+  // writeln('TestInt64ToggleBit Start');
+  I64 := 0;
+  for Index in TInt64BitIndex do
+  begin
+    I64.ToggleBit(Index);
+    if I64 <> Expected[Index] then
+      Exit('Bit '+IntToStr(Index)+': expected <'+IntToStr(Expected[Index])+'> got <'+IntToStr(I64)+'>');
+  end;
+  // writeln('TestInt64ToggleBit: OK');
+end;
+
+
+Function TestInt64ClearBit : string;
+var
+  Index: TInt64BitIndex;
+  I64: Int64;
+const
+  Expected: array[TInt64BitIndex] of Int64 = (
+    Int64($FFFFFFFFFFFFFFFE),Int64($FFFFFFFFFFFFFFFD),Int64($FFFFFFFFFFFFFFFB),Int64($FFFFFFFFFFFFFFF7),
+    Int64($FFFFFFFFFFFFFFEF),Int64($FFFFFFFFFFFFFFDF),Int64($FFFFFFFFFFFFFFBF),Int64($FFFFFFFFFFFFFF7F),
+    Int64($FFFFFFFFFFFFFEFF),Int64($FFFFFFFFFFFFFDFF),Int64($FFFFFFFFFFFFFBFF),Int64($FFFFFFFFFFFFF7FF),
+    Int64($FFFFFFFFFFFFEFFF),Int64($FFFFFFFFFFFFDFFF),Int64($FFFFFFFFFFFFBFFF),Int64($FFFFFFFFFFFF7FFF),
+    Int64($FFFFFFFFFFFEFFFF),Int64($FFFFFFFFFFFDFFFF),Int64($FFFFFFFFFFFBFFFF),Int64($FFFFFFFFFFF7FFFF),
+    Int64($FFFFFFFFFFEFFFFF),Int64($FFFFFFFFFFDFFFFF),Int64($FFFFFFFFFFBFFFFF),Int64($FFFFFFFFFF7FFFFF),
+    Int64($FFFFFFFFFEFFFFFF),Int64($FFFFFFFFFDFFFFFF),Int64($FFFFFFFFFBFFFFFF),Int64($FFFFFFFFF7FFFFFF),
+    Int64($FFFFFFFFEFFFFFFF),Int64($FFFFFFFFDFFFFFFF),Int64($FFFFFFFFBFFFFFFF),Int64($FFFFFFFF7FFFFFFF),
+    Int64($FFFFFFFEFFFFFFFF),Int64($FFFFFFFDFFFFFFFF),Int64($FFFFFFFBFFFFFFFF),Int64($FFFFFFF7FFFFFFFF),
+    Int64($FFFFFFEFFFFFFFFF),Int64($FFFFFFDFFFFFFFFF),Int64($FFFFFFBFFFFFFFFF),Int64($FFFFFF7FFFFFFFFF),
+    Int64($FFFFFEFFFFFFFFFF),Int64($FFFFFDFFFFFFFFFF),Int64($FFFFFBFFFFFFFFFF),Int64($FFFFF7FFFFFFFFFF),
+    Int64($FFFFEFFFFFFFFFFF),Int64($FFFFDFFFFFFFFFFF),Int64($FFFFBFFFFFFFFFFF),Int64($FFFF7FFFFFFFFFFF),
+    Int64($FFFEFFFFFFFFFFFF),Int64($FFFDFFFFFFFFFFFF),Int64($FFFBFFFFFFFFFFFF),Int64($FFF7FFFFFFFFFFFF),
+    Int64($FFEFFFFFFFFFFFFF),Int64($FFDFFFFFFFFFFFFF),Int64($FFBFFFFFFFFFFFFF),Int64($FF7FFFFFFFFFFFFF),
+    Int64($FEFFFFFFFFFFFFFF),Int64($FDFFFFFFFFFFFFFF),Int64($FBFFFFFFFFFFFFFF),Int64($F7FFFFFFFFFFFFFF),
+    Int64($EFFFFFFFFFFFFFFF),Int64($DFFFFFFFFFFFFFFF),Int64($BFFFFFFFFFFFFFFF),Int64($7FFFFFFFFFFFFFFF));
+begin
+  // writeln('TestInt64ClearBit Start');
+  for Index in TInt64BitIndex do
+  begin
+    I64 := Int64($FFFFFFFFFFFFFFFF);
+    I64.ClearBit(Index);
+    if I64 <> Expected[Index] then
+      Exit('Bit '+IntToStr(Index)+': expected <'+IntToStr(Expected[Index])+'> got <'+IntToStr(I64)+'>');
+  end;
+  // writeln('TestInt64ClearBit: OK');
+end;
+
+
+Function TestInt64TestBit : string;
+var
+  Index: TInt64BitIndex;
+  I64: Int64;
+const
+  Expected: array[TInt64BitIndex] of Boolean = (True,False,True,False,True,False,True,False,
+                                                True,False,True,False,True,False,True,False,
+                                                True,False,True,False,True,False,True,False,
+                                                True,False,True,False,True,False,True,False,
+                                                True,False,True,False,True,False,True,False,
+                                                True,False,True,False,True,False,True,False,
+                                                True,False,True,False,True,False,True,False,
+                                                True,False,True,False,True,False,True,False);
+begin
+  // writeln('TestInt64TestBit Start');
+  I64 := Int64($5555555555555555);
+  for Index in TInt64BitIndex do
+  begin
+    if I64.TestBit(Index) <> Expected[Index] then
+      Exit('Bit '+IntToStr(Index)+': expected <'+BoolToStr(Expected[Index])+'> got <'+BoolToStr(I64.TestBit(Index))+'>');
+  end;
+  // writeln('TestInt64TestBit: OK');
+end;
+
+{$if SizeOf(NativeUint)=SizeOf(QWord)}
+{$define IsQWord}
+{$endif}
+{$if SizeOf(NativeUint)=SizeOf(DWord)}
+{$define IsDWord}
+{$endif}
+{$if SizeOf(NativeUint)=SizeOf(Word)}
+{$define IsWord}
+{$endif}
+
+
+
+Function TestNativeUIntSetBit : string;
+var
+  Index: TNativeUIntBitIndex;
+  NU: NativeUInt;
+const
+  {$ifdef IsQWord}
+  Expected: array[TNativeUIntBitIndex] of NativeUInt = (
+    $0000000000000001,$0000000000000003,$0000000000000007,$000000000000000F,
+    $000000000000001F,$000000000000003F,$000000000000007F,$00000000000000FF,
+    $00000000000001FF,$00000000000003FF,$00000000000007FF,$0000000000000FFF,
+    $0000000000001FFF,$0000000000003FFF,$0000000000007FFF,$000000000000FFFF,
+    $000000000001FFFF,$000000000003FFFF,$000000000007FFFF,$00000000000FFFFF,
+    $00000000001FFFFF,$00000000003FFFFF,$00000000007FFFFF,$0000000000FFFFFF,
+    $0000000001FFFFFF,$0000000003FFFFFF,$0000000007FFFFFF,$000000000FFFFFFF,
+    $000000001FFFFFFF,$000000003FFFFFFF,$000000007FFFFFFF,$00000000FFFFFFFF,
+    $00000001FFFFFFFF,$00000003FFFFFFFF,$00000007FFFFFFFF,$0000000FFFFFFFFF,
+    $0000001FFFFFFFFF,$0000003FFFFFFFFF,$0000007FFFFFFFFF,$000000FFFFFFFFFF,
+    $000001FFFFFFFFFF,$000003FFFFFFFFFF,$000007FFFFFFFFFF,$00000FFFFFFFFFFF,
+    $00001FFFFFFFFFFF,$00003FFFFFFFFFFF,$00007FFFFFFFFFFF,$0000FFFFFFFFFFFF,
+    $0001FFFFFFFFFFFF,$0003FFFFFFFFFFFF,$0007FFFFFFFFFFFF,$000FFFFFFFFFFFFF,
+    $001FFFFFFFFFFFFF,$003FFFFFFFFFFFFF,$007FFFFFFFFFFFFF,$00FFFFFFFFFFFFFF,
+    $01FFFFFFFFFFFFFF,$03FFFFFFFFFFFFFF,$07FFFFFFFFFFFFFF,$0FFFFFFFFFFFFFFF,
+    $1FFFFFFFFFFFFFFF,$3FFFFFFFFFFFFFFF,$7FFFFFFFFFFFFFFF,NativeUInt($FFFFFFFFFFFFFFFF));
+  {$endif}
+  {$ifdef IsDWord}
+  Expected: array[TNativeUIntBitIndex] of NativeUInt = (
+    $00000001,$00000003,$00000007,$0000000F,
+    $0000001F,$0000003F,$0000007F,$000000FF,
+    $000001FF,$000003FF,$000007FF,$00000FFF,
+    $00001FFF,$00003FFF,$00007FFF,$0000FFFF,
+    $0001FFFF,$0003FFFF,$0007FFFF,$000FFFFF,
+    $001FFFFF,$003FFFFF,$007FFFFF,$00FFFFFF,
+    $01FFFFFF,$03FFFFFF,$07FFFFFF,$0FFFFFFF,
+    $1FFFFFFF,$3FFFFFFF,$7FFFFFFF,$FFFFFFFF);
+  {$endif}
+  {$ifdef IsWord}
+  Expected: array[TNativeUIntBitIndex] of NativeUInt = (
+    $0001,$0003,$0007,$000F,
+    $001F,$003F,$007F,$00FF,
+    $01FF,$03FF,$07FF,$0FFF,
+    $1FFF,$3FFF,$7FFF,$FFFF);
+  {$endif}
+begin
+  // writeln('TestNativeUIntSetBit Start');
+  NU := 0;
+  for Index in TNativeUIntBitIndex do
+  begin
+    NU.SetBit(Index);
+    if NU <> Expected[Index] then
+      Exit('Bit '+IntToStr(Index)+': expected <'+IntToStr(Expected[Index])+'> got <'+IntToStr(NU)+'>');
+  end;
+  // writeln('TestNativeUIntSetBit: OK');
+end;
+
+
+Function TestNativeUIntToggleBit : string;
+var
+  Index: TNativeUIntBitIndex;
+  NU: NativeUInt;
+const
+  {$ifdef IsQWord}
+  Expected: array[TNativeUIntBitIndex] of NativeUInt = (
+    $0000000000000001,$0000000000000003,$0000000000000007,$000000000000000F,
+    $000000000000001F,$000000000000003F,$000000000000007F,$00000000000000FF,
+    $00000000000001FF,$00000000000003FF,$00000000000007FF,$0000000000000FFF,
+    $0000000000001FFF,$0000000000003FFF,$0000000000007FFF,$000000000000FFFF,
+    $000000000001FFFF,$000000000003FFFF,$000000000007FFFF,$00000000000FFFFF,
+    $00000000001FFFFF,$00000000003FFFFF,$00000000007FFFFF,$0000000000FFFFFF,
+    $0000000001FFFFFF,$0000000003FFFFFF,$0000000007FFFFFF,$000000000FFFFFFF,
+    $000000001FFFFFFF,$000000003FFFFFFF,$000000007FFFFFFF,$00000000FFFFFFFF,
+    $00000001FFFFFFFF,$00000003FFFFFFFF,$00000007FFFFFFFF,$0000000FFFFFFFFF,
+    $0000001FFFFFFFFF,$0000003FFFFFFFFF,$0000007FFFFFFFFF,$000000FFFFFFFFFF,
+    $000001FFFFFFFFFF,$000003FFFFFFFFFF,$000007FFFFFFFFFF,$00000FFFFFFFFFFF,
+    $00001FFFFFFFFFFF,$00003FFFFFFFFFFF,$00007FFFFFFFFFFF,$0000FFFFFFFFFFFF,
+    $0001FFFFFFFFFFFF,$0003FFFFFFFFFFFF,$0007FFFFFFFFFFFF,$000FFFFFFFFFFFFF,
+    $001FFFFFFFFFFFFF,$003FFFFFFFFFFFFF,$007FFFFFFFFFFFFF,$00FFFFFFFFFFFFFF,
+    $01FFFFFFFFFFFFFF,$03FFFFFFFFFFFFFF,$07FFFFFFFFFFFFFF,$0FFFFFFFFFFFFFFF,
+    $1FFFFFFFFFFFFFFF,$3FFFFFFFFFFFFFFF,$7FFFFFFFFFFFFFFF,NativeUInt($FFFFFFFFFFFFFFFF));
+  {$endif}
+  {$ifdef IsDWord}
+  Expected: array[TNativeUIntBitIndex] of NativeUInt = (
+    $00000001,$00000003,$00000007,$0000000F,
+    $0000001F,$0000003F,$0000007F,$000000FF,
+    $000001FF,$000003FF,$000007FF,$00000FFF,
+    $00001FFF,$00003FFF,$00007FFF,$0000FFFF,
+    $0001FFFF,$0003FFFF,$0007FFFF,$000FFFFF,
+    $001FFFFF,$003FFFFF,$007FFFFF,$00FFFFFF,
+    $01FFFFFF,$03FFFFFF,$07FFFFFF,$0FFFFFFF,
+    $1FFFFFFF,$3FFFFFFF,$7FFFFFFF,$FFFFFFFF);
+  {$endif}
+  {$ifdef IsWord}
+  Expected: array[TNativeUIntBitIndex] of NativeUInt = (
+    $0001,$0003,$0007,$000F,
+    $001F,$003F,$007F,$00FF,
+    $01FF,$03FF,$07FF,$0FFF,
+    $1FFF,$3FFF,$7FFF,$FFFF);
+  {$endif}
+begin
+  // writeln('TestNativeUIntToggleBit Start');
+  NU := 0;
+  for Index in TNativeUIntBitIndex do
+  begin
+    NU.ToggleBit(Index);
+    if NU <> Expected[Index] then
+      Exit('Bit '+IntToStr(Index)+': expected <'+IntToStr(Expected[Index])+'> got <'+IntToStr(NU)+'>');
+  end;
+  // writeln('TestNativeUIntToggleBit: OK');
+end;
+
+
+Function TestNativeUIntClearBit : string;
+var
+  Index: TNativeUIntBitIndex;
+  NU: NativeUInt;
+const
+  {$ifdef IsQWord}
+  Expected: array[TNativeUIntBitIndex] of NativeUInt = (
+    NativeUInt($FFFFFFFFFFFFFFFE),NativeUInt($FFFFFFFFFFFFFFFD),NativeUInt($FFFFFFFFFFFFFFFB),NativeUInt($FFFFFFFFFFFFFFF7),
+    NativeUInt($FFFFFFFFFFFFFFEF),NativeUInt($FFFFFFFFFFFFFFDF),NativeUInt($FFFFFFFFFFFFFFBF),NativeUInt($FFFFFFFFFFFFFF7F),
+    NativeUInt($FFFFFFFFFFFFFEFF),NativeUInt($FFFFFFFFFFFFFDFF),NativeUInt($FFFFFFFFFFFFFBFF),NativeUInt($FFFFFFFFFFFFF7FF),
+    NativeUInt($FFFFFFFFFFFFEFFF),NativeUInt($FFFFFFFFFFFFDFFF),NativeUInt($FFFFFFFFFFFFBFFF),NativeUInt($FFFFFFFFFFFF7FFF),
+    NativeUInt($FFFFFFFFFFFEFFFF),NativeUInt($FFFFFFFFFFFDFFFF),NativeUInt($FFFFFFFFFFFBFFFF),NativeUInt($FFFFFFFFFFF7FFFF),
+    NativeUInt($FFFFFFFFFFEFFFFF),NativeUInt($FFFFFFFFFFDFFFFF),NativeUInt($FFFFFFFFFFBFFFFF),NativeUInt($FFFFFFFFFF7FFFFF),
+    NativeUInt($FFFFFFFFFEFFFFFF),NativeUInt($FFFFFFFFFDFFFFFF),NativeUInt($FFFFFFFFFBFFFFFF),NativeUInt($FFFFFFFFF7FFFFFF),
+    NativeUInt($FFFFFFFFEFFFFFFF),NativeUInt($FFFFFFFFDFFFFFFF),NativeUInt($FFFFFFFFBFFFFFFF),NativeUInt($FFFFFFFF7FFFFFFF),
+    NativeUInt($FFFFFFFEFFFFFFFF),NativeUInt($FFFFFFFDFFFFFFFF),NativeUInt($FFFFFFFBFFFFFFFF),NativeUInt($FFFFFFF7FFFFFFFF),
+    NativeUInt($FFFFFFEFFFFFFFFF),NativeUInt($FFFFFFDFFFFFFFFF),NativeUInt($FFFFFFBFFFFFFFFF),NativeUInt($FFFFFF7FFFFFFFFF),
+    NativeUInt($FFFFFEFFFFFFFFFF),NativeUInt($FFFFFDFFFFFFFFFF),NativeUInt($FFFFFBFFFFFFFFFF),NativeUInt($FFFFF7FFFFFFFFFF),
+    NativeUInt($FFFFEFFFFFFFFFFF),NativeUInt($FFFFDFFFFFFFFFFF),NativeUInt($FFFFBFFFFFFFFFFF),NativeUInt($FFFF7FFFFFFFFFFF),
+    NativeUInt($FFFEFFFFFFFFFFFF),NativeUInt($FFFDFFFFFFFFFFFF),NativeUInt($FFFBFFFFFFFFFFFF),NativeUInt($FFF7FFFFFFFFFFFF),
+    NativeUInt($FFEFFFFFFFFFFFFF),NativeUInt($FFDFFFFFFFFFFFFF),NativeUInt($FFBFFFFFFFFFFFFF),NativeUInt($FF7FFFFFFFFFFFFF),
+    NativeUInt($FEFFFFFFFFFFFFFF),NativeUInt($FDFFFFFFFFFFFFFF),NativeUInt($FBFFFFFFFFFFFFFF),NativeUInt($F7FFFFFFFFFFFFFF),
+    NativeUInt($EFFFFFFFFFFFFFFF),NativeUInt($DFFFFFFFFFFFFFFF),NativeUInt($BFFFFFFFFFFFFFFF),NativeUInt($7FFFFFFFFFFFFFFF));
+  {$endif}
+  {$ifdef IsDWord}
+  Expected: array[TNativeUIntBitIndex] of NativeUInt = (
+    NativeUInt($FFFFFFFE),NativeUInt($FFFFFFFD),NativeUInt($FFFFFFFB),NativeUInt($FFFFFFF7),
+    NativeUInt($FFFFFFEF),NativeUInt($FFFFFFDF),NativeUInt($FFFFFFBF),NativeUInt($FFFFFF7F),
+    NativeUInt($FFFFFEFF),NativeUInt($FFFFFDFF),NativeUInt($FFFFFBFF),NativeUInt($FFFFF7FF),
+    NativeUInt($FFFFEFFF),NativeUInt($FFFFDFFF),NativeUInt($FFFFBFFF),NativeUInt($FFFF7FFF),
+    NativeUInt($FFFEFFFF),NativeUInt($FFFDFFFF),NativeUInt($FFFBFFFF),NativeUInt($FFF7FFFF),
+    NativeUInt($FFEFFFFF),NativeUInt($FFDFFFFF),NativeUInt($FFBFFFFF),NativeUInt($FF7FFFFF),
+    NativeUInt($FEFFFFFF),NativeUInt($FDFFFFFF),NativeUInt($FBFFFFFF),NativeUInt($F7FFFFFF),
+    NativeUInt($EFFFFFFF),NativeUInt($DFFFFFFF),NativeUInt($BFFFFFFF),NativeUInt($7FFFFFFF));
+  {$endif}
+  {$ifdef IsWord}
+  Expected: array[TNativeUIntBitIndex] of NativeUInt = (
+    NativeUInt($FFFE),NativeUInt($FFFD),NativeUInt($FFFB),NativeUInt($FFF7),
+    NativeUInt($FFEF),NativeUInt($FFDF),NativeUInt($FFBF),NativeUInt($FF7F),
+    NativeUInt($FEFF),NativeUInt($FDFF),NativeUInt($FBFF),NativeUInt($F7FF),
+    NativeUInt($EFFF),NativeUInt($DFFF),NativeUInt($BFFF),NativeUInt($7FFF));
+  {$endif}
+begin
+  // writeln('TestNativeUIntClearBit Start');
+  for Index in TNativeUIntBitIndex do
+  begin
+    NU := High(NativeUInt);
+    NU.ClearBit(Index);
+    if NU <> Expected[Index] then
+      Exit('Bit '+IntToStr(Index)+': expected <'+IntToStr(Expected[Index])+'> got <'+IntToStr(NU)+'>');
+  end;
+  // writeln('TestNativeUIntClearBit: OK');
+end;
+
+
+Function TestNativeUIntTestBit : string;
+var
+  Index: TNativeUIntBitIndex;
+  NU: NativeUInt;
+const
+  {$ifdef IsQWord}
+  Expected: array[TNativeUIntBitIndex] of Boolean = (True,False,True,False,True,False,True,False,
+                                                True,False,True,False,True,False,True,False,
+                                                True,False,True,False,True,False,True,False,
+                                                True,False,True,False,True,False,True,False,
+                                                True,False,True,False,True,False,True,False,
+                                                True,False,True,False,True,False,True,False,
+                                                True,False,True,False,True,False,True,False,
+                                                True,False,True,False,True,False,True,False);
+  {$endif}
+  {$ifdef IsDWord}
+  Expected: array[TNativeUIntBitIndex] of Boolean = (True,False,True,False,True,False,True,False,
+                                                True,False,True,False,True,False,True,False,
+                                                True,False,True,False,True,False,True,False,
+                                                True,False,True,False,True,False,True,False);
+
+  {$endif}
+  {$ifdef IsWord}
+  Expected: array[TNativeUIntBitIndex] of Boolean = (True,False,True,False,True,False,True,False,
+                                                True,False,True,False,True,False,True,False);
+
+  {$endif}
+begin
+  // writeln('TestNativeUIntTestBit Start');
+  {$ifdef IsQWord}
+  NU := $5555555555555555;
+  {$endif}
+  {$ifdef IsDWord}
+  NU := $55555555;
+  {$endif}
+  {$ifdef IsWord}
+  NU := $5555;
+  {$endif}
+  for Index in TNativeUIntBitIndex do
+  begin
+    if NU.TestBit(Index) <> Expected[Index] then
+      Exit('Bit '+IntToStr(Index)+': expected <'+BoolToStr(Expected[Index])+'> got <'+BoolToStr(NU.TestBit(Index))+'>');
+  end;
+  // writeln('TestNativeUIntTestBit: OK');
+end;
+
+{$undef IsQword}
+{$undef IsDword}
+{$undef IsWord}
+
+{$if SizeOf(NativeUint)=SizeOf(Int64)}
+{$define IsInt64}
+{$endif}
+{$if SizeOf(NativeUint)=SizeOf(LongInt)}
+{$define IsInt32}
+{$endif}
+{$if SizeOf(NativeUint)=SizeOf(SmallInt)}
+{$define IsInt16}
+{$endif}
+
+
+
+Function TestNativeIntSetBit : string;
+var
+  Index: TNativeIntBitIndex;
+  NI: NativeInt;
+const
+  {$ifdef IsInt64}
+  Expected: array[TNativeIntBitIndex] of NativeInt = (
+    $0000000000000001,$0000000000000003,$0000000000000007,$000000000000000F,
+    $000000000000001F,$000000000000003F,$000000000000007F,$00000000000000FF,
+    $00000000000001FF,$00000000000003FF,$00000000000007FF,$0000000000000FFF,
+    $0000000000001FFF,$0000000000003FFF,$0000000000007FFF,$000000000000FFFF,
+    $000000000001FFFF,$000000000003FFFF,$000000000007FFFF,$00000000000FFFFF,
+    $00000000001FFFFF,$00000000003FFFFF,$00000000007FFFFF,$0000000000FFFFFF,
+    $0000000001FFFFFF,$0000000003FFFFFF,$0000000007FFFFFF,$000000000FFFFFFF,
+    $000000001FFFFFFF,$000000003FFFFFFF,$000000007FFFFFFF,$00000000FFFFFFFF,
+    $00000001FFFFFFFF,$00000003FFFFFFFF,$00000007FFFFFFFF,$0000000FFFFFFFFF,
+    $0000001FFFFFFFFF,$0000003FFFFFFFFF,$0000007FFFFFFFFF,$000000FFFFFFFFFF,
+    $000001FFFFFFFFFF,$000003FFFFFFFFFF,$000007FFFFFFFFFF,$00000FFFFFFFFFFF,
+    $00001FFFFFFFFFFF,$00003FFFFFFFFFFF,$00007FFFFFFFFFFF,$0000FFFFFFFFFFFF,
+    $0001FFFFFFFFFFFF,$0003FFFFFFFFFFFF,$0007FFFFFFFFFFFF,$000FFFFFFFFFFFFF,
+    $001FFFFFFFFFFFFF,$003FFFFFFFFFFFFF,$007FFFFFFFFFFFFF,$00FFFFFFFFFFFFFF,
+    $01FFFFFFFFFFFFFF,$03FFFFFFFFFFFFFF,$07FFFFFFFFFFFFFF,$0FFFFFFFFFFFFFFF,
+    $1FFFFFFFFFFFFFFF,$3FFFFFFFFFFFFFFF,$7FFFFFFFFFFFFFFF,NativeInt($FFFFFFFFFFFFFFFF));
+  {$endif}
+  {$ifdef IsInt32}
+  Expected: array[TNativeIntBitIndex] of NativeInt = (
+    $00000001,$00000003,$00000007,$0000000F,
+    $0000001F,$0000003F,$0000007F,$000000FF,
+    $000001FF,$000003FF,$000007FF,$00000FFF,
+    $00001FFF,$00003FFF,$00007FFF,$0000FFFF,
+    $0001FFFF,$0003FFFF,$0007FFFF,$000FFFFF,
+    $001FFFFF,$003FFFFF,$007FFFFF,$00FFFFFF,
+    $01FFFFFF,$03FFFFFF,$07FFFFFF,$0FFFFFFF,
+    $1FFFFFFF,$3FFFFFFF,$7FFFFFFF,NativeInt($FFFFFFFF));
+  {$endif}
+  {$ifdef IsInt16}
+  Expected: array[TNativeIntBitIndex] of NativeInt = (
+    $0001,$0003,$0007,$000F,
+    $001F,$003F,$007F,$00FF,
+    $01FF,$03FF,$07FF,$0FFF,
+    $1FFF,$3FFF,$7FFF,$FFFF);
+  {$endif}
+begin
+  // writeln('TestNativeIntSetBit Start');
+  NI := 0;
+  for Index in TNativeIntBitIndex do
+  begin
+    NI.SetBit(Index);
+    if NI <> Expected[Index] then
+      Exit('Bit '+IntToStr(Index)+': expected <'+IntToStr(Expected[Index])+'> got <'+IntToStr(NI)+'>');
+  end;
+  // writeln('TestNativeIntSetBit: OK');
+end;
+
+
+Function TestNativeIntToggleBit : string;
+var
+  Index: TNativeIntBitIndex;
+  NI: NativeInt;
+const
+  {$ifdef IsInt64}
+  Expected: array[TNativeIntBitIndex] of NativeInt = (
+    $0000000000000001,$0000000000000003,$0000000000000007,$000000000000000F,
+    $000000000000001F,$000000000000003F,$000000000000007F,$00000000000000FF,
+    $00000000000001FF,$00000000000003FF,$00000000000007FF,$0000000000000FFF,
+    $0000000000001FFF,$0000000000003FFF,$0000000000007FFF,$000000000000FFFF,
+    $000000000001FFFF,$000000000003FFFF,$000000000007FFFF,$00000000000FFFFF,
+    $00000000001FFFFF,$00000000003FFFFF,$00000000007FFFFF,$0000000000FFFFFF,
+    $0000000001FFFFFF,$0000000003FFFFFF,$0000000007FFFFFF,$000000000FFFFFFF,
+    $000000001FFFFFFF,$000000003FFFFFFF,$000000007FFFFFFF,$00000000FFFFFFFF,
+    $00000001FFFFFFFF,$00000003FFFFFFFF,$00000007FFFFFFFF,$0000000FFFFFFFFF,
+    $0000001FFFFFFFFF,$0000003FFFFFFFFF,$0000007FFFFFFFFF,$000000FFFFFFFFFF,
+    $000001FFFFFFFFFF,$000003FFFFFFFFFF,$000007FFFFFFFFFF,$00000FFFFFFFFFFF,
+    $00001FFFFFFFFFFF,$00003FFFFFFFFFFF,$00007FFFFFFFFFFF,$0000FFFFFFFFFFFF,
+    $0001FFFFFFFFFFFF,$0003FFFFFFFFFFFF,$0007FFFFFFFFFFFF,$000FFFFFFFFFFFFF,
+    $001FFFFFFFFFFFFF,$003FFFFFFFFFFFFF,$007FFFFFFFFFFFFF,$00FFFFFFFFFFFFFF,
+    $01FFFFFFFFFFFFFF,$03FFFFFFFFFFFFFF,$07FFFFFFFFFFFFFF,$0FFFFFFFFFFFFFFF,
+    $1FFFFFFFFFFFFFFF,$3FFFFFFFFFFFFFFF,$7FFFFFFFFFFFFFFF,NativeInt($FFFFFFFFFFFFFFFF));
+  {$endif}
+  {$ifdef IsInt32}
+  Expected: array[TNativeIntBitIndex] of NativeInt = (
+    $00000001,$00000003,$00000007,$0000000F,
+    $0000001F,$0000003F,$0000007F,$000000FF,
+    $000001FF,$000003FF,$000007FF,$00000FFF,
+    $00001FFF,$00003FFF,$00007FFF,$0000FFFF,
+    $0001FFFF,$0003FFFF,$0007FFFF,$000FFFFF,
+    $001FFFFF,$003FFFFF,$007FFFFF,$00FFFFFF,
+    $01FFFFFF,$03FFFFFF,$07FFFFFF,$0FFFFFFF,
+    $1FFFFFFF,$3FFFFFFF,$7FFFFFFF,NativeInt($FFFFFFFF));
+  {$endif}
+  {$ifdef IsInt16}
+  Expected: array[TNativeIntBitIndex] of NativeInt = (
+    $0001,$0003,$0007,$000F,
+    $001F,$003F,$007F,$00FF,
+    $01FF,$03FF,$07FF,$0FFF,
+    $1FFF,$3FFF,$7FFF,$FFFF);
+  {$endif}
+begin
+  // writeln('TestNativeIntToggleBit: OK');
+  NI := 0;
+  for Index in TNativeIntBitIndex do
+  begin
+    NI.ToggleBit(Index);
+    if NI <> Expected[Index] then
+      Exit('Bit '+IntToStr(Index)+': expected <'+IntToStr(Expected[Index])+'> got <'+IntToStr(NI)+'>');
+  end;
+  // writeln('TestNativeIntToggleBit: OK');
+end;
+
+
+Function TestNativeIntClearBit : string;
+var
+  Index: TNativeIntBitIndex;
+  NI: NativeInt;
+const
+  {$ifdef IsInt64}
+  Expected: array[TNativeIntBitIndex] of NativeInt = (
+    NativeInt($FFFFFFFFFFFFFFFE),NativeInt($FFFFFFFFFFFFFFFD),NativeInt($FFFFFFFFFFFFFFFB),NativeInt($FFFFFFFFFFFFFFF7),
+    NativeInt($FFFFFFFFFFFFFFEF),NativeInt($FFFFFFFFFFFFFFDF),NativeInt($FFFFFFFFFFFFFFBF),NativeInt($FFFFFFFFFFFFFF7F),
+    NativeInt($FFFFFFFFFFFFFEFF),NativeInt($FFFFFFFFFFFFFDFF),NativeInt($FFFFFFFFFFFFFBFF),NativeInt($FFFFFFFFFFFFF7FF),
+    NativeInt($FFFFFFFFFFFFEFFF),NativeInt($FFFFFFFFFFFFDFFF),NativeInt($FFFFFFFFFFFFBFFF),NativeInt($FFFFFFFFFFFF7FFF),
+    NativeInt($FFFFFFFFFFFEFFFF),NativeInt($FFFFFFFFFFFDFFFF),NativeInt($FFFFFFFFFFFBFFFF),NativeInt($FFFFFFFFFFF7FFFF),
+    NativeInt($FFFFFFFFFFEFFFFF),NativeInt($FFFFFFFFFFDFFFFF),NativeInt($FFFFFFFFFFBFFFFF),NativeInt($FFFFFFFFFF7FFFFF),
+    NativeInt($FFFFFFFFFEFFFFFF),NativeInt($FFFFFFFFFDFFFFFF),NativeInt($FFFFFFFFFBFFFFFF),NativeInt($FFFFFFFFF7FFFFFF),
+    NativeInt($FFFFFFFFEFFFFFFF),NativeInt($FFFFFFFFDFFFFFFF),NativeInt($FFFFFFFFBFFFFFFF),NativeInt($FFFFFFFF7FFFFFFF),
+    NativeInt($FFFFFFFEFFFFFFFF),NativeInt($FFFFFFFDFFFFFFFF),NativeInt($FFFFFFFBFFFFFFFF),NativeInt($FFFFFFF7FFFFFFFF),
+    NativeInt($FFFFFFEFFFFFFFFF),NativeInt($FFFFFFDFFFFFFFFF),NativeInt($FFFFFFBFFFFFFFFF),NativeInt($FFFFFF7FFFFFFFFF),
+    NativeInt($FFFFFEFFFFFFFFFF),NativeInt($FFFFFDFFFFFFFFFF),NativeInt($FFFFFBFFFFFFFFFF),NativeInt($FFFFF7FFFFFFFFFF),
+    NativeInt($FFFFEFFFFFFFFFFF),NativeInt($FFFFDFFFFFFFFFFF),NativeInt($FFFFBFFFFFFFFFFF),NativeInt($FFFF7FFFFFFFFFFF),
+    NativeInt($FFFEFFFFFFFFFFFF),NativeInt($FFFDFFFFFFFFFFFF),NativeInt($FFFBFFFFFFFFFFFF),NativeInt($FFF7FFFFFFFFFFFF),
+    NativeInt($FFEFFFFFFFFFFFFF),NativeInt($FFDFFFFFFFFFFFFF),NativeInt($FFBFFFFFFFFFFFFF),NativeInt($FF7FFFFFFFFFFFFF),
+    NativeInt($FEFFFFFFFFFFFFFF),NativeInt($FDFFFFFFFFFFFFFF),NativeInt($FBFFFFFFFFFFFFFF),NativeInt($F7FFFFFFFFFFFFFF),
+    NativeInt($EFFFFFFFFFFFFFFF),NativeInt($DFFFFFFFFFFFFFFF),NativeInt($BFFFFFFFFFFFFFFF),NativeInt($7FFFFFFFFFFFFFFF));
+  {$endif}
+  {$ifdef IsInt32}
+  Expected: array[TNativeIntBitIndex] of NativeInt = (
+    NativeInt($FFFFFFFE),NativeInt($FFFFFFFD),NativeInt($FFFFFFFB),NativeInt($FFFFFFF7),
+    NativeInt($FFFFFFEF),NativeInt($FFFFFFDF),NativeInt($FFFFFFBF),NativeInt($FFFFFF7F),
+    NativeInt($FFFFFEFF),NativeInt($FFFFFDFF),NativeInt($FFFFFBFF),NativeInt($FFFFF7FF),
+    NativeInt($FFFFEFFF),NativeInt($FFFFDFFF),NativeInt($FFFFBFFF),NativeInt($FFFF7FFF),
+    NativeInt($FFFEFFFF),NativeInt($FFFDFFFF),NativeInt($FFFBFFFF),NativeInt($FFF7FFFF),
+    NativeInt($FFEFFFFF),NativeInt($FFDFFFFF),NativeInt($FFBFFFFF),NativeInt($FF7FFFFF),
+    NativeInt($FEFFFFFF),NativeInt($FDFFFFFF),NativeInt($FBFFFFFF),NativeInt($F7FFFFFF),
+    NativeInt($EFFFFFFF),NativeInt($DFFFFFFF),NativeInt($BFFFFFFF),NativeInt($7FFFFFFF));
+  {$endif}
+  {$ifdef IsInt16}
+  Expected: array[TNativeIntBitIndex] of NativeInt = (
+    NativeInt($FFFE),NativeInt($FFFD),NativeInt($FFFB),NativeInt($FFF7),
+    NativeInt($FFEF),NativeInt($FFDF),NativeInt($FFBF),NativeInt($FF7F),
+    NativeInt($FEFF),NativeInt($FDFF),NativeInt($FBFF),NativeInt($F7FF),
+    NativeInt($EFFF),NativeInt($DFFF),NativeInt($BFFF),NativeInt($7FFF));
+  {$endif}
+begin
+  // writeln('TestNativeIntClearBit Start');
+  for Index in TNativeIntBitIndex do
+  begin
+    {$ifdef IsInt64}
+    NI := NativeInt($FFFFFFFFFFFFFFFF);
+    {$endif}
+    {$ifdef IsInt32}
+    NI := NativeInt($FFFFFFFF);
+    {$endif}
+    {$ifdef IsInt}
+    Q := NativeInt($FFFFF);
+    {$endif}
+    NI.ClearBit(Index);
+    if NI <> Expected[Index] then
+      Exit('Bit '+IntToStr(Index)+': expected <'+IntToStr(Expected[Index])+'> got <'+IntToStr(NI)+'>');
+  end;
+  // writeln('TestNativeIntClearBit: OK');
+end;
+
+
+Function TestNativeIntTestBit : string;
+var
+  Index: TNativeIntBitIndex;
+  NI : NativeInt;
+
+const
+  {$ifdef IsInt64}
+  Expected: array[TNativeIntBitIndex] of Boolean = (True,False,True,False,True,False,True,False,
+                                                True,False,True,False,True,False,True,False,
+                                                True,False,True,False,True,False,True,False,
+                                                True,False,True,False,True,False,True,False,
+                                                True,False,True,False,True,False,True,False,
+                                                True,False,True,False,True,False,True,False,
+                                                True,False,True,False,True,False,True,False,
+                                                True,False,True,False,True,False,True,False);
+  {$endif}
+  {$ifdef IsInt32}
+  Expected: array[TNativeIntBitIndex] of Boolean = (True,False,True,False,True,False,True,False,
+                                                True,False,True,False,True,False,True,False,
+                                                True,False,True,False,True,False,True,False,
+                                                True,False,True,False,True,False,True,False);
+
+  {$endif}
+  {$ifdef IsInt16}
+  Expected: array[TNativeIntBitIndex] of Boolean = (True,False,True,False,True,False,True,False,
+                                                True,False,True,False,True,False,True,False);
+
+  {$endif}
+begin
+  // writeln('TestNativeIntTestBit Start');
+  {$ifdef IsInt64}
+  NI := NativeInt($5555555555555555);
+  {$endif}
+  {$ifdef IsInt32}
+  NI := NativeInt($55555555);
+  {$endif}
+  {$ifdef IsInt16}
+  NI := NativeInt($5555);
+  {$endif}
+  for Index in TNativeIntBitIndex do
+  begin
+    if NI.TestBit(Index) <> Expected[Index] then
+      Exit('Bit '+IntToStr(Index)+': expected <'+BoolToStr(Expected[Index])+'> got <'+BoolToStr(NI.TestBit(Index))+'>');
+  end;
+  // writeln('TestNativeIntTestBit: OK');
+end;
+
+Procedure RegisterHelperTests;
+
+Var
+  P : PSuite;
+
+begin
+  P:=AddSuite('OrdinalHelpers',EnsureSuite('SysUtils'));
+//  P:=AddSuite('OrdinalHelpers',Psuite(Nil){EnsureSuite('SysUtils')});
+  AddTest('ByteHelper',@TestByteHelper,P);
+  AddTest('ShortIntHelper',@TestShortIntHelper,P);
+  AddTest('NegShortIntHelper',@TestNegShortIntHelper,P);
+  AddTest('WordHelper',@TestWordHelper,P);
+  AddTest('SmallIntHelper',@TestSmallIntHelper,P);
+  AddTest('NegSmallIntHelper',@TestNegSmallIntHelper,P);
+  AddTest('CardinalHelper',@TestCardinalHelper,P);
+  AddTest('LongintHelper',@TestLongintHelper,P);
+  AddTest('NegLongintHelper',@TestNegLongintHelper,P);
+  AddTest('QWordHelper',@TestQWordHelper,P);
+  AddTest('Int64Helper',@TestInt64Helper,P);
+  AddTest('NegInt64Helper',@TestNegInt64Helper,P);
+  AddTest('TestByteSetBit',@TestByteSetBit,P);
+  AddTest('TestByteToggleBit',@TestByteToggleBit,P);
+  AddTest('TestByteClearBit',@TestByteClearBit,P);
+  AddTest('TestByteTestBit',@TestByteTestBit,P);
+  AddTest('TestShortIntSetBit',@TestShortIntSetBit,P);
+  AddTest('TestShortIntToggleBit',@TestShortIntToggleBit,P);
+  AddTest('TestShortIntClearBit',@TestShortIntClearBit,P);
+  AddTest('TestShortIntTestBit',@TestShortIntTestBit,P);
+  AddTest('TestWordSetBit',@TestWordSetBit,P);
+  AddTest('TestWordToggleBit',@TestWordToggleBit,P);
+  AddTest('TestWordClearBit',@TestWordClearBit,P);
+  AddTest('TestWordTestBit',@TestWordTestBit,P);
+  AddTest('TestSmallIntSetBit',@TestSmallIntSetBit,P);
+  AddTest('TestSmallIntToggleBit',@TestSmallIntToggleBit,P);
+  AddTest('TestSmallIntClearBit',@TestSmallIntClearBit,P);
+  AddTest('TestSmallIntTestBit',@TestSmallIntTestBit,P);
+  AddTest('TestCardinalSetBit',@TestCardinalSetBit,P);
+  AddTest('TestCardinalToggleBit',@TestCardinalToggleBit,P);
+  AddTest('TestCardinalClearBit',@TestCardinalClearBit,P);
+  AddTest('TestCardinalTestBit',@TestCardinalTestBit,P);
+  AddTest('TestLongIntSetBit',@TestLongIntSetBit,P);
+  AddTest('TestLongIntToggleBit',@TestLongIntToggleBit,P);
+  AddTest('TestLongIntClearBit',@TestLongIntClearBit,P);
+  AddTest('TestLongIntTestBit',@TestLongIntTestBit,P);
+  AddTest('TestQWordSetBit',@TestQWordSetBit,P);
+  AddTest('TestQWordToggleBit',@TestQWordToggleBit,P);
+  AddTest('TestQWordClearBit',@TestQWordClearBit,P);
+  AddTest('TestQWordTestBit',@TestQWordTestBit,P);
+  AddTest('TestInt64SetBit',@TestInt64SetBit,P);
+  AddTest('TestInt64ToggleBit',@TestInt64ToggleBit,P);
+  AddTest('TestInt64ClearBit',@TestInt64ClearBit,P);
+  AddTest('TestInt64TestBit',@TestInt64TestBit,P);
+  AddTest('TestNativeUIntSetBit',@TestNativeUIntSetBit,P);
+  AddTest('TestNativeUIntToggleBit',@TestNativeUIntToggleBit,P);
+  AddTest('TestNativeUIntClearBit',@TestNativeUIntClearBit,P);
+  AddTest('TestNativeUIntTestBit',@TestNativeUIntTestBit,P);
+  AddTest('TestNativeIntSetBit',@TestNativeIntSetBit,P);
+  AddTest('TestNativeIntToggleBit',@TestNativeIntToggleBit,P);
+  AddTest('TestNativeIntClearBit',@TestNativeIntClearBit,P);
+  AddTest('TestNativeIntTestBit',@TestNativeIntTestBit,P);
+
+  P:=AddSuite('GUIDHelper',EnsureSuite('SysUtils'));
+//  P:=AddSuite('GUIDHelper',Psuite(Nil){EnsureSuite('SysUtils')});
+  AddTest('CreateUntypedData',@TestGUIDHelperCreateUntypedData,P);
+  AddTest('CreateUntypedDataEndian',@TestGUIDHelperCreateUntypedDataEndian,P);
+  AddTest('CreateArrayOfByte',@TestGUIDHelperCreateArrayOfByte,P);
+  AddTest('CreateTBytes',@TestGUIDHelperCreateTBytes,P);
+  AddTest('CreateTBytesAtIndex',@TestGUIDHelperCreateTBytesAtIndex,P);
+  AddTest('CreateString',@TestGUIDHelperCreateString,P);
+  AddTest('CreateIntegerBytes',@TestGUIDHelperCreateIntegerBytes,P);
+  AddTest('CreateWords',@TestGUIDHelperCreateWords,P);
+  AddTest('CreateInteger',@TestGUIDHelperCreateInteger,P);
+  AddTest('CreateNew',@TestGUIDHelperCreateNew,P);
+  AddTest('ToByteArray',@TestGUIDHelperToByteArray,P);
+  AddTest('ToString',@TestGUIDHelperToString,P);
+  P:=AddSuite('FloatHelper',EnsureSuite('SysUtils'));
+  // Float tests
+  AddTest('IsNanSingle',@TestIsNanSingle,P);
+  AddTest('IsNanDouble',@TestIsNanDouble,P);
+  AddTest('IsNanExtended',@TestIsNanExtended,P);
+
+
+end;
+
+
+initialization
+  RegisterHelperTests;
+end.
+

rtl/test/utsysutils.pp

@@ -0,0 +1,136 @@
+{$mode objfpc}
+{$h+}
+unit utsysutils;
+
+Interface
+
+Function CheckMaxDateTime : String;
+
+Implementation
+
+uses sysutils, punit, utrtl;
+
+Function CheckMaxDateTime : String;
+
+
+var
+  y,d,h,m,s,z : Word;
+    
+begin
+  Result:='';
+  DecodeTime(MaxDateTime, h, m, s, z);
+  if not AssertEquals('Hours correct',23,h) then exit;
+  if not AssertEquals('Minutes correct',59,m) then exit;
+  if not AssertEquals('Seconds correct',59,s) then exit;
+  if not AssertEquals('Milliseconds correct',999,z) then exit;
+  DecodeDate(MaxDateTime, y, m,d);
+  if not AssertEquals('Year correct',9999,y) then exit;
+  if not AssertEquals('Month correct',12,m) then exit;
+  if not AssertEquals('Day correct',31,d) then exit;
+end;
+
+Function CheckIsValidIdent : string;
+
+begin
+  Result:='';
+  if not AssertTrue('Normal',isValidIdent('abc')) then exit;
+  if not AssertTrue('Normal with dot',isValidIdent('abc',true)) then exit;
+  if not AssertTrue('Normal underscore',isValidIdent('_abc')) then exit;
+  if not AssertTrue('Normal underscore with dot',isValidIdent('_abc',true)) then exit;
+  if not AssertTrue('Normal last underscore',isValidIdent('abc_')) then exit;
+  if not AssertTrue('Normal last underscore with dot',isValidIdent('abc_',true)) then exit;
+  if not AssertTrue('Normal number',isValidIdent('abc0')) then exit;
+  if not AssertTrue('Normal number',isValidIdent('abc0',true)) then exit;
+  if not AssertFalse('Normal number first',isValidIdent('9abc')) then exit;
+  if not AssertFalse('Normal number first',isValidIdent('9abc',True)) then exit;
+  if not AssertTrue('Containing dot, allowed',IsValidIdent('a.b',True)) then exit;
+  if not AssertFalse('Containing dot, not allowed',IsValidIdent('a.b')) then exit;
+  if not AssertFalse('Containing dot pos 1, allowed',IsValidIdent('.b',true)) then exit;
+end;
+
+Function CheckAnsiDequotedString : string;
+
+begin
+  Result:='';
+  if Not AssertEquals('Nothing between quotes','',AnsiDequotedStr('""', '"')) then exit;
+  if Not AssertEquals('empty string','',AnsiDequotedStr('', '"')) then exit;
+  if Not AssertEquals('Non-quoted string','abc',AnsiDequotedStr('abc', '"')) then exit;
+end;
+
+Function CheckFileOpenDirFails : String;
+
+begin
+  Result:='';
+  If Not AssertEquals('Cannot open directory with fileOpen',-1,FileOpen('.',fmOpenRead)) then exit;
+end;
+
+Function CheckStringReplace : String;
+
+Var
+  C : integer;
+
+begin
+  Result:='';
+  If not AssertEquals('StringReplace 1 Result','ABA',StringReplace('ACA','C','B',[],C)) then exit;
+  If not AssertEquals('StringReplace 1 count Result',1,C) then exit;
+  If not AssertEquals('StringReplace 2 Result','ABAC',StringReplace('ACAC','C','B',[],C)) then exit;
+  If not AssertEquals('StringReplace 2 count Result',1,C) then exit;
+  If not AssertEquals('StringReplace 3 Result','ABAB',StringReplace('ACAC','C','B',[rfReplaceAll],C)) then exit;
+  If not AssertEquals('StringReplace 3 count Result',2,C) then exit;
+  If not AssertEquals('StringReplace 4 Result','ACAC',StringReplace('ACAC','D','B',[rfReplaceAll],C)) then exit;
+  If not AssertEquals('StringReplace 4 count Result',0,C) then exit;
+end;
+
+Function CheckUnicodeStringReplace : String;
+
+Var
+  C : integer;
+
+begin
+  Result:='';
+  If not AssertEquals('UnicodeStringReplace 1 Result','ABA',UnicodeStringReplace('ACA','C','B',[],C)) then exit;
+  If not AssertEquals('UnicodeStringReplace 1 count Result',1,C) then exit;
+  If not AssertEquals('UnicodeStringReplace 2 Result','ABAC',UnicodeStringReplace('ACAC','C','B',[],C)) then exit;
+  If not AssertEquals('UnicodeStringReplace 2 count Result',1,C) then exit;
+  If not AssertEquals('UnicodeStringReplace 3 Result','ABAB',UnicodeStringReplace('ACAC','C','B',[rfReplaceAll],C)) then exit;
+  If not AssertEquals('UnicodeStringReplace 3 count Result',2,C) then exit;
+  If not AssertEquals('UnicodeStringReplace 4 Result','ACAC',UnicodeStringReplace('ACAC','D','B',[rfReplaceAll],C)) then exit;
+  If not AssertEquals('UnicodeStringReplace 4 count Result',0,C) then exit;
+end;
+
+Function CheckWideStringReplace : String;
+
+Var
+  C : integer;
+
+begin
+  Result:='';
+  If not AssertEquals('WideStringReplace 1 Result','ABA',WideStringReplace('ACA','C','B',[],C)) then exit;
+  If not AssertEquals('WideStringReplace 1 count Result',1,C) then exit;
+  If not AssertEquals('WideStringReplace 2 Result','ABAC',WideStringReplace('ACAC','C','B',[],C)) then exit;
+  If not AssertEquals('WideStringReplace 2 count Result',1,C) then exit;
+  If not AssertEquals('WideStringReplace 3 Result','ABAB',WideStringReplace('ACAC','C','B',[rfReplaceAll],C)) then exit;
+  If not AssertEquals('WideStringReplace 3 count Result',2,C) then exit;
+  If not AssertEquals('WideStringReplace 4 Result','ACAC',WideStringReplace('ACAC','D','B',[rfReplaceAll],C)) then exit;
+  If not AssertEquals('WideStringReplace 4 count Result',0,C) then exit;
+end;
+
+Function CheckWrapText : String;
+
+begin
+  Result:='';
+  If not AssertEquals('Default','hello hello',WrapText('hello hello',7)) then exit;
+end;
+
+
+begin
+  SysutilsTest('CheckMaxDateTime',@CheckMaxDateTime);
+  SysutilsTest('CheckIsValidIdent',@CheckIsValidIdent);
+  SysutilsTest('CheckAnsiDequotedString',@CheckAnsiDequotedString);
+  SysutilsTest('CheckFileOpenDirFails',@CheckFileOpenDirFails);
+  SysutilsTest('CheckStringReplace',@CheckStringReplace);
+  SysutilsTest('CheckUnicodeStringReplace',@CheckUnicodeStringReplace);
+  SysutilsTest('CheckWideStringReplace',@CheckWideStringReplace);
+  SysutilsTest('CheckWrapText',@CheckWrapText);
+end.
+

rtl/test/uttypinfo.pp

@@ -0,0 +1,143 @@
+unit uttypinfo;
+
+{$mode objfpc}
+{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, punit, utrtl, typinfo;
+
+implementation
+
+Type
+  TMyEnum = (one,two,three);
+  TMyInt = Integer;
+
+Var
+  MyEnumInfo : PtypeInfo;
+
+Function RegisterAliasesNotEnumerated : TtestString;
+
+begin
+  Result:='';
+  ExpectException('Type information points to non-enumerated type',EArgumentException);
+  AddEnumElementAliases(TypeInfo(TMyInt),['a','b','c'],0)
+end;
+
+Function RegisterAliasesNoElements : TTestString;
+
+begin
+  Result:='';
+  ExpectException('Invalid number of enumerated values',EArgumentException);
+  AddEnumElementAliases(MyEnumInfo,[],0)
+end;
+
+Function RegisterAliasesTooManyElements : TTestString;
+
+begin
+  Result:='';
+  ExpectException('Invalid number of enumerated values',EArgumentException);
+  AddEnumElementAliases(MyEnumInfo,['a','b','c','d'],0)
+end;
+
+Function RegisterAliasesTooManyElementsOffset : TTestString;
+
+begin
+  Result:='';
+  ExpectException('Invalid number of enumerated values',EArgumentException);
+  AddEnumElementAliases(MyEnumInfo,['a','b','c'],2)
+end;
+
+Function RegisterAliasesDuplicate : TTestString;
+
+
+begin
+  Result:='';
+  ExpectException('Duplicate alias for enumerated value',EArgumentException);
+  AddEnumElementAliases(MyEnumInfo,['a','b','a'],2)
+end;
+
+function TestGetEnumeratedAliasValue : TTestString;
+
+begin
+  Result:='';
+  AddEnumElementAliases(MyEnumInfo,['a','b','c']);
+  if not AssertEquals('Correct value',0,GetEnumeratedAliasValue(MyEnumInfo,'a')) then
+    exit;
+  if not AssertEquals('Correct value',1,GetEnumeratedAliasValue(MyEnumInfo,'b')) then
+    exit;
+  if not AssertEquals('Correct value',2,GetEnumeratedAliasValue(MyEnumInfo,'c')) then
+    exit;
+end;
+
+function TestGetRemoveEnumeratedAliases : TTestString;
+
+begin
+  Result:='';
+  RemoveEnumElementAliases(MyEnumInfo);
+  AddEnumElementAliases(MyEnumInfo,['a','b','c']);
+  if not AssertEquals('Correct value',0,GetEnumeratedAliasValue(MyEnumInfo,'a')) then
+    exit;
+  RemoveEnumElementAliases(MyEnumInfo);
+  if not AssertEquals('Correct value',-1,GetEnumeratedAliasValue(MyEnumInfo,'a')) then
+    exit;
+end;
+
+function TestGetRemoveEnumeratedAliasesOffset : TTestString;
+
+begin
+  Result:='';
+  RemoveEnumElementAliases(MyEnumInfo);
+  AddEnumElementAliases(MyEnumInfo,['b','c'],1);
+  if not AssertEquals('Correct value',-1,GetEnumeratedAliasValue(MyEnumInfo,'a')) then
+    exit;
+  if not AssertEquals('Correct value',1,GetEnumeratedAliasValue(MyEnumInfo,'b')) then
+    exit;
+  if not AssertEquals('Correct value',2,GetEnumeratedAliasValue(MyEnumInfo,'c')) then
+    exit;
+end;
+
+function TestGetEnumeratedValue : TTestString;
+
+begin
+  Result:='';
+  RemoveEnumElementAliases(MyEnumInfo);
+  AddEnumElementAliases(MyEnumInfo,['b','c'],1);
+  if not AssertEquals('Correct value',-1,GetEnumValue(MyEnumInfo,'a')) then
+    exit;
+  if not AssertEquals('Correct value',0,GetEnumValue(MyEnumInfo,'one')) then
+    exit;
+  if not AssertEquals('Correct value',1,GetEnumValue(MyEnumInfo,'two')) then
+    exit;
+  if not AssertEquals('Correct value',1,GetEnumValue(MyEnumInfo,'b')) then
+    exit;
+  if not AssertEquals('Correct value',2,GetEnumValue(MyEnumInfo,'three')) then
+    exit;
+  if not AssertEquals('Correct value',2,GetEnumValue(MyEnumInfo,'c')) then
+    exit;
+end;
+
+
+Procedure RegisterTests;
+
+Var
+  P : Psuite;
+begin
+  P:=EnsureSuite('TypInfo');
+  AddTest('RegisterAliasesNotEnumerated',@RegisterAliasesNoElements,P);
+  AddTest('RegisterAliasesNoElements',@RegisterAliasesNoElements,P);
+  AddTest('RegisterAliasesTooManyElements',@RegisterAliasesTooManyElements,P);
+  AddTest('RegisterAliasesTooManyElementsOffset',@RegisterAliasesTooManyElementsOffset,P);
+  AddTest('RegisterAliasesDuplicate',@RegisterAliasesDuplicate,P);
+  AddTest('TestGetEnumeratedAliasValue',@TestGetEnumeratedAliasValue,P);
+  AddTest('TestGetRemoveEnumeratedAliases',@TestGetRemoveEnumeratedAliases,P);
+  AddTest('TestGetRemoveEnumeratedAliasesOffset',@TestGetRemoveEnumeratedAliasesOffset,P);
+  AddTest('TestGetEnumeratedValue',@TestGetEnumeratedValue,P);
+end;
+
+begin
+  MyEnumInfo:=TypeInfo(TMyEnum);
+  RegisterTests;
+end.
+

rtl/test/utunifile.pp

@@ -0,0 +1,132 @@
+unit utunifile;
+
+{$codepage utf8}
+{$mode objfpc}{$h+}
+
+interface
+
+uses
+{$ifdef unix}
+  {$ifdef darwin}iosxwstr{$else}cwstring{$endif},
+{$endif}
+  sysutils;
+  
+implementation  
+
+uses punit,utrtl;
+
+type
+  tcpstr866 = type ansistring(866);
+
+procedure error(const s: string);
+begin
+  writeln('Error: ',s);
+  halt(1);
+end;
+
+
+procedure warn(const s: string);
+begin
+  Ignore('Warning: cannot test '+s+' scenario fully because not all characters are supported by DefaultFileSystemCodePage');
+end;
+
+
+Function testsinglebyteUtf8 : String;
+
+var
+  u: utf8string;
+  f: THandle;
+  r: rawbytestring;
+begin
+  Result:='';
+  u:='‹≈©◊';
+  r:=u;
+  setcodepage(r,DefaultFileSystemCodePage);
+  if r=u then
+    begin
+    f:=FileCreate(u,fmShareDenyNone,(6 shl 6) or (4 shl 3) or 4);
+    if not AssertTrue('Creating utf8string',f<>-1) then exit;
+    FileClose(f);
+    DeleteFile(u);
+    end
+  else
+    warn('utf8string');
+end;
+
+Function testsinglebytecp866 : String;
+
+  var
+    c: tcpstr866;
+    f: THandle;
+    r: rawbytestring;
+  begin
+    Result:='';
+  c:='Русская';
+  setcodepage(rawbytestring(c),866);
+  r:=c;
+  setcodepage(r,DefaultFileSystemCodePage);
+  if r=c then
+    begin
+    f:=FileCreate(c,fmShareDenyNone,(6 shl 6) or (4 shl 3) or 4);
+    if not AssertTrue('Creating tcpstr866',f<>-1) then exit;
+    FileClose(f);
+    DeleteFile(c);
+    end
+  else
+    warn('tcpstr866');
+end;
+
+
+Function testtwobyteutf8 : string;
+
+var
+  u: unicodestring;
+  f: THandle;
+  r: rawbytestring;
+
+begin
+  Result:='';
+  R:='';
+  u:='‹≈©◊';
+  widestringmanager.unicode2ansimoveproc(punicodechar(u),r,DefaultFileSystemCodePage,length(u));
+  if r=u then
+    begin
+    f:=FileCreate(u,fmShareDenyNone,(6 shl 6) or (4 shl 3) or 4);
+    if not AssertTrue('Creating unicodestring 1',f<>-1) then exit;
+    FileClose(f);
+    DeleteFile(u);
+    end
+  else
+    warn('random unicodestring');
+end;
+
+Function testtwobytecp866 : string;
+
+var
+  u: unicodestring;
+  f: THandle;
+  r: rawbytestring;
+
+begin
+  Result:='';
+  r:='';
+  u:='Русская';
+  r:=u;
+  if r=u then
+    begin
+    f:=FileCreate(u,fmShareDenyNone,(6 shl 6) or (4 shl 3) or 4);
+    if not AssertTrue('Creating unicodestring 1',f<>-1) then exit;
+    FileClose(f);
+    DeleteFile(u);
+    end
+  else
+    warn('cp866 unicodestring');
+end;
+
+
+begin
+  SysutilsTest('testsinglebyteutf8',@testsinglebyteutf8);
+  SysutilsTest('testsinglebytecp866',@testsinglebytecp866);
+  SysutilsTest('testtwobyteutf8',@testtwobyteutf8);
+  SysutilsTest('testtwobytecp866',@testtwobytecp866);
+end.

rtl/test/utuplow.pp

@@ -0,0 +1,113 @@
+unit utuplow;
+
+{$mode objfpc}
+{$h+}
+
+interface
+
+uses
+  SysUtils;
+
+Implementation
+
+uses punit, utrtl;
+
+procedure writestring(const s: ansistring);
+  var
+    i: longint;
+  begin
+    for i:=1 to length(s) do
+      if (s[i]<=#32) or (s[i]>=#127) then
+        write('#',ord(s[i]),' ')
+      else
+        write(s[i],' ');
+    writeln;
+  end;
+
+procedure writestring(const s: unicodestring);
+  var
+    i: longint;
+  begin
+    for i:=1 to length(s) do
+      if (s[i]<=#0032) or (s[i]>=#0127) then
+        write('#',ord(s[i]),' ')
+      else
+        write(s[i],' ');
+    writeln;
+  end;
+
+procedure error(const s1,s2: ansistring; nr: longint);
+begin
+  writeln('error ',nr);
+  write('  Got: ');
+  writestring(s1);
+  write('  Expected: ');
+  writestring(s2);
+  halt(nr);
+end;
+
+procedure error(const s1,s2: unicodestring; nr: longint);
+begin
+  writeln('error ',nr);
+  write('  Got: ');
+  writestring(s1);
+  write('  Expected: ');
+  writestring(s2);
+  halt(nr);
+end;
+
+
+
+Function testuplowansi : string;
+
+  const
+    str = #1#2#0#3#128#129#130#131#132#133#134#135#136#137#138#139'aAbBcCdD'#0'fF';
+    upperstr = #1#2#0#3#128#129#130#131#132#133#134#135#136#137#138#139'AABBCCDD'#0'FF';
+    lowerstr = #1#2#0#3#128#129#130#131#132#133#134#135#136#137#138#139'aabbccdd'#0'ff';
+  var
+    s1, s2: ansistring;
+  begin
+    Result:='';
+    s1:=str;
+    uniquestring(s1);
+    s2:=s1;
+    s1:=uppercase(s1);
+    if not AssertEquals('error 1',upperstr,S1) then exit;
+    if not AssertEquals('error 2',str,S2) then exit;
+    s1:=str;
+    uniquestring(s1);
+    s2:=s1;
+    s1:=lowercase(s1);
+    if not AssertEquals('Error 3',lowerstr,S1) then exit;
+    if not AssertEquals('Error 4',str,S2) then exit;
+ end;
+
+
+Function testuplowwide : String;
+  const
+    str = #$0001#$0002#$0000#$0003#0128#0129#0130#0131#0132#0133#0134#0135#0136#0137#0138#0139'AABBCCDD'#0000'FF';
+    upperstr = #$0001#$0002#$0000#$0003#0128#0129#0130#0131#0132#0133#0134#0135#0136#0137#0138#0139'AABBCCDD'#0000'FF';
+    lowerstr = #$0001#$0002#$0000#$0003#0128#0129#0130#0131#0132#0133#0134#0135#0136#0137#0138#0139'aabbccdd'#0000'ff';
+  var
+    s1, s2: unicodestring;
+  begin
+    Result:='';
+    s1:=str;
+    uniquestring(s1);
+    s2:=s1;
+    s1:=uppercase(s1);
+    if not AssertEquals('error 5',upperstr,S1) then exit;
+    if not AssertEquals('error 6',str,S2) then exit;
+
+    s1:=str;
+    uniquestring(s1);
+    s2:=s1;
+    s1:=lowercase(s1);
+    if not AssertEquals('Error 7',lowerstr,S1) then exit;
+    if not AssertEquals('Error 8',str,S2) then exit;
+ end;
+
+begin
+  SysUtilsTest('testuplowansi',@testuplowansi);
+  SysUtilsTest('testuplowwide',@testuplowwide);
+end.

rtl/test/utustringbuild.pp

@@ -0,0 +1,6 @@
+unit utustringbuild;
+
+{$DEFINE SBUNICODE}
+
+{$i utstringbuild.pp}
+

rtl/test/utverify.pp

@@ -0,0 +1,57 @@
+{******************************************}
+{  Used to check the DOS unit              }
+{------------------------------------------}
+{  SetVerify / GetVerify routine testing   }
+{******************************************}
+{$mode objfpc}
+unit utverify;
+
+interface
+
+uses punit, utrtl;
+
+implementation
+
+uses utdos, dos;
+
+{$IFDEF GO32V2}
+{$DEFINE SUPPORTS_VERIFY}
+{$ENDIF}
+
+
+Function TestVerify : TTestString;
+
+Var
+ B: Boolean;
+ s: string;
+Begin
+  Result:='';
+  B:=False;
+  if ShowDebugOutput then
+    begin
+    WriteLn('----------------------------------------------------------------------');
+    WriteLn('                       GETVERIFY/SETVERIFY                            ');
+    WriteLn('----------------------------------------------------------------------');
+    end;
+  if not CheckDosError('Initial value',0) then exit;
+  s:='Testing GetVerify...';
+  SetVerify(TRUE);
+  if not CheckDosError(S,0) then exit;
+  GetVerify(b);
+  if not CheckDosError(S,0) then exit;
+  if not AssertEquals(S+' return value',true,B) then exit;
+  s:='Testing SetVerify...';
+  SetVerify(FALSE);
+  if not CheckDosError(S,0) then exit;
+  GetVerify(b);
+  if not CheckDosError(S,0) then exit;
+  { verify actually only works under dos       }
+  { and always returns TRUE on other platforms }
+  { not anymore (JM)                           }
+  if not AssertEquals(S+' test 2',False, B) then exit;
+end;
+
+
+initialization
+  AddTest('TestVerify',@testverify,EnsureSuite('Dos'));
+end.

rtl/test/utwstrcmp.pp

@@ -0,0 +1,143 @@
+{ based on string/tester.c of glibc 2.3.6
+
+* Tester for string functions.
+   Copyright (C) 1995-2000, 2001, 2003 Free Software Foundation, Inc.
+   This file is part of the GNU C Library.
+
+   The GNU C Library is free software; you can redistribute it and/or
+   modify it under the terms of the GNU Lesser General Public
+   License as published by the Free Software Foundation; either
+   version 2.1 of the License, or (at your option) any later version.
+
+   The GNU C Library 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.  See the GNU
+   Lesser General Public License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with the GNU C Library; if not, write to the Free
+   Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
+   02111-1307 USA.  */
+}
+unit utwstrcmp;
+
+{$ifdef fpc}
+{$mode delphi}
+{$modeswitch unicodestrings}
+{$endif fpc}
+interface
+
+uses
+{$ifdef unix}
+  {$ifdef darwin}iosxwstr{$else}cwstring{$endif},
+{$endif unix}
+  SysUtils;
+
+Implementation
+
+uses punit, utrtl;
+
+Var
+  GotError : Boolean;
+
+procedure check(b: boolean; testnr: longint);
+
+begin
+  if Not GotError then
+    begin
+    GotError:=B;
+    AssertTrue('Error nr '+IntToStr(testNr),B);
+    end;
+end;
+
+Function teststricomp : String;
+begin
+  GotError:=False;
+  Result:='';
+  check(stricomp(pwidechar('a'), pwidechar('a')) = 0, 1);
+  check(stricomp(pwidechar('a'), pwidechar('A')) = 0, 2);
+  check(stricomp(pwidechar('A'), pwidechar('a')) = 0, 3);
+  check(stricomp(pwidechar('a'), pwidechar('b')) < 0, 4);
+  check(stricomp(pwidechar('c'), pwidechar('b')) > 0, 5);
+  check(stricomp('abc', 'AbC') = 0, 6);
+  check(stricomp('0123456789', '0123456789') = 0, 7);
+  check(stricomp(pwidechar(''), '0123456789') < 0, 8);
+  check(stricomp('AbC', pwidechar('')) > 0, 9);
+  check(stricomp('AbC', pwidechar('A')) > 0, 10);
+  check(stricomp('AbC', 'Ab') > 0, 11);
+  check(stricomp('AbC', 'ab') > 0, 12);
+  check(stricomp('Ab'#0'C', 'ab'#0) = 0, 13);
+end;
+
+
+Function teststrlcomp : String;
+
+begin
+  GotError:=False;
+  Result:='';
+  check (strlcomp ('', '', 0) = 0, 1); { Trivial case. }
+  check (strlcomp (pwidechar('a'), pwidechar('a'), 1) = 0, 2);       { Identity. }
+  check (strlcomp ('abc', 'abc', 3) = 0, 3);   { Multicharacter. }
+  check (strlcomp ('abc'#0, 'abcd', 4) < 0, 4);   { Length unequal. }
+  check (strlcomp ('abcd', 'abc'#0, 4) > 0, 5);
+  check (strlcomp ('abcd', 'abce', 4) < 0, 6);  { Honestly unequal. }
+  check (strlcomp ('abce', 'abcd', 4) > 0, 7);
+  check (strlcomp ('abce', 'abcd', 3) = 0, 10); { Count limited. }
+  check (strlcomp ('abce', 'abc', 3) = 0, 11);  { Count = length. }
+  check (strlcomp ('abcd', 'abce', 4) < 0, 12);  { Nudging limit. }
+  check (strlcomp ('abc', 'def', 0) = 0, 13);   { Zero count. }
+  check (strlcomp ('abc'#0'e', 'abc'#0'd', 5) = 0, 14);
+end;
+
+
+Function teststrcomp : String;
+
+begin
+  GotError:=False;
+  Result:='';
+  check (strcomp (pwidechar(''), pwidechar('')) = 0, 1);              { Trivial case. }
+  check (strcomp (pwidechar('a'), pwidechar('a')) = 0, 2);            { Identity. }
+  check (strcomp ('abc', 'abc') = 0, 3);        { Multicharacter. }
+  check (strcomp ('abc', 'abcd') < 0, 4);        { Length mismatches. }
+  check (strcomp ('abcd', 'abc') > 0, 5);
+  check (strcomp ('abcd', 'abce') < 0, 6);       { Honest miscompares. }
+  check (strcomp ('abce', 'abcd') > 0, 7);
+  check (strcomp ('abc'#0'e', 'abc'#0'd') = 0, 8);
+end;
+
+
+function teststrlicomp : string;
+
+begin
+  GotError:=False;
+  Result:='';
+  check(strlicomp(pwidechar('a'), pwidechar('a'), 1) = 0, 1);
+  check(strlicomp(pwidechar('a'), pwidechar('A'), 1) = 0, 2);
+  check(strlicomp(pwidechar('A'), pwidechar('a'), 1) = 0, 3);
+  check(strlicomp(pwidechar('a'), pwidechar('b'), 1) < 0, 4);
+  check(strlicomp(pwidechar('c'), pwidechar('b'), 1) > 0, 5);
+  check(strlicomp('abc', 'AbC', 3) = 0, 6);
+  check(strlicomp('0123456789', '0123456789', 10) = 0, 7);
+  check(strlicomp(#0'123456789', #0'123456799', 10) = 0, 8);
+  check(strlicomp(#0'bD', #0'bC', 3) = 0, 9);
+  check(strlicomp('AbC', 'A'#0#0,3) > 0, 10);
+  check(strlicomp('AbC', 'Ab'#0, 3) > 0, 11);
+  check(strlicomp('AbC', 'ab'#0, 3) > 0, 12);
+  check(strlicomp('0123456789', 'AbC', 0) = 0, 13);
+  check(strlicomp('AbC', 'abc', 1) = 0, 14);
+  check(strlicomp('AbC', 'abc', 2) = 0, 15);
+  check(strlicomp('AbC', 'abc', 3) = 0, 16);
+  check(strlicomp('AbC', 'abcd', 3) = 0, 17);
+  check(strlicomp('AbCc', 'abcd', 4) < 0, 18);
+  check(strlicomp('ADC', 'abcd', 1) = 0, 19);
+  check(strlicomp('ADC', 'abcd', 2) > 0, 20);
+  check(strlicomp('abc'#0'e', 'abc'#0'd', 5) = 0, 21);
+end;
+
+
+begin
+  SysutilsTest('UnicodeTestStrIComp',@teststricomp);
+  SysutilsTest('UnicodeTestStrLComp',@teststrlcomp);
+  SysutilsTest('UnicodeTestStrComp',@teststrcomp);
+  SysutilsTest('UnicodeTestStrLIComp',@teststrlicomp);
+end.