+ more tests

tests/README

@@ -34,3 +34,9 @@ tf000001.pp       stupid example that creates a GPF sometimes
 tf000002.pp       tests that use of a type as a member of an expression is not possible
 
 to000000.pp       shows when uncertain optimizations can cause wrong code
+
+testcrt.pp        test crt unit functions
+testdos.pp        test dos unit functions
+testset.pp        test set functions
+testheap.pp       test heap functions
+teststr.pp        test string functions and speed

tests/testcrt.pp

@@ -0,0 +1,105 @@
+{
+  $Id$
+  
+  Program to test CRT unit by Mark May.
+  Only standard TP functions are tested (except WhereX, WhereY).
+}
+program testcrt;
+
+uses crt;
+var
+  i,j : longint;
+  fil : text;
+  c   : char;
+begin
+{Window/AssignCrt/GotoXY}
+  clrscr;
+  writeln ('This should be on a clear screen...');
+  gotoxy (10,10);
+  writeln ('(10,10) is the coordinate of this sentence');
+  window  (10,11,70,22);
+  writeln ('Window (10,11,70,22) executed.');
+  writeln ('Sending some output to a file, assigned to crt.');
+  assigncrt ( fil);
+  rewrite (fil);
+  writeln (fil,'This was written to the file, assigned to the crt.');
+  writeln (fil,'01234567890123456789012345678901234567890123456789012345678901234567890');
+  close (fil);
+  writeln ('The above too, but this not any more');
+  write ('Press any key to continue');
+  c:=readkey;
+  clrscr;
+  writeln ('the small window should have been cleared.');
+  write ('Press any key to continue');
+  c:=readkey;
+
+{Colors/KeyPressed}
+  window (1,1,80,25);
+  clrscr;
+  writeln ('Color testing :');
+  writeln;
+  highvideo;
+  write ('highlighted text');
+  normvideo;
+  write (' normal text ');
+  lowvideo;
+  writeln ('And low text.');
+  writeln;
+  writeln ('Color chart :');
+  for i:=black to lightgray do
+   begin
+     textbackground (i);
+     textcolor (0);
+     write ('backgr. : ',i:2,' ');
+     for j:= black to white do
+      begin
+        textcolor (j);
+        write (' ',j:2,' ');
+      end;
+     writeln;
+   end;
+  normvideo;
+  writeln ('The same, with blinking foreground.');
+  for i:=black to lightgray do
+   begin
+     textbackground (i);
+     textcolor (0);
+     write ('backgr. : ',i:2,' ');
+     for j:= black to white do
+      begin
+        textcolor (j+128);
+        write (' ',j:2,' ');
+      end;
+     writeln;
+   end;
+  textcolor (white);
+  textbackground (black);
+  writeln;
+  writeln ('press any key to continue');
+  repeat until keypressed;
+  c:=readkey;
+
+{ClrEol/DelLine/InsLine}
+  clrscr;
+  writeln ('Testing some line functions :');
+  writeln ;
+  writeln ('This line should become blank after you press enter');
+  writeln;
+  writeln ('The following line should then become blank from column 10');
+  writeln ('12345678901234567890');
+  writeln;
+  writeln ('This line should dissapear.');
+  writeln;
+  writeln ('Between this line and the next, an empty line should appear.');
+  writeln ('This is the next line, above which the empty one should appear');
+  writeln;
+  write ('Press any key to observe the predicted effects.');
+  readkey;
+  gotoxy(1,3);clreol;
+  gotoxy (10,6);clreol;
+  gotoxy (1,8);delline;
+  gotoxy (1,10); insline;
+  gotoxy (17,13); clreol;
+  writeln ('end.');
+  readkey;
+end.

tests/testdos.pp

@@ -0,0 +1,140 @@
+{
+  $Id$
+  
+  Program to test DOS unit by Peter Vreman.
+  Only main TP functions are tested (nothing with Interrupts/Break/Verify).
+}
+program testdos;
+uses dos;
+
+procedure TestInfo;
+var
+  dt    : DateTime;
+  ptime : longint;
+  wday,
+  HSecs : integer;
+begin
+  writeln;
+  writeln('Info Functions');
+  writeln('**************');
+  writeln('Dosversion     : ',lo(DosVersion),'.',hi(DosVersion));
+  GetDate(Dt.Year,Dt.Month,Dt.Day,wday);
+  writeln('Current Date   : ',Dt.Month,'-',Dt.Day,'-',Dt.Year,' weekday ',wday);
+  GetTime(Dt.Hour,Dt.Min,Dt.Sec,HSecs);
+  writeln('Current Time   : ',Dt.Hour,':',Dt.Min,':',Dt.Sec,' hsecs ',HSecs);
+  PackTime(Dt,ptime);
+  writeln('Packed like dos: ',ptime);
+  UnpackTime(ptime,DT);
+  writeln('Unpacked again : ',Dt.Month,'-',Dt.Day,'-',Dt.Year,'  ',Dt.Hour,':',Dt.Min,':',Dt.Sec);
+  writeln;
+  write('Press Enter');
+  Readln;
+end;
+
+
+procedure TestEnvironment;
+var
+  i : longint;
+begin
+  writeln;
+  writeln('Environment Functions');
+  writeln('*********************');
+  writeln('Amount of environment strings : ',EnvCount);
+  writeln('GetEnv TERM : ',GetEnv('TERM'));
+  writeln('GetEnv HOST : ',GetEnv('HOST'));
+  writeln('GetEnv SHELL: ',GetEnv('SHELL'));
+  write('Press Enter for all Environment Strings using EnvStr()');
+  Readln;
+  for i:=1to EnvCount do
+   writeln(EnvStr(i));
+  write('Press Enter');
+  Readln;
+end;
+
+
+procedure TestExec;
+begin
+  writeln;
+  writeln('Exec Functions');
+  writeln('**************');
+  write('Press Enter for an Exec of ''ls -la''');
+  Readln;
+  Exec('pine','');
+  write('Press Enter');
+  Readln;
+end;
+
+
+
+procedure TestDisk;
+var
+  Dir : SearchRec;
+begin
+  writeln;
+  writeln('Disk Functions');
+  writeln('**************');
+  writeln('DiskFree 0 : ',DiskFree(0));
+  writeln('DiskSize 0 : ',DiskSize(0));
+  writeln('DiskSize 1 : ',DiskSize(1));
+{$IFDEF LINUX}
+  AddDisk('/fd0');
+  writeln('DiskSize 4 : ',DiskSize(4));
+{$ENDIF}
+  write('Press Enter for FindFirst/FindNext Test');
+  Readln;
+
+  FindFirst('*.*',$20,Dir);
+  while (DosError=0) do
+   begin
+     Writeln(dir.Name,' ',dir.Size);
+     FindNext(Dir);
+   end;
+  write('Press Enter');
+  Readln;
+end;
+
+
+
+procedure TestFile;
+var
+  test,
+  name,dir,ext : string;
+begin
+  writeln;
+  writeln('File(name) Functions');
+  writeln('********************');
+  test:='/usr/local/bin/ppc.so';
+  writeln('FSplit(',test,')');
+  FSplit(test,dir,name,ext);
+  writeln('dir: ',dir,' name: ',name,' ext: ',ext);
+  test:='/usr/bin.1/ppc';
+  writeln('FSplit(',test,')');
+  FSplit(test,dir,name,ext);
+  writeln('dir: ',dir,' name: ',name,' ext: ',ext);
+  test:='mtools.tar.gz';
+  writeln('FSplit(',test,')');
+  FSplit(test,dir,name,ext);
+  writeln('dir: ',dir,' name: ',name,' ext: ',ext);
+
+  Writeln('Expanded dos.pp                 : ',FExpand('dos.pp'));
+  Writeln('Expanded ../dos.pp              : ',FExpand('../dos.pp'));
+  Writeln('Expanded /usr/local/dos.pp      : ',FExpand('/usr/local/dos.pp'));
+  Writeln('Expanded ../dos/./../././dos.pp : ',FExpand('../dos/./../././dos.pp'));
+
+  test:='../;/usr/;/usr/bin/;/usr/bin;/bin/';
+  Writeln('FSearch ls: ',FSearch('ls',test));
+
+  write('Press Enter');
+  Readln;
+end;
+
+
+
+begin
+  TestInfo;
+  TestEnvironment;
+  TestExec;
+  TestDisk;
+  TestFile;
+end.
+

tests/testheap.pp

@@ -0,0 +1,170 @@
+{
+  $Id$
+  
+  Program to test heap functions, timing doesn't work
+}
+PROGRAM TestHeap;
+
+Procedure InitMSTimer;
+begin
+end;
+
+
+
+{Get MS Timer}
+Function MSTimer:longint;
+begin
+  MSTimer:=0;
+end;
+
+
+VAR Dummy,Start, LoopTime,LoopTime2: LONGINT;
+    Delta, TotalTime: LONGINT;
+    L,Choice,K,T: WORD;
+    BlkPtr:  ARRAY [1..1000] OF POINTER;
+    BlkSize: ARRAY [1..1000] OF WORD;
+    Permutation: ARRAY [1..1000] OF WORD;
+
+BEGIN
+  INitMSTimer;
+   WriteLn ('Test of TP heap functions');
+   WriteLn;
+   TotalTime := 0;
+   RandSeed := 997;
+   WriteLn ('MaxAvail: ', MaxAvail, '   MemAvail: ', MemAvail);
+   Start :=MSTimer;
+   FOR L := 1 TO 1000 DO BEGIN
+   END;
+   LoopTime := MSTimer-Start;
+   FOR L := 1 TO 1000 DO BEGIN
+      BlkSize [L] := Random (512) + 1;
+   END;
+   Write ('Allocating 1000 blocks at the end of the heap: ');
+   Start := MSTImer;
+   FOR L := 1 TO 1000 DO BEGIN
+      GetMem (BlkPtr [L], BlkSize [L]);
+   END;
+   Delta := MSTimer-Start-LoopTime;
+   Inc (TotalTime, Delta);
+   WriteLn (Delta:5, ' ms');
+   WriteLn ('MaxAvail: ', MaxAvail, '   MemAvail: ', MemAvail);
+   Write ('Deallocating same 1000 blocks in reverse order:');
+   Start := MSTimer;
+   FOR L := 1 TO 1000 DO BEGIN
+      FreeMem (BlkPtr [L], BlkSize [L]);
+   END;
+   Delta := MSTimer-Start-LoopTime;
+   Inc (TotalTime, Delta);
+   WriteLn (Delta:5, ' ms');
+   WriteLn ('MaxAvail: ', MaxAvail, '   MemAvail: ', MemAvail);
+   Write ('Allocating 1000 blocks at the end of the heap: ');
+   Start := MSTimer;
+   FOR L := 1 TO 1000 DO BEGIN
+      GetMem (BlkPtr [L], BlkSize [L]);
+   END;
+   Delta := MSTimer-Start-LoopTime;
+   Inc (TotalTime, Delta);
+   WriteLn (Delta:5, ' ms');
+   WriteLn ('MaxAvail: ', MaxAvail, '   MemAvail: ', MemAvail);
+   FOR L := 1 TO 1000 DO BEGIN
+      Permutation [L] := L;
+   END;
+   Start := MSTimer;
+   FOR L := 1000 DOWNTO 1 DO BEGIN
+      Choice := Random (L)+1;
+      K := Permutation [Choice];
+      Permutation [Choice] := Permutation [L];
+   END;
+   LoopTime2 := MSTimer - Start;
+   FOR L := 1 TO 1000 DO BEGIN
+      Permutation [L] := L;
+   END;
+   Write ('Deallocating same 1000 blocks at random:       ');
+   Start := MSTimer;
+   FOR L := 1000 DOWNTO 1 DO BEGIN
+      Choice := Random (L)+1;
+      K := Permutation [Choice];
+      Permutation [Choice] := Permutation [L];
+      FreeMem (BlkPtr [K], BlkSize [K]);
+   END;
+   Delta := MSTimer - Start - LoopTime2;
+   Inc (TotalTime, Delta);
+   WriteLn (Delta:5, ' ms');
+   WriteLn ('MaxAvail: ', MaxAvail, '   MemAvail: ', MemAvail);
+   Write ('Allocating 1000 blocks at the end of the heap: ');
+   Start := MSTimer;
+   FOR L := 1 TO 1000 DO BEGIN
+      GetMem (BlkPtr [L], BlkSize [L]);
+   END;
+   Delta := MSTimer-Start-LoopTime;
+   Inc (TotalTime, Delta);
+   WriteLn (Delta:5, ' ms');
+   WriteLn ('MaxAvail: ', MaxAvail, '   MemAvail: ', MemAvail);
+   FOR L := 1 TO 1000 DO BEGIN
+      Permutation [L] := L;
+   END;
+   Start := MSTimer;
+   FOR L := 1000 DOWNTO 1 DO BEGIN
+      Choice := Random (L)+1;
+      K := Permutation [Choice];
+      T:= Permutation [L];
+      Permutation [L] := Permutation [Choice];
+      Permutation [Choice] := T;
+   END;
+   LoopTime2 := MSTimer - Start;
+   FOR L := 1 TO 1000 DO BEGIN
+      Permutation [L] := L;
+   END;
+   Write ('Deallocating 500 blocks at random:             ');
+   Start := MSTimer;
+   FOR L := 1000 DOWNTO 501 DO BEGIN
+      Choice := Random (L)+1;
+      K := Permutation [Choice];
+      T:= Permutation [L];
+      Permutation [L] := Permutation [Choice];
+      Permutation [Choice] := T;
+      SYSTEM.FreeMem (BlkPtr [K], BlkSize [K]);
+   END;
+   Delta := MSTimer-Start-LoopTime2;
+   Inc (TotalTime, Delta);
+   WriteLn (Delta:5, ' ms');
+   WriteLn ('MaxAvail: ', MaxAvail, '   MemAvail: ', MemAvail);
+   Start := MSTimer;
+   FOR L := 1 TO 1000 DO BEGIN
+      Dummy := MaxAvail;
+   END;
+   Delta := MSTimer-Start;
+   Inc (TotalTime, (Delta + 5) DIV 10);
+   WriteLn ('1000 calls to MaxAvail:                        ', Delta:5, ' ms');
+   Start := MSTimer;
+   FOR L := 1 TO 1000 DO BEGIN
+      Dummy := MemAvail;
+   END;
+   Delta := MSTimer - Start;
+   Inc (TotalTime, (Delta + 5) DIV 10);
+   WriteLn ('1000 calls to MemAvail:                        ', Delta:5, ' ms');
+   WriteLn ('MaxAvail: ', MaxAvail, '   MemAvail: ', MemAvail);
+   Write ('Reallocating deallocated 500 blocks at random: ');
+   Start := MSTimer;
+   FOR L := 501 TO 1000 DO BEGIN
+      GetMem (BlkPtr [Permutation [L]], BlkSize [Permutation [L]]);
+   END;
+   Delta := MSTimer-Start-LoopTime;
+   Inc (TotalTime, Delta);
+   WriteLn (Delta:5, ' ms');
+   WriteLn ('MaxAvail: ', MaxAvail, '   MemAvail: ', MemAvail);
+   Write ('Deallocating all 1000 blocks at random:        ');
+   Start := MSTimer;
+   FOR L := 1000 DOWNTO 1 DO BEGIN
+      FreeMem (BlkPtr [L], BlkSize [L]);
+   END;
+   Delta := MSTimer-Start-LoopTime;
+   Inc (TotalTime, Delta);
+   WriteLn (Delta:5, ' ms');
+   WriteLn ('MaxAvail: ', MaxAvail, '   MemAvail: ', MemAvail);
+   WriteLn;
+   WriteLn ('Total time for benchmark: ', TotalTime, ' ms');
+END.
+
+
+

tests/testset.pp

@@ -0,0 +1,162 @@
+{
+  $Id$
+  
+  Program to test set functions
+}
+program TestSet;
+
+Procedure InitMSTimer;
+begin
+end;
+
+
+{Get MS Timer}
+Function MSTimer:longint;
+begin
+  MSTimer:=0;
+end;
+
+
+const
+  Lval=2000;
+VAR Box1, Box2:         ARRAY [0..255] OF BYTE;
+    OneWOTwo, TwoWOOne,
+    UnionSet, InterSet,
+    Set1, Set2, Set3:   SET OF BYTE;
+    K, MaxNr, L,
+    N, Low, Hi:         INTEGER;
+    Start:              LONGINT;
+
+begin
+   WriteLn ('Set operators functional and speed test');
+   WriteLn;
+
+   RandSeed := 17;
+
+   for L := 0 TO 255 DO begin
+      Box1 [L] := L;
+   end;
+   MaxNr := 255;
+   for L := 0 TO 255 DO begin
+      K := Random (MaxNr+1);
+      Box2 [L] := Box1 [K];
+      Box1 [K] := Box1 [MaxNr];
+      Dec (MaxNr);
+   end;
+
+   Start :=MSTimer;
+
+   Set1 := [];
+   Set2 := [];
+   for L := 0 TO 255 DO begin
+      Set1 := Set1 + [Box2 [L]];
+      if NOT (Box2 [L] IN Set1) then begin
+         WriteLn ('error in AddElem or InSet functions');
+         Halt;
+         end;
+      Set2 := Set2 + [Box2 [L]] + [];
+   end;
+
+   if (Set1 <> Set2) OR (NOT (Set1 <= Set2)) OR (NOT (Set1 >= Set2)) then begin
+      WriteLn ('error in relational operators 1');
+      Halt;
+      end;
+
+   for L := 0 TO 255 DO begin
+      Set1 := Set1 - [Box2 [L]];
+      if Box2 [L] IN Set1 then begin
+         WriteLn ('error in set difference 1');
+         Halt;
+         end;
+   end;
+
+   if Set1 <> [] then begin
+      WriteLn ('error in set difference 2');
+      Halt;
+      end;
+
+   for L := 1 TO LVal DO begin
+      REPEAT
+         Low := Random (256);
+         Hi  := Random (256);
+      UNTIL Low <= Hi;
+
+      Set1 := [];
+      Set1 := Set1 + [Low..Hi];
+      for K := 0 TO 255 DO begin
+         if (K IN Set1) AND ((K < Low) OR (K > Hi)) then begin
+            WriteLn ('wrong set inclusion in add range');
+            Halt;
+            end;
+         if (NOT (K IN Set1)) AND ((K >= Low) AND (K <= Hi)) then begin
+            WriteLn ('wrong set exclusion in add range');
+            Halt;
+            end;
+      end;
+   end;
+
+   for L := 1 TO LVal DO begin
+      Set1 := [];
+      Set2 := [];
+
+      for K := 1 TO 10 DO begin
+         Low := Random (256);
+         Hi  := Random (256);
+         Set2:= Set1 + [Low..Hi];
+         if (Set1 >= Set2) AND (Set1 <> Set2) then begin
+            WriteLn ('error in relational operators 2');
+            Halt;
+            end;
+         if NOT (Set1 <= Set2) then begin
+            WriteLn ('error in relational operators 3');
+            Halt;
+            end;
+         Set1 := Set2;
+
+      end;
+   end;
+
+   for L := 1 TO LVal DO begin
+      Set1 := [];
+      for K := 1 TO 10 DO begin
+         Low := Random (256);
+         Hi  := Random (256);
+         Set1:= Set1 + [Low..Hi];
+      end;
+      Set2 := [];
+      for K := 1 TO 10 DO begin
+         Low := Random (256);
+         Hi  := Random (256);
+         Set2:= Set2 + [Low..Hi];
+      end;
+
+      OneWOTwo := Set1 - Set2;
+      TwoWOOne := Set2 - Set1;
+      InterSet := Set1 * Set2;
+      UnionSet := Set1 + Set2;
+
+      if InterSet <> (Set2 * Set1) then begin
+         WriteLn ('error in set difference');
+         Halt;
+         end;
+
+      if (InterSet + OneWOTwo) <> Set1 then begin
+         WriteLn ('error in set difference or intersection');
+         Halt;
+         end;
+
+      if (InterSet + TwoWOOne) <> Set2 then begin
+         WriteLn ('error in set difference or intersection');
+         Halt;
+         end;
+
+      if (OneWOTwo + TwoWOOne + InterSet) <> UnionSet then begin
+         WriteLn ('error in set union, intersection or difference');
+         Halt;
+         end;
+
+   end;
+  Start:=MSTimer-Start;
+  WriteLn('Set test completes in ',Start,' ms');
+end.
+

tests/teststr.pp

@@ -0,0 +1,235 @@
+{
+  $Id$
+  
+  Program to test string functions and speed of the functions
+}
+program TestStr;
+uses Timer;
+
+const
+  TestSize=10; {Use at least 10 for reasonable results}
+type
+  BenType=array[1..8] of longint;
+var
+  Total      : longint;
+  headBen,
+  LoadBen,
+  ConcatBen,
+  DelBen,
+  InsBen,
+  CopyBen,
+  CmpBen,
+  MixBen     : BenType;
+  t          : TTimer;
+
+
+function TestOK:boolean;
+Const
+  TestStr: string[22]='HELLO, THIS IS A TEST ';
+var
+  I : INTEGER;
+  U : STRING[1];
+  Q : STRING[100];
+  S : STRING[55];
+  T : STRING[60];
+  V : STRING;
+begin
+  TestOk:=false;
+  T:='THE QUICK BROWN FOX JUMPS OVER THE LAZY DOG 1234567890';
+  Insert (T, T, 1);
+{Writeln(T);}
+  Delete (T, 55, 54);
+  S:=Copy (T, -5, 2);     {'TH'}
+  U:=Copy (T, 7, 4);      {'I'}
+  S:=S + U;               {'THI'}
+  Q:=Copy (T, 32, 70);    {'THE LAZY DOG 1234567890'}
+  Delete (Q, 2, 1);         {'TE LAZY DOG 1234567890'}
+  Delete (Q, 100, 2);       {'TE LAZY DOG 1234567890'}
+  Delete (Q, 3, -4);        {'TE LAZY DOG 1234567890'}
+  Delete (Q, 3, 10);        {'TE1234567890'}
+{  writeln('TE1234567890 - ',Q);}
+  I:=Pos ('S', T);        {25}
+  Insert(Copy(T,I,200),Q,3);{'TES OVER THE LAZY DOG 12345678901234567890'}
+  Delete (Q, 4, 6);         {'TESTHE LAZY DOG 12345678901234567890}
+  S:=S + T [25];          {'THIS'}
+  S:=S + Copy (S, 3, -5) + Copy (S, 3, 2);  {'THISIS'}
+  V:=T;                   {'THE QUICK BROWN FOX JUMPS OVER THE LAZY ..'}
+  Delete (V, -10, 47);      {'AZY DOG 1234567890'}
+  if (Copy (V, -7, -1)='') and (Pos ('DOG', V)=5) then {TRUE}
+   Insert (V, S, 200);    {'THISISAZY DOG 1234567890'}
+  U:=Copy (T, 44, 40);    {' '}
+  Insert (U, S, 5);         {'THIS ISAZY DOG 1234567890'}
+  I:=Pos ('ZY', S);       {9}
+  Delete (S, I, -5);        {'THIS ISAZY DOG 1234567890'}
+  Insert (Copy(S,5,1),S,8); {'THIS IS AZY DOG 1234567890'}
+  Delete (S, 10, 16);       {'THIS IS A0'}
+  if S [Length (S)]='0' then {TRUE}
+   S:=S + Q;            {'THIS IS A0TESTHE LAZY DOG 123456789012345...'}
+  V:=Copy (S, Length (S) - 19, 10); {'1234567890'}
+  if V=Copy (S, Length (S) - 9, 10) then {TRUE}
+   Delete (S, 15, 3 * Length (V)+2); {'THIS IS A0TEST'}
+  Insert ('', S, 0);        {'THIS IS A0TEST'}
+  Insert(Copy(S,5,1),S,11); {'THIS IS A0 TEST'}
+  Insert ('HELLO', S, -4);  {'HELLOTHIS IS A0 TEST'}
+  Insert (',', S, 6);       {'HELLO,THIS IS A0 TEST'}
+  Delete (S, Pos ('TEST', S) - 2, 1); {'HELLO,THIS IS A TEST'}
+  Delete (Q, 0, 32767);     {''}
+  Q:=Q + ' ';             {' '}
+  Insert (Q, S, 7);         {'HELLO, THIS IS A TEST'}
+  Insert (Q, S, 255);       {'HELLO, THIS IS A TEST '}
+  if (S=TestStr) and (Q=' ') and (V='1234567890') and
+     (T='THE QUICK BROWN FOX JUMPS OVER THE LAZY DOG 1234567890') then
+   TestOK:=true;
+end;
+
+
+procedure TestSpeed(Row,Len:byte);
+var
+  l      : longint;
+  hstr,
+  OrgStr : string;
+begin
+  HeadBen[Row]:=Len;
+  OrgStr:='';
+  while Length(OrgStr)<Len do
+   OrgStr:=OrgStr+'aaaaaaaaaa';
+  OrgStr:=Copy(OrgStr,1,Len);
+  OrgStr[Len]:='b';
+{Load/Store}
+  t.Reset;
+  t.Start;
+  for l:=1to 5000*TestSize do
+   HSTr:=OrgStr;
+  t.Stop;
+  inc(Total,t.MSec);
+  LoadBen[Row]:=t.MSec;
+{Concat}
+  t.Reset;
+  t.Start;
+  for l:=1to 2000*TestSize do
+   begin
+     Hstr:='aaa';
+     Hstr:=Hstr+OrgStr;
+   end;
+  t.Stop;
+  inc(Total,t.MSec);
+  ConcatBen[Row]:=t.MSec;
+{Copy}
+  t.Reset;
+  t.Start;
+  for l:=1to 2000*TestSize do
+   HSTr:=Copy(OrgStr,1,Len);
+  t.Stop;
+  inc(Total,t.MSec);
+  CopyBen[Row]:=t.MSec;
+{Delete}
+  t.Reset;
+  t.Start;
+  for l:=1to 2000*TestSize do
+   begin
+     Hstr:=OrgStr;
+     Delete(HStr,1,9);
+   end;
+  t.Stop;
+  inc(Total,t.MSec);
+  DelBen[Row]:=t.MSec;
+{Insert}
+  t.Reset;
+  t.Start;
+  for l:=1to 1000*TestSize do
+   begin
+     Hstr:='aaa';
+     Insert(OrgStr,hstr,2);
+     Hstr:=OrgStr;
+     Insert('aaaaaaaaaaaaa',hstr,9);
+   end;
+  t.Stop;
+  inc(Total,t.MSec);
+  InsBen[Row]:=t.MSec;
+{Compare}
+  t.Reset;
+  t.Start;
+  Hstr:='aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa'+
+        'aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa'+
+        'aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa';
+  for l:=1to 5000*TestSize do
+   if OrgStr=Hstr then;
+  t.Stop;
+  inc(Total,t.MSec);
+  CmpBen[Row]:=t.MSec;
+{Mixed}
+  t.Reset;
+  t.Start;
+  for l:=1 to 400*TestSize do
+   begin
+     hstr:=OrgStr;
+     hstr:=Copy(hstr,1,30);
+     Delete(hstr,5,40);
+     hstr:=Copy(hstr,1,length(hstr));
+     hstr:=hstr+'  ';
+     Delete(hstr,length(hstr)-2,2);
+     Insert('aaaaaaaaaaaaaaaaaaaaaaaaaaaa',hstr,10);
+     Insert('aaaaaaaaaaaaaaaaaaaaaaaaaaaa',hstr,20);
+     hstr:=Copy(hstr,1,length(hstr));
+     hstr:=Copy(hstr,1,80)+'aaaaaaaaaaaaaaaaaaaaaaaaaaabbbbbbbbbbbbbbbbbbbbbbb';
+     hstr:=hstr+OrgStr;
+   end;
+  t.Stop;
+  inc(Total,t.MSec);
+  MixBen[Row]:=t.MSec;
+end;
+
+
+procedure PutBen(const r:BenType);
+var
+  i : byte;
+begin
+  for i:=1to 8 do
+   Write(r[i]:6);
+  Writeln;
+end;
+
+
+
+begin
+  t.Init;
+  WriteLn ('String Function Compatibility and Speed Test');
+  WriteLn;
+
+  if TestOK then
+   WriteLn('Test OK')
+  else
+   WriteLn('Test Failure!');
+
+  if paramstr(1)='t' then
+   halt;
+
+  WriteLn;
+  TestSpeed(1,10);
+  TestSpeed(2,30);
+  TestSpeed(3,50);
+  TestSpeed(4,70);
+  TestSpeed(5,100);
+  TestSpeed(6,150);
+  TestSpeed(7,200);
+  TestSpeed(8,250);
+
+  Write('Length      ');
+  PutBen(HeadBen);
+  WriteLn('------------------------------------------------------------------------------');
+  Write('Load/Store  ');
+  PutBen(LoadBen);
+  Write('Concat      ');
+  PutBen(ConcatBen);
+  Write('Copy        ');
+  PutBen(CopyBen);
+  Write('Delete      ');
+  PutBen(DelBen);
+  Write('Insert      ');
+  PutBen(InsBen);
+  Write('Compare     ');
+  PutBen(CmpBen);
+  Write('Mixed       ');
+  PutBen(MixBen);
+  WriteLn('String-Benchmark avarage ',Total div 8,' ms');
+end.