From dd1c06d5b5c8e763ac7d01f36ac7cd1248592705 Mon Sep 17 00:00:00 2001 From: michael Date: Wed, 12 May 2021 19:00:32 +0000 Subject: [PATCH] * Additional tests for classes/sysutils, based on bugreports --- test/tcclasses.pas | 168 ++++++++++++++++++++++++++++++++++++++++++++ test/tcstream.pp | 26 ++++++- test/tcsysutils.pas | 63 +++++++++++++++++ test/testrtl.lpi | 8 +++ test/testrtl.lpr | 7 +- 5 files changed, 269 insertions(+), 3 deletions(-) create mode 100644 test/tcclasses.pas create mode 100644 test/tcsysutils.pas diff --git a/test/tcclasses.pas b/test/tcclasses.pas new file mode 100644 index 0000000..4f02ba4 --- /dev/null +++ b/test/tcclasses.pas @@ -0,0 +1,168 @@ +unit tcclasses; + +{$mode ObjFPC} + +interface + +uses + Classes, SysUtils, fpcunit, testregistry; + +Type + + { TSortObj } + + TSortObj = Class (TObject) + Value : String; + Constructor create(aValue : string); + end; + { TTestClasses } + + TTestClasses = class(TTestCase) + private + FList: TFPList; + FStrings: TStringList; + procedure AssertSortedList; + procedure AssertSortedStrings; + public + Procedure Setup; override; + procedure TearDown; override; + property Strings : TStringList Read FStrings; + property List : TFPList Read FList; + Published + Procedure TestSort; + Procedure TestSorted; + Procedure TestSortedInverse; + Procedure TestListSort; + Procedure TestListSorted; + Procedure TestListSortedInverse; + end; + +implementation + +{ TSortObj } + +constructor TSortObj.create(aValue: string); +begin + Value:=aValue; +end; + +{ TTestClasses } + +procedure TTestClasses.Setup; +begin + Inherited; + FStrings:=TStringLisT.Create; + FList:=TFPList.Create; +end; + +procedure TTestClasses.TearDown; + +Var + I : Integer; + O : TObject; + +begin + FreeAndNil(FStrings); + For I:=0 to Flist.Count-1 do + begin + O:=TObject(Flist[i]); + FreeAndNil(O); + end; + FreeAndNil(FList); + Inherited; +end; + +procedure TTestClasses.AssertSortedStrings; + +Var + I : Integer; + +begin + For I:=0 to Strings.Count-2 do + if not (Strings[i]<=Strings[i+1]) then + Fail(Strings.Text+Format('Not sorted at %d (%s) - %d (%s)',[I,Strings[i],I+1,Strings[i+1]])); +end; + +procedure TTestClasses.TestSort; +begin + Strings.Add('beta'); + Strings.Add('delta'); + Strings.Add('alfa'); + Strings.Add('gamma'); + Strings.Sort; + AssertSortedStrings; +end; + +procedure TTestClasses.TestSorted; +begin + Strings.Add('alfa'); + Strings.Add('beta'); + Strings.Add('gamma'); + Strings.Add('delta'); + Strings.Sort; + AssertSortedStrings; +end; + +procedure TTestClasses.TestSortedInverse; +begin + Strings.Add('delta'); + Strings.Add('gamma'); + Strings.Add('beta'); + Strings.Add('alfa'); + Strings.Sort; + AssertSortedStrings; +end; + +procedure TTestClasses.AssertSortedList; + +Var + I : Integer; + +begin + For I:=0 to FList.Count-2 do + if not (TSortObj(Flist[i]).Value<=TSortObj(Flist[i+1]).Value) then + Fail(Strings.Text+Format('Not sorted at %d (%s) - %d (%s)',[I,TSortObj(Flist[i]).Value,I+1,TSortObj(Flist[i+1]).Value])); + +end; + +Function ObjSort (A,B : JSValue) : Integer; + +begin + Result:=CompareText(TSortObj(A).Value,TSortObj(B).Value); +end; + +procedure TTestClasses.TestListSort; +begin + FList.Add(TSortObj.Create('beta')); + FList.Add(TSortObj.Create('delta')); + FList.Add(TSortObj.Create('alfa')); + FList.Add(TSortObj.Create('gamma')); + FList.Sort(@ObjSort); + AssertSortedList; +end; + +procedure TTestClasses.TestListSorted; +begin + FList.Add(TSortObj.Create('alfa')); + FList.Add(TSortObj.Create('beta')); + FList.Add(TSortObj.Create('gamma')); + FList.Add(TSortObj.Create('delta')); + FList.Sort(@ObjSort); + AssertSortedList; +end; + +procedure TTestClasses.TestListSortedInverse; +begin + FList.Add(TSortObj.Create('delta')); + FList.Add(TSortObj.Create('gamma')); + FList.Add(TSortObj.Create('beta')); + FList.Add(TSortObj.Create('alfa')); + FList.Sort(@ObjSort); + AssertSortedList; +end; + +initialization + RegisterTests([TTestClasses]); + +end. + diff --git a/test/tcstream.pp b/test/tcstream.pp index dbc5f2b..4cb7d50 100644 --- a/test/tcstream.pp +++ b/test/tcstream.pp @@ -103,6 +103,8 @@ type Procedure TestDataString; Procedure TestWrite; Procedure TestRead; + Procedure TestReadString; + Procedure TestWriteString; Procedure TestCopyFrom; end; @@ -161,6 +163,28 @@ begin end; end; +procedure TTestStringStream.TestReadString; +Var + S : String; + +begin + S:='ABCDEFGH'; + DoCreate(S); + AssertEquals('2 characters','AB',Stream.ReadString(4)); + AssertEquals('Top off characters','CDEFGH',Stream.ReadString(22)); +end; + +procedure TTestStringStream.TestWriteString; +begin + DoCreate(''); + Stream.WriteString('AB'); + AssertEquals('Length 1',4,Stream.Size); + AssertEquals('Datastring 1','AB',Stream.DataString); + Stream.WriteString('CDEFGH'); + AssertEquals('Length 2',16,Stream.Size); + AssertEquals('Datastring 2','ABCDEFGH',Stream.DataString); +end; + procedure TTestStringStream.TestCopyFrom; Var @@ -861,6 +885,6 @@ end; initialization - RegisterTests([TTestStream,TTestBigendianStream,TTestStringStream]); + RegisterTests([{TTestStream,TTestBigendianStream,}TTestStringStream]); end. diff --git a/test/tcsysutils.pas b/test/tcsysutils.pas new file mode 100644 index 0000000..db4e904 --- /dev/null +++ b/test/tcsysutils.pas @@ -0,0 +1,63 @@ +unit tcsysutils; + +{$mode ObjFPC} + +interface + +uses + Classes, SysUtils, fpcunit, testregistry; + +Type + + { TTestSysutils } + + TTestSysutils = Class(TTestCase) + + private + procedure TestFormat(Fmt: String; const Args: array of const; + aResult: String); + Published + Procedure TestFormatSimple; + end; + + +implementation + +Procedure TTestSysutils.TestFormat(Fmt : String; Const Args : Array of const; aResult : String); + +begin + AssertEquals('Format >>'+Fmt+'<<',aResult,Format(Fmt,Args)); +end; + +Procedure TTestSysutils.TestFormatSimple; +begin + // Just 1 data item + TestFormat('%s', ['Hello'],'Hello'); + + // A mix of literal text and a data item + TestFormat('String = %s', ['Hello'],'String = Hello'); + + // Examples of each of the data types + TestFormat('Decimal = %d', [-123],'Decimal = -123'); +{$IFDEF PAS2JS} + TestFormat('Exponent = %e', [12345.678],'Exponent = 1.23E+4'); +{$ELSE} + TestFormat('Exponent = %e', [12345.678],'Exponent = 1.2345678000000000E+004'); +{$ENDIF} + TestFormat('Fixed = %f', [12345.678],'Fixed = 12345.68'); + TestFormat('General = %g', [12345.678],'General = 12345.678'); + TestFormat('Number = %n', [12345.678],'Number = 12,345.68'); +{$IFDEF PAS2JS} + TestFormat('Money = %m', [12345.678],'Money = $12,345.68'); +{$ELSE} + TestFormat('Money = %m', [12345.678],'Money = 12,345.68$'); +{$ENDIF} + TestFormat('String = %s', ['Hello'],'String = Hello'); + TestFormat('Unsigned decimal = %u', [123],'Unsigned decimal = 123'); + TestFormat('Hexadecimal = %x', [140],'Hexadecimal = 8C'); +end; + +initialization + RegisterTests([TTestSysUtils]); +end. + diff --git a/test/testrtl.lpi b/test/testrtl.lpi index 654dbec..bb3d815 100644 --- a/test/testrtl.lpi +++ b/test/testrtl.lpi @@ -96,6 +96,14 @@ + + + + + + + + diff --git a/test/testrtl.lpr b/test/testrtl.lpr index e6f3a6e..84fcde2 100644 --- a/test/testrtl.lpr +++ b/test/testrtl.lpr @@ -26,14 +26,17 @@ program testrtl; uses browserconsole, consoletestrunner, frmrtlrun, simplelinkedlist, -// tcstream, tccompstreaming, +// tcstream, +// tccompstreaming, // tcsyshelpers, // tcgenarrayhelper, // tcstringhelp, // tcgenericdictionary, // tcgenericlist, // tcgenericqueue, - tcgenericstack, +// tcgenericstack, +// tcsysutils, + tcclasses, strutils, sysutils;