diff --git a/tests/README b/tests/README index 408fc1ca1d..a43258ddbc 100644 --- a/tests/README +++ b/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 diff --git a/tests/testcrt.pp b/tests/testcrt.pp new file mode 100644 index 0000000000..8ec15a66e4 --- /dev/null +++ b/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. diff --git a/tests/testdos.pp b/tests/testdos.pp new file mode 100644 index 0000000000..b43c83b9b6 --- /dev/null +++ b/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. + diff --git a/tests/testheap.pp b/tests/testheap.pp new file mode 100644 index 0000000000..ef1544e894 --- /dev/null +++ b/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. + + + diff --git a/tests/testset.pp b/tests/testset.pp new file mode 100644 index 0000000000..968a9bff2e --- /dev/null +++ b/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. + diff --git a/tests/teststr.pp b/tests/teststr.pp new file mode 100644 index 0000000000..6580e92a64 --- /dev/null +++ b/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)