paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-24 22:10:42 +02:00
Code Issues Packages Projects Releases Wiki Activity

* getheapstatus

Browse Source
This commit is contained in:
peter 2005-03-04 16:49:42 +00:00
parent 617bd39762
commit 4a0d3f7176
1 changed files with 17 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

19
tests/units/erroru.pp
View File

@ -30,6 +30,12 @@ type
procedure getheapstatus(var status:THeapStatus); procedure getheapstatus(var status:THeapStatus);
{$endif HASGETHEAPSTATUS} {$endif HASGETHEAPSTATUS}
{$ifndef HASGETFPCHEAPSTATUS}
type
TFPCHeapStatus = THeapStatus;
function GetFPCHeapStatus:TFPCHeapStatus;
{$endif HASGETFPCHEAPSTATUS}
function DoMem (Var StartMem : sizeint): sizeint; function DoMem (Var StartMem : sizeint): sizeint;
@ -114,6 +120,15 @@ end;
end; end;
{$endif HASGETHEAPSTATUS} {$endif HASGETHEAPSTATUS}
{$ifndef HASGETFPCHEAPSTATUS}
function GetFPCHeapStatus:TFPCHeapStatus;
begin
GetHeapStatus(GetFPCHeapStatus);
end;
{$endif HASGETFPCHEAPSTATUS}
function DoMem (Var StartMem : sizeint): sizeint; function DoMem (Var StartMem : sizeint): sizeint;
@ -132,9 +147,9 @@ function DoMem (Var StartMem : sizeint): sizeint;
end; end;
var var
hstatus : THeapstatus; hstatus : TFPCHeapstatus;
begin begin
GetHeapStatus(hstatus); hstatus:=GetFPCHeapStatus;
if StartMem=0 then if StartMem=0 then
begin begin
Writeln ('[HEAP] Size: ',getsize(hstatus.CurrHeapSize),', Used: ',getsize(hstatus.CurrHeapUsed)); Writeln ('[HEAP] Size: ',getsize(hstatus.CurrHeapSize),', Used: ',getsize(hstatus.CurrHeapUsed));