* Test from merge request !312

packages/rtl-objpas/tests/testrunner.rtlobjpas.lpi

@@ -14,6 +14,11 @@
       <UseAppBundle Value="False"/>
       <ResourceType Value="res"/>
     </General>
+    <CustomData Count="3">
+      <Item0 Name="OpenAPIBase"/>
+      <Item1 Name="OpenAPIConfig"/>
+      <Item2 Name="OpenAPIFile"/>
+    </CustomData>
     <BuildModes>
       <Item Name="Default" Default="True"/>
     </BuildModes>
@@ -91,12 +96,16 @@
         <Filename Value="tests.rtti.attrtypes2.pp"/>
         <IsPartOfProject Value="True"/>
       </Unit>
+      <Unit>
+        <Filename Value="utcstrutils.pp"/>
+        <IsPartOfProject Value="True"/>
+      </Unit>
     </Units>
   </ProjectOptions>
   <CompilerOptions>
     <Version Value="11"/>
     <Target>
-      <Filename Value="testrunner.rtlobjpas"/>
+      <Filename Value="testrunner.rtlobjpas.js" ApplyConventions="False"/>
     </Target>
     <SearchPaths>
       <IncludeFiles Value="$(ProjOutDir)"/>

packages/rtl-objpas/tests/testrunner.rtlobjpas.pp

@@ -55,8 +55,9 @@ uses
   utcvector,
   utcquaternion
 {$IFDEF HAS_MONITOR}
-  ,utcfpmonitor, tests.rtti.attrtypes2
+  ,utcfpmonitor, tests.rtti.attrtypes2,
 {$ENDIF}
+   utcStrUtils
   ;
 
 

packages/rtl-objpas/tests/utcstrutils.pp

@@ -0,0 +1,111 @@
+unit utcstrutils;
+
+{$mode ObjFPC}{$H+}
+
+interface
+
+uses
+  sysutils, strutils, fpcunit, testregistry;
+
+Type
+
+  { TTestStrUtils }
+
+  TTestStrUtils = class(TTestCase)
+  Published
+    Procedure TestNaturalCompareText;
+
+  end;
+
+implementation
+
+{ TTestStrUtils }
+
+type
+  CaseRec = record
+    a, b: string;
+    expect: int8;
+  end;
+
+const
+  Cases: array[0 .. 4] of CaseRec = (
+      (a: '100000000000000000000'; b: '100000000000000000001'; expect: -1),
+      (a: ' 10 hi';                b: '010 hi';                expect:  0),
+      (a: 'score: 10';             b: 'score:010';             expect:  0),
+      (a: '9';                     b: ' ';                     expect: -1),
+      (a: 'A';                     b: '';                      expect: +1)
+  );
+
+procedure TTestStrUtils.TestNaturalCompareText;
+
+var
+  somethingFailed: boolean = false;
+
+  function RandomString: string;
+
+  const
+    TextChars = 'abAB ';
+    NumberChars = '012';
+  var
+    iComp, iSym: SizeInt;
+  begin
+    result := '';
+    for iComp := 0 to random(5) do
+      case random(2) of
+        0:
+          for iSym := 0 to random(3) do
+            result += TextChars[1 + random(length(TextChars))];
+        else
+          for iSym := 0 to random(3) do
+            result += NumberChars[1 + random(length(NumberChars))];
+      end;
+  end;
+const
+  NFuzzStrings = 200;
+
+var
+  cs: CaseRec;
+  got, ab: integer;
+  desc : string;
+  fuzz: array of string;
+  i, iA, iB, iC: SizeInt;
+  comparisons: array[0 .. NFuzzStrings - 1, 0 .. NFuzzStrings - 1] of int8;
+
+begin
+  for cs in Cases do
+  begin
+    got := NaturalCompareText(cs.a, cs.b);
+    Desc:=Format('a = ''%s'', b = ''%s'' ',[cs.a, cs.b]);
+    AssertEquals(Desc,cs.expect,got);
+  end;
+  SetLength(fuzz, NFuzzStrings);
+  fuzz[0] := '';
+  fuzz[1] := ' ';
+  for i := 2 to High(fuzz) do
+    fuzz[i] := RandomString;
+
+  for iA := 0 to High(fuzz) do
+    for iB := iA to High(fuzz) do
+    begin
+      comparisons[iA, iB] := NaturalCompareText(fuzz[iA], fuzz[iB]);
+      comparisons[iB, iA] := NaturalCompareText(fuzz[iB], fuzz[iA]);
+      Desc:=Format('Antisymmetry: a= ''%s'', b= ''%s'' ',[fuzz[iA],fuzz[iB]]);
+      AssertEquals('Expect '+Desc, -comparisons[iB, iA], comparisons[iA, iB]);
+    end;
+
+  for iA := 0 to High(fuzz) do
+    for iB := iA to High(fuzz) do
+    begin
+      ab := comparisons[iA, iB];
+      for iC := 0 to High(fuzz) do
+        begin
+          Desc:=Format('Transitivity: a= ''%s'', b= ''%s'' , c= ''%s'' ',[fuzz[iA], fuzz[iB], fuzz[iC]]);
+          AssertFalse(Desc,(comparisons[iB, iC] = ab) and (comparisons[iA, iC] <> ab));
+        end;
+    end;
+end;
+
+initialization
+  RegisterTest(TTestStrUtils);
+end.
+