mirror of
https://gitlab.com/freepascal.org/fpc/pas2js.git
synced 2025-04-05 00:47:47 +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 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
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"/>
|
||||
<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>
|
||||
|
@ -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;
|
||||
|
||||
|
Loading…
Reference in New Issue
Block a user