paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-07 02:48:07 +02:00
Code Issues Packages Projects Releases Wiki Activity

* tests fixed

Browse Source
This commit is contained in:
florian 2022-05-29 10:37:12 +02:00
parent 638de87a5a
commit 390084d59e
2 changed files with 159 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

165
tests/test/theap.inc
View File

@ -1,10 +1,161 @@
{
const
{$if defined (cpusparc) or defined(cpui8086)}
Blocks = 1000;
{$else}
Blocks = 10000;
{$endif}
Program to test heap functions, timing doesn't work
}
PROGRAM TestHeap;
Procedure InitMSTimer;
begin
end;
uses
erroru;
{$i theap.inc}
{Get MS Timer}
Function MSTimer:longint;
begin
MSTimer:=0;
end;
procedure ShowHeap;
var
hstatus : TFPCHeapstatus;
begin
hstatus:=GetFPCHeapStatus;
WriteLn ('Used: ', hstatus.CurrHeapUsed, ' Free: ', hstatus.CurrHeapFree,' Size: ',hstatus.CurrHeapSize);
end;
VAR Start, LoopTime,LoopTime2: LONGINT;
Delta, TotalTime: LONGINT;
L,Choice,K,T: WORD;
BlkPtr: ARRAY [1..Blocks] OF POINTER;
BlkSize: ARRAY [1..Blocks] OF WORD;
Permutation: ARRAY [1..Blocks] OF WORD;
BEGIN
INitMSTimer;
WriteLn ('Test of TP heap functions');
WriteLn;
TotalTime := 0;
RandSeed := 997;
ShowHeap;
Start :=MSTimer;
FOR L := 1 TO Blocks DO BEGIN
END;
LoopTime := MSTimer-Start;
FOR L := 1 TO Blocks DO BEGIN
BlkSize [L] := Random (512) + 1;
END;
Write ('Allocating ',Blocks,' blocks at the end of the heap: ');
Start := MSTImer;
FOR L := 1 TO Blocks DO BEGIN
GetMem (BlkPtr [L], BlkSize [L]);
END;
Delta := MSTimer-Start-LoopTime;
Inc (TotalTime, Delta);
WriteLn (Delta:5, ' ms');
ShowHeap;
Write ('Deallocating same ',Blocks,' blocks in reverse order:');
Start := MSTimer;
FOR L := 1 TO Blocks DO BEGIN
FreeMem (BlkPtr [L], BlkSize [L]);
END;
Delta := MSTimer-Start-LoopTime;
Inc (TotalTime, Delta);
WriteLn (Delta:5, ' ms');
ShowHeap;
Write ('Allocating ',Blocks,' blocks at the end of the heap: ');
Start := MSTimer;
FOR L := 1 TO Blocks DO BEGIN
GetMem (BlkPtr [L], BlkSize [L]);
END;
Delta := MSTimer-Start-LoopTime;
Inc (TotalTime, Delta);
WriteLn (Delta:5, ' ms');
ShowHeap;
FOR L := 1 TO Blocks DO BEGIN
Permutation [L] := L;
END;
Start := MSTimer;
FOR L := Blocks DOWNTO 1 DO BEGIN
Choice := Random (L)+1;
K := Permutation [Choice];
Permutation [Choice] := Permutation [L];
END;
LoopTime2 := MSTimer - Start;
FOR L := 1 TO Blocks DO BEGIN
Permutation [L] := L;
END;
Write ('Deallocating same ',Blocks,' blocks at random: ');
Start := MSTimer;
FOR L := Blocks 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');
ShowHeap;
Write ('Allocating ',Blocks,' blocks at the end of the heap: ');
Start := MSTimer;
FOR L := 1 TO Blocks DO BEGIN
GetMem (BlkPtr [L], BlkSize [L]);
END;
Delta := MSTimer-Start-LoopTime;
Inc (TotalTime, Delta);
WriteLn (Delta:5, ' ms');
ShowHeap;
FOR L := 1 TO Blocks DO BEGIN
Permutation [L] := L;
END;
Start := MSTimer;
FOR L := Blocks 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 Blocks DO BEGIN
Permutation [L] := L;
END;
Write ('Deallocating ',(Blocks div 2 + 1),' blocks at random: ');
Start := MSTimer;
FOR L := Blocks DOWNTO (Blocks div 2 + 1) 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');
ShowHeap;
Write ('Reallocating deallocated ',(Blocks div 2 + 1),' blocks at random: ');
Start := MSTimer;
FOR L := (Blocks div 2+1) TO Blocks DO BEGIN
GetMem (BlkPtr [Permutation [L]], BlkSize [Permutation [L]]);
END;
Delta := MSTimer-Start-LoopTime;
Inc (TotalTime, Delta);
WriteLn (Delta:5, ' ms');
ShowHeap;
Write ('Deallocating all ',Blocks,' blocks at random: ');
Start := MSTimer;
FOR L := Blocks DOWNTO 1 DO BEGIN
FreeMem (BlkPtr [L], BlkSize [L]);
END;
Delta := MSTimer-Start-LoopTime;
Inc (TotalTime, Delta);
WriteLn (Delta:5, ' ms');
ShowHeap;
WriteLn;
WriteLn ('Total time for benchmark: ', TotalTime, ' ms');
END.

2
tests/test/theap.pp
View File

@ -7,4 +7,4 @@ PROGRAM TestHeap;
uses
erroru;
{$I heap.inc}
{$I theap.inc}