瀏覽代碼

+ Added tests for contnrs unit

michael 23 年之前
父節點
當前提交
ec8efd136a
共有 4 個文件被更改,包括 123 次插入6 次删除
  1. 1 1
      fcl/tests/Makefile.fpc
  2. 7 5
      fcl/tests/README
  3. 56 0
      fcl/tests/testcont.pp
  4. 59 0
      fcl/tests/testol.pp

+ 1 - 1
fcl/tests/Makefile.fpc

@@ -6,7 +6,7 @@
 programs=stringl dparser fstream mstream list threads testrtf \
          cfgtest xmldump htdump testcgi tidea \
          b64test b64test2 b64enc b64dec restest testz testz2 \
-         istream doecho
+         istream doecho testol testcont
 programs_win32=showver testproc
 programs_linux=sockcli isockcli dsockcli socksvr isocksvr dsocksvr
 rst=restest

+ 7 - 5
fcl/tests/README

@@ -38,9 +38,11 @@ istream.pp   testprogram for input/output streams.
 testproc.pp  testprogram for TProcess object. Needs doecho to be compiled
              also.
 socksvr.pp   Unix socket server application. Tests TUnixServer in ssockets.
-isocksvr.pp   Inet socket server application. Tests TInetServer in ssockets.
-dsocksvr.pp   Unix socket server application. Tests ssockets.
+isocksvr.pp  Inet socket server application. Tests TInetServer in ssockets.
+dsocksvr.pp  Unix socket server application. Tests ssockets.
 sockcli.pp   Unix socket client application. Tests TUnixStream in ssockets.
-isockcli.pp   Inet socket server application. Tests TInetStream in ssockets.
-dsockcli.pp   Dual socket server application. Tests ssockets.
-sstream.pp    Tests TStringStream object.
+isockcli.pp  Inet socket server application. Tests TInetStream in ssockets.
+dsockcli.pp  Dual socket server application. Tests ssockets.
+sstream.pp   Tests TStringStream object.
+testol.pp    Tests TObjectList in contnrs. (MVC)
+testcont.pp  Tests TStack/TQueue in contnrs. (MVC)

+ 56 - 0
fcl/tests/testcont.pp

@@ -0,0 +1,56 @@
+program testcont;
+
+{$mode objfpc}
+
+uses contnrs;
+
+Type
+  TTestObject = Class(TObject)
+    FID : Integer;
+    Fmsg : String;
+    Constructor Create (ID : INteger; Msg : String);
+    Procedure Print;
+  end;
+
+Constructor TTestObject.Create (ID : INteger; Msg : String);
+
+begin
+  FID:=ID;
+  FMsg:=Msg;
+end;
+
+procedure TTestObject.Print;
+
+begin
+  Writeln(FID,' (',FMsg,')');
+end;
+
+Var
+   S : TOrderedList;
+   O : TTEstObject;
+   I : Integer;
+begin
+//   S:=TObjectStack.Create;
+   S:=TObjectQueue.Create;
+   For I:=1 to 10 do
+     S.Push(TTestObject.Create(I,''));
+   Writeln('Popping list');
+   Repeat
+     O:=TTestObject(S.Pop);
+     If O<>Nil then
+       begin
+       Write('Popped : ');
+       O.Print;
+       Write (S.Count,' elements left. ');
+       O:=TTestObject(S.Peek);
+       If (O<>NIl) then
+         begin
+         Write('Next element is : ');
+         O.Print;
+         end
+       else
+         Writeln;
+       end;
+   Until (O=Nil);
+   Writeln('Popped stack');
+end.

+ 59 - 0
fcl/tests/testol.pp

@@ -0,0 +1,59 @@
+program testol;
+
+{$mode objfpc}
+
+uses sysutils,contnrs;
+
+Type
+  TTestObject = Class(TObject)
+    FID : Integer;
+    Fmsg : String;
+    Constructor Create (ID : INteger; Msg : String);
+    Destructor Destroy; override;
+    Procedure Print;
+  end;
+
+Constructor TTestObject.Create (ID : INteger; Msg : String);
+
+begin
+  FID:=ID;
+  FMsg:=Msg;
+end;
+
+procedure TTestObject.Print;
+
+begin
+  Writeln(FID,' (',FMsg,')');
+end;
+
+Destructor TTEstObject.Destroy;
+
+begin
+  Write('Destroying : ');
+  Print;
+end;
+
+Const
+  NO = 10;
+
+Var
+  S : TObjectList;
+  I : Integer;
+
+begin
+  S:=TobjectList.Create;
+  For I:=1 to NO do
+    S.add(TTestObject.Create(I,'Item '+intToStr(i)));
+  Writeln('Counting objects:');
+  For I:=0 to S.Count-1 do
+    (S[i] as TTestObject).Print;
+  Writeln('Shifting..');
+  For I:=1 to 5 do
+    S.Move(9,0);
+  Writeln('Counting objects:');
+  For I:=0 to S.Count-1 do
+    (S[i] as TTestObject).Print;
+  Writeln('Deleting objects:');
+  For I:=S.Count-1 downto 0 do
+    S.Delete(I);
+end.