mirror of
https://gitlab.com/freepascal.org/fpc/pas2js.git
synced 2025-09-01 21:20:13 +02:00
* Additional tests for classes/sysutils, based on bugreports
This commit is contained in:
parent
270126b868
commit
dd1c06d5b5
168
test/tcclasses.pas
Normal file
168
test/tcclasses.pas
Normal 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.
|
||||||
|
|
@ -103,6 +103,8 @@ type
|
|||||||
Procedure TestDataString;
|
Procedure TestDataString;
|
||||||
Procedure TestWrite;
|
Procedure TestWrite;
|
||||||
Procedure TestRead;
|
Procedure TestRead;
|
||||||
|
Procedure TestReadString;
|
||||||
|
Procedure TestWriteString;
|
||||||
Procedure TestCopyFrom;
|
Procedure TestCopyFrom;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
@ -161,6 +163,28 @@ begin
|
|||||||
end;
|
end;
|
||||||
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;
|
procedure TTestStringStream.TestCopyFrom;
|
||||||
|
|
||||||
Var
|
Var
|
||||||
@ -861,6 +885,6 @@ end;
|
|||||||
|
|
||||||
|
|
||||||
initialization
|
initialization
|
||||||
RegisterTests([TTestStream,TTestBigendianStream,TTestStringStream]);
|
RegisterTests([{TTestStream,TTestBigendianStream,}TTestStringStream]);
|
||||||
end.
|
end.
|
||||||
|
|
||||||
|
63
test/tcsysutils.pas
Normal file
63
test/tcsysutils.pas
Normal 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.
|
||||||
|
|
@ -96,6 +96,14 @@
|
|||||||
<Filename Value="tcgenericstack.pp"/>
|
<Filename Value="tcgenericstack.pp"/>
|
||||||
<IsPartOfProject Value="True"/>
|
<IsPartOfProject Value="True"/>
|
||||||
</Unit>
|
</Unit>
|
||||||
|
<Unit>
|
||||||
|
<Filename Value="tcsysutils.pas"/>
|
||||||
|
<IsPartOfProject Value="True"/>
|
||||||
|
</Unit>
|
||||||
|
<Unit>
|
||||||
|
<Filename Value="tcclasses.pas"/>
|
||||||
|
<IsPartOfProject Value="True"/>
|
||||||
|
</Unit>
|
||||||
</Units>
|
</Units>
|
||||||
</ProjectOptions>
|
</ProjectOptions>
|
||||||
<CompilerOptions>
|
<CompilerOptions>
|
||||||
|
@ -26,14 +26,17 @@ program testrtl;
|
|||||||
|
|
||||||
uses
|
uses
|
||||||
browserconsole, consoletestrunner, frmrtlrun, simplelinkedlist,
|
browserconsole, consoletestrunner, frmrtlrun, simplelinkedlist,
|
||||||
// tcstream, tccompstreaming,
|
// tcstream,
|
||||||
|
// tccompstreaming,
|
||||||
// tcsyshelpers,
|
// tcsyshelpers,
|
||||||
// tcgenarrayhelper,
|
// tcgenarrayhelper,
|
||||||
// tcstringhelp,
|
// tcstringhelp,
|
||||||
// tcgenericdictionary,
|
// tcgenericdictionary,
|
||||||
// tcgenericlist,
|
// tcgenericlist,
|
||||||
// tcgenericqueue,
|
// tcgenericqueue,
|
||||||
tcgenericstack,
|
// tcgenericstack,
|
||||||
|
// tcsysutils,
|
||||||
|
tcclasses,
|
||||||
strutils,
|
strutils,
|
||||||
sysutils;
|
sysutils;
|
||||||
|
|
||||||
|
Loading…
Reference in New Issue
Block a user