Browse Source

* Additional tests for classes/sysutils, based on bugreports

michael 4 years ago
parent
commit
dd1c06d5b5
5 changed files with 269 additions and 3 deletions
  1. 168 0
      test/tcclasses.pas
  2. 25 1
      test/tcstream.pp
  3. 63 0
      test/tcsysutils.pas
  4. 8 0
      test/testrtl.lpi
  5. 5 2
      test/testrtl.lpr

+ 168 - 0
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.
+

+ 25 - 1
test/tcstream.pp

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

+ 8 - 0
test/testrtl.lpi

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

+ 5 - 2
test/testrtl.lpr

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