View Issue Details

IDProjectCategoryView StatusLast Update
0028578FPCPatchpublic2015-08-28 10:48
ReporterOndrej PokornyAssigned ToMichael Van Canneyt 
PrioritynormalSeverityminorReproducibilityhave not tried
Status closedResolutionfixed 
Product Version3.1.1Product Build 
Target Version4.0.0Fixed in Version3.1.1 
Summary0028578: Heaptrc suggestion: not show information when no memory leaks occured
DescriptionWhen I debug a LCL application with heaptrc enabled, there is the dialog box shown also when no memory leaks occurred (see attachment). I personally am interested in the output only when there is a memory leak and I have to do something.

It's quite tiresome to close the heaptrc dialog every time I finish debugging a program.

I suggest to show the output only when memory leaks occurred. (Btw. this is also Delphi behavior.)
Steps To Reproduce1.) Create an empty LCL application.
2.) Set build mode to "Debug".
3.) Run and close the program. You'll see the heaptrc dialog.
Additional InformationI made a fast&dirty patch that is attached.
TagsNo tags attached.
Fixed in Revision31434
FPCOldBugId
FPCTarget
Attached Files
  • heaptrc.jpg (16,078 bytes)
    heaptrc.jpg (16,078 bytes)
  • heaptrc.pp.patch (2,524 bytes)
    Index: rtl/inc/heaptrc.pp
    ===================================================================
    --- rtl/inc/heaptrc.pp	(revision 31193)
    +++ rtl/inc/heaptrc.pp	(working copy)
    @@ -1120,26 +1120,29 @@
       else
         ptext:=textoutput;
       pp:=loc_info^.heap_mem_root;
    -  Writeln(ptext^,'Heap dump by heaptrc unit');
    -  Writeln(ptext^,loc_info^.getmem_cnt, ' memory blocks allocated : ',
    -    loc_info^.getmem_size,'/',loc_info^.getmem8_size);
    -  Writeln(ptext^,loc_info^.freemem_cnt,' memory blocks freed     : ',
    -    loc_info^.freemem_size,'/',loc_info^.freemem8_size);
    -  Writeln(ptext^,loc_info^.getmem_cnt-loc_info^.freemem_cnt,
    -    ' unfreed memory blocks : ',loc_info^.getmem_size-loc_info^.freemem_size);
    -  status:=SysGetFPCHeapStatus;
    -  Write(ptext^,'True heap size : ',status.CurrHeapSize);
    -  if EntryMemUsed > 0 then
    -    Writeln(ptext^,' (',EntryMemUsed,' used in System startup)')
    -  else
    -    Writeln(ptext^);
    -  Writeln(ptext^,'True free heap : ',status.CurrHeapFree);
    -  ExpectedHeapFree:=status.CurrHeapSize
    -    -(loc_info^.getmem8_size-loc_info^.freemem8_size)
    -    -(loc_info^.getmem_cnt-loc_info^.freemem_cnt)*(sizeof(theap_mem_info)+extra_info_size)
    -    -EntryMemUsed;
    -  If ExpectedHeapFree<>status.CurrHeapFree then
    -    Writeln(ptext^,'Should be : ',ExpectedHeapFree);
    +  if loc_info^.getmem_size-loc_info^.freemem_size > 0 then
    +  begin
    +    Writeln(ptext^,'Heap dump by heaptrc unit');
    +    Writeln(ptext^,loc_info^.getmem_cnt, ' memory blocks allocated : ',
    +      loc_info^.getmem_size,'/',loc_info^.getmem8_size);
    +    Writeln(ptext^,loc_info^.freemem_cnt,' memory blocks freed     : ',
    +      loc_info^.freemem_size,'/',loc_info^.freemem8_size);
    +    Writeln(ptext^,loc_info^.getmem_cnt-loc_info^.freemem_cnt,
    +      ' unfreed memory blocks : ',loc_info^.getmem_size-loc_info^.freemem_size);
    +    status:=SysGetFPCHeapStatus;
    +    Write(ptext^,'True heap size : ',status.CurrHeapSize);
    +    if EntryMemUsed > 0 then
    +      Writeln(ptext^,' (',EntryMemUsed,' used in System startup)')
    +    else
    +      Writeln(ptext^);
    +    Writeln(ptext^,'True free heap : ',status.CurrHeapFree);
    +    ExpectedHeapFree:=status.CurrHeapSize
    +      -(loc_info^.getmem8_size-loc_info^.freemem8_size)
    +      -(loc_info^.getmem_cnt-loc_info^.freemem_cnt)*(sizeof(theap_mem_info)+extra_info_size)
    +      -EntryMemUsed;
    +    If ExpectedHeapFree<>status.CurrHeapFree then
    +      Writeln(ptext^,'Should be : ',ExpectedHeapFree);
    +  end;
       i:=loc_info^.getmem_cnt-loc_info^.freemem_cnt;
       while pp<>nil do
        begin
    
    heaptrc.pp.patch (2,524 bytes)

Relationships

has duplicate 0030118 resolvedOndrej Pokorny Lazarus FEATURE REQUEST: Allow to show heatrc window only if error 

Activities

Ondrej Pokorny

2015-08-28 09:40

developer  

heaptrc.jpg (16,078 bytes)
heaptrc.jpg (16,078 bytes)

Ondrej Pokorny

2015-08-28 09:42

developer  

heaptrc.pp.patch (2,524 bytes)
Index: rtl/inc/heaptrc.pp
===================================================================
--- rtl/inc/heaptrc.pp	(revision 31193)
+++ rtl/inc/heaptrc.pp	(working copy)
@@ -1120,26 +1120,29 @@
   else
     ptext:=textoutput;
   pp:=loc_info^.heap_mem_root;
-  Writeln(ptext^,'Heap dump by heaptrc unit');
-  Writeln(ptext^,loc_info^.getmem_cnt, ' memory blocks allocated : ',
-    loc_info^.getmem_size,'/',loc_info^.getmem8_size);
-  Writeln(ptext^,loc_info^.freemem_cnt,' memory blocks freed     : ',
-    loc_info^.freemem_size,'/',loc_info^.freemem8_size);
-  Writeln(ptext^,loc_info^.getmem_cnt-loc_info^.freemem_cnt,
-    ' unfreed memory blocks : ',loc_info^.getmem_size-loc_info^.freemem_size);
-  status:=SysGetFPCHeapStatus;
-  Write(ptext^,'True heap size : ',status.CurrHeapSize);
-  if EntryMemUsed > 0 then
-    Writeln(ptext^,' (',EntryMemUsed,' used in System startup)')
-  else
-    Writeln(ptext^);
-  Writeln(ptext^,'True free heap : ',status.CurrHeapFree);
-  ExpectedHeapFree:=status.CurrHeapSize
-    -(loc_info^.getmem8_size-loc_info^.freemem8_size)
-    -(loc_info^.getmem_cnt-loc_info^.freemem_cnt)*(sizeof(theap_mem_info)+extra_info_size)
-    -EntryMemUsed;
-  If ExpectedHeapFree<>status.CurrHeapFree then
-    Writeln(ptext^,'Should be : ',ExpectedHeapFree);
+  if loc_info^.getmem_size-loc_info^.freemem_size > 0 then
+  begin
+    Writeln(ptext^,'Heap dump by heaptrc unit');
+    Writeln(ptext^,loc_info^.getmem_cnt, ' memory blocks allocated : ',
+      loc_info^.getmem_size,'/',loc_info^.getmem8_size);
+    Writeln(ptext^,loc_info^.freemem_cnt,' memory blocks freed     : ',
+      loc_info^.freemem_size,'/',loc_info^.freemem8_size);
+    Writeln(ptext^,loc_info^.getmem_cnt-loc_info^.freemem_cnt,
+      ' unfreed memory blocks : ',loc_info^.getmem_size-loc_info^.freemem_size);
+    status:=SysGetFPCHeapStatus;
+    Write(ptext^,'True heap size : ',status.CurrHeapSize);
+    if EntryMemUsed > 0 then
+      Writeln(ptext^,' (',EntryMemUsed,' used in System startup)')
+    else
+      Writeln(ptext^);
+    Writeln(ptext^,'True free heap : ',status.CurrHeapFree);
+    ExpectedHeapFree:=status.CurrHeapSize
+      -(loc_info^.getmem8_size-loc_info^.freemem8_size)
+      -(loc_info^.getmem_cnt-loc_info^.freemem_cnt)*(sizeof(theap_mem_info)+extra_info_size)
+      -EntryMemUsed;
+    If ExpectedHeapFree<>status.CurrHeapFree then
+      Writeln(ptext^,'Should be : ',ExpectedHeapFree);
+  end;
   i:=loc_info^.getmem_cnt-loc_info^.freemem_cnt;
   while pp<>nil do
    begin
heaptrc.pp.patch (2,524 bytes)

Michael Van Canneyt

2015-08-28 10:11

administrator   ~0085556

I did this differently.

I created an overloaded version of DumpHeap:

Procedure DumpHeap(SkipIfNoLeaks : Boolean);

And introduced a global boolean GlobalSkipIfNoLeaks. This boolean is used by DumpHeap() to call the overloaded DumpHeap(GlobalSkipIfNoLeaks)

This variable is False for backwards compatibility.
It can be set to True to get the behaviour you want.

Like most Heaptrc variables, it can be activated by adding skipifnoleaks to the HEAPTRC environment variable.

We could imagine initializing this variable to
 GlobalSkipIfNoLeaks:=not IsConsole.

Ondrej Pokorny

2015-08-28 10:48

developer   ~0085557

I was sure that somebody from FPC developers comes with a better solution and you did! Thanks a lot!

Just a small remark: the check can be applied directly after loc_info assignment:

procedure dumpheap(SkipIfNoLeaks : Boolean);
var
//...
begin
  loc_info:=@heap_info;
  if ((loc_info^.getmem_size-loc_info^.freemem_size)=0) and SkipIfNoLeaks then
    exit;
//...

Issue History

Date Modified Username Field Change
2015-08-28 09:40 Ondrej Pokorny New Issue
2015-08-28 09:40 Ondrej Pokorny File Added: heaptrc.jpg
2015-08-28 09:42 Ondrej Pokorny File Added: heaptrc.pp.patch
2015-08-28 10:06 Michael Van Canneyt Assigned To => Michael Van Canneyt
2015-08-28 10:06 Michael Van Canneyt Status new => assigned
2015-08-28 10:11 Michael Van Canneyt Fixed in Revision => 31434
2015-08-28 10:11 Michael Van Canneyt Note Added: 0085556
2015-08-28 10:11 Michael Van Canneyt Status assigned => resolved
2015-08-28 10:11 Michael Van Canneyt Fixed in Version => 3.1.1
2015-08-28 10:11 Michael Van Canneyt Resolution open => fixed
2015-08-28 10:11 Michael Van Canneyt Target Version => 4.0.0
2015-08-28 10:48 Ondrej Pokorny Note Added: 0085557
2015-08-28 10:48 Ondrej Pokorny Status resolved => closed
2016-05-13 08:32 Ondrej Pokorny Relationship added has duplicate 0030118