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

--- Merging r31434 into '.':

Browse Source 
U    rtl/inc/heaptrc.pp
--- Recording mergeinfo for merge of r31434 into '.':
 U   .

# revisions: 31434

git-svn-id: branches/fixes_3_0@33861 -
This commit is contained in:
marco 2016-05-31 05:59:35 +00:00
parent f8e7eddefc
commit bce375dc3a
1 changed files with 13 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
rtl/inc/heaptrc.pp
View File

@ -30,6 +30,7 @@ interface
{$endif}
Procedure DumpHeap;
Procedure DumpHeap(SkipIfNoLeaks : Boolean);
{ define EXTRA to add more
tests :
@ -85,6 +86,8 @@ const
printleakedblock: boolean = false;
printfaultyblock: boolean = false;
maxprintedblocklength: integer = 128;
GlobalSkipIfNoLeaks : Boolean = False;
implementation
@ -1106,6 +1109,12 @@ end;
*****************************************************************************}
procedure dumpheap;
begin
DumpHeap(GlobalSkipIfNoLeaks);
end;
procedure dumpheap(SkipIfNoLeaks : Boolean);
var
pp : pheap_mem_info;
i : ptrint;
@ -1120,6 +1129,8 @@ begin
else
ptext:=textoutput;
pp:=loc_info^.heap_mem_root;
if ((loc_info^.getmem_size-loc_info^.freemem_size)=0) and SkipIfNoLeaks then
exit;
Writeln(ptext^,'Heap dump by heaptrc unit');
Writeln(ptext^,loc_info^.getmem_cnt, ' memory blocks allocated : ',
loc_info^.getmem_size,'/',loc_info^.getmem8_size);
@ -1517,6 +1528,8 @@ begin
haltonerror:=false;
if pos('haltonnotreleased',s)>0 then
HaltOnNotReleased :=true;
if pos('skipifnoleaks',s)>0 then
GlobalSkipIfNoLeaks :=true;
i:=pos('log=',s);
if i>0 then
begin