* Remove testsuite again

git-svn-id: trunk@43431 -

.gitattributes

@@ -11649,57 +11649,6 @@ 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

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

rtl/test/punit.cfg

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

rtl/test/punit.pp

@@ -1,3120 +0,0 @@
-{
-    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

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

rtl/test/testpunit2.pp

@@ -1,565 +0,0 @@
-{$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

@@ -1,17 +0,0 @@
-{$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

@@ -1,224 +0,0 @@
-<?xml version="1.0" encoding="UTF-8"?>
-<CONFIG>
-  <ProjectOptions>
-    <Version Value="12"/>
-    <General>
-      <Flags>
-        <SaveOnlyProjectUnits Value="True"/>
-        <MainUnitHasCreateFormStatements Value="False"/>
-        <MainUnitHasTitleStatement Value="False"/>
-        <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

@@ -1,22 +0,0 @@
-{$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

@@ -1,20 +0,0 @@
-  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

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

rtl/test/utastrcmp.pp

@@ -1,171 +0,0 @@
-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

@@ -1,76 +0,0 @@
-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

@@ -1,1390 +0,0 @@
-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

@@ -1,557 +0,0 @@
-{ %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

@@ -1,156 +0,0 @@
-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

@@ -1,46 +0,0 @@
-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

@@ -1,157 +0,0 @@
-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

@@ -1,75 +0,0 @@
-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

@@ -1,82 +0,0 @@
-{******************************************}
-{  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

@@ -1,74 +0,0 @@
-{$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

@@ -1,140 +0,0 @@
-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

@@ -1,45 +0,0 @@
-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

@@ -1,305 +0,0 @@
-{******************************************}
-{  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

@@ -1,476 +0,0 @@
-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

@@ -1,275 +0,0 @@
-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

@@ -1,222 +0,0 @@
-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

@@ -1,40 +0,0 @@
-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

@@ -1,188 +0,0 @@
-{$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

@@ -1,120 +0,0 @@
-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

@@ -1,226 +0,0 @@
-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

@@ -1,23 +0,0 @@
-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

@@ -1,75 +0,0 @@
-{
-    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

@@ -1,19 +0,0 @@
-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

@@ -1,51 +0,0 @@
-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

@@ -1,222 +0,0 @@
-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

@@ -1,31 +0,0 @@
-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

@@ -1,142 +0,0 @@
-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

@@ -1,51 +0,0 @@
-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

@@ -1,1034 +0,0 @@
-{$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

@@ -1,1264 +0,0 @@
-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

@@ -1,147 +0,0 @@
-{ 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

@@ -1,97 +0,0 @@
-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

@@ -1,158 +0,0 @@
-{$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

@@ -1,1883 +0,0 @@
-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

@@ -1,136 +0,0 @@
-{$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

@@ -1,143 +0,0 @@
-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

@@ -1,132 +0,0 @@
-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

@@ -1,113 +0,0 @@
-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

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

rtl/test/utverify.pp

@@ -1,57 +0,0 @@
-{******************************************}
-{  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

@@ -1,143 +0,0 @@
-{ 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.