diff --git a/packages/rtl-objpas/tests/testrunner.rtlobjpas.lpi b/packages/rtl-objpas/tests/testrunner.rtlobjpas.lpi index eb3f502500..8cbd213b73 100644 --- a/packages/rtl-objpas/tests/testrunner.rtlobjpas.lpi +++ b/packages/rtl-objpas/tests/testrunner.rtlobjpas.lpi @@ -14,6 +14,11 @@ + + + + + @@ -91,12 +96,16 @@ + + + + - + diff --git a/packages/rtl-objpas/tests/testrunner.rtlobjpas.pp b/packages/rtl-objpas/tests/testrunner.rtlobjpas.pp index a3463b6a5e..341265a31f 100644 --- a/packages/rtl-objpas/tests/testrunner.rtlobjpas.pp +++ b/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 ; diff --git a/packages/rtl-objpas/tests/utcstrutils.pp b/packages/rtl-objpas/tests/utcstrutils.pp new file mode 100644 index 0000000000..49988f0860 --- /dev/null +++ b/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. +