* Additional tests for classes/sysutils, based on bugreports

This commit is contained in:
michael 2021-05-12 19:00:32 +00:00
parent 270126b868
commit dd1c06d5b5
5 changed files with 269 additions and 3 deletions

168
test/tcclasses.pas Normal file
View File

@ -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.

View File

@ -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.

63
test/tcsysutils.pas Normal file
View File

@ -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.

View File

@ -96,6 +96,14 @@
<Filename Value="tcgenericstack.pp"/>
<IsPartOfProject Value="True"/>
</Unit>
<Unit>
<Filename Value="tcsysutils.pas"/>
<IsPartOfProject Value="True"/>
</Unit>
<Unit>
<Filename Value="tcclasses.pas"/>
<IsPartOfProject Value="True"/>
</Unit>
</Units>
</ProjectOptions>
<CompilerOptions>

View File

@ -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;