[SOLVED] Weird Memory Leak!!

[garlar27]

Hi!

I have this code which generates a Memory Leak:

Code: [Select]

   TTransactionData = record
      GUID     : string     ;
      Name     : string     ;
      Number   : QWord      ;
      StartTime: TDateTime  ;
      EndTime  : TDateTime  ;
      TimeOut  : TTimeOut   ; //< In Milliseconds.
      RawAnswer: string     ;
      Owner    : TObject    ;
   end;

   TMyObj = cLass(TOBject)
   public
      Data: TTransactionData;
      ....
   end;
...
...

var
   SomeData: TTransactionData;
begin
   for i := 1 to CantMsj do begin
      FillByte(SomeData, SizeOf(SomeData), 0);
      SomeData.StartTime  := Now;
      SomeData.GUID       := AGUID;
      SomeData.Name       := Format('%S.Pet%D[%D of %D]', [Name, Count, i, MsgCount]); // Memory Leak!!
      SomeData.Number     := i;
      SomeData.TimeOut    := MIN_TIME_OUT + Random(MAX_TIME_OUT - MIN_TIME_OUT);
      SomeData.RawAnswer  := Format('%S-[BEGIN] Transaction "%S".{%S}.%D Created', [StrLog(Now), Name, AGUID, SomeData.Number]); // Memory Leak!!
      SomeData.Owner      := Self;

      ATransa := TTransaction.Create(nil);
      ATransa.Name             := SomeData.Name;

      ATransa.SetData(SomeData);
      FList.Add(ATransa);
   end; {<--- of "for i" }
end;

And this version don't:

Code: [Select]

begin
   for i := 1 to CantMsj do begin

      ATransa := TTransaction.Create(nil);
      ATransa.Data.StartTime  := Now;
      ATransa.Data.GUID       := AGUID;
      ATransa.Data.Name       := Format('%S.Pet%D[%D of %D]', [Name, Count, i, MsgCount]); // No Memory Leak!!
      ATransa.Data.Number     := i;
      ATransa.Data.TimeOut    := MIN_TIME_OUT + Random(MAX_TIME_OUT - MIN_TIME_OUT);
      ATransa.Data.RawAnswer  := Format('%S-[BEGIN] Transaction "%S".{%S}.%D Created', [StrLog(Now), Name, AGUID, ATransa.Data.Number]); // No Memory Leak!!
      ATransa.Data.Owner      := Self;
      ATransa.Name             := ATransa.Data.Name;

      FList.Add(ATransa);
   end; {<--- of "for i" }
end;

Am I doing something wrong?

I'm using FPC 2.4.4 Lazarus 0.9.30 on Linux Ubuntu 10.04 LTS

[Laksen]

Yes. String is a reference counted datatype.

When you call FillByte(SomeData, SizeOf(SomeData), 0); the second time you'll simply remove all traces of the string, while it's still referenced.

[garlar27]

Dough!!!

Is there anything else I can do beside not using FillByte??

[Laksen]

Just remove the FillByte? The only thing you don't initialize is EndTime.

[garlar27]

Yes, I know.
I like FillByte because I can initialize a record with lots of fields in one line and the code is more readable for me since it's something done in one line and I don't have to search for errors during initialization even if I change the record's definition.

My work around:

Code: [Select]

type

   TTransactionData = record
      GUID     : string     ;
      Name     : string     ;
      Number   : QWord      ;
      StartTime: TDateTime  ;
      EndTime  : TDateTime  ;
      TimeOut  : TTimeOut   ; //< In Milliseconds.
      RawAnswer: string     ;
      Owner    : TObject    ;
   end;

const

   EMPTY_TRANSACTION_DATA : TTransactionData = (
      GUID     : '';
      Name     : '';
      Number   : 0;
      StartTime: 0;
      EndTime  : 0;
      TimeOut  : 0; //< In Milliseconds.
      RawAnswer: '';
      Owner    : nil;
   );

begin
   SomeData := EMPTY_TRANSACTION_DATA; //SomeData Initialized
end;


[User137]

Yes. String is a reference counted datatype.

When you call FillByte(SomeData, SizeOf(SomeData), 0); the second time you'll simply remove all traces of the string, while it's still referenced.

Are you saying

Code: [Select]

ATransa.SetData(SomeData);This code doesn't makes new instances of the string variables contained in record? That would be weird.

[Laksen]

I'm saying that it makes new unique instances of the strings in the record, hence why the old ones are forgotten when the next fillbyte is called

[Leledumbo]

I like FillByte because I can initialize a record with lots of fields in one line and the code is more readable for me since it's something done in one line and I don't have to search for errors during initialization even if I change the record's definition.

Well you can try this instead:

Code: [Select]

Initialize(SomeData);

[garlar27]

Well you can try this instead:

Code: [Select]

Initialize(SomeData);

I still have the Memory Leak with Initialize() 

[garlar27]

Well, I didn't expected that problem. I'm gonna miss FillByte. It was so convenient that I have a code template defined to use it!! (Yes, I know, I'm a lazy programmer ). Initialize is good too (I didn't remembered it's existence !!) but has the same issue with strings.

I think the best approach is:
   1. Defining a constant with an initial value.
or
   2. Creating an Init Procedure for the type.

Thanks everybody!
If someone knows something better I'll be glad to know what it is.

[User137]

I don't really understand what you are getting at. Your original idea works perfectly fine. Insert TMemo on form and try this code

Code: [Select]

type
  TMyData = record
    int1: integer;
    str1: string;
    str2: string;
    int2: byte;
  end;

  { TMyClass }

  TMyClass = class
  private
    data: TMyData;
  public
    function print: string;
    procedure setdata(const _data: TMyData);
  end;

  { TForm1 }

  TForm1 = class(TForm)
    Memo1: TMemo;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
  public
    list: array of TMyClass;
    count: integer;
  end;

var
  Form1: TForm1;

implementation

{$R *.lfm}

{ TForm1 }

procedure TForm1.FormCreate(Sender: TObject);
var i: integer; data: TMyData;
begin
  count:=10;
  setlength(list, count);
  for i:=0 to count-1 do begin
    fillbyte(data, sizeof(data), 0);
    data.str1:='String1 = '+inttostr(i);
    data.str2:='String2 = '+inttostr(i*i+10);
    data.int1:=(i+1)*3;
    list[i]:=TMyClass.Create;
    list[i].setdata(data);
  end;

  for i:=0 to count-1 do
    memo1.lines.add(list[i].print);
end;

procedure TForm1.FormDestroy(Sender: TObject);
var i: integer;
begin
  for i:=0 to count-1 do
    list[i].Free;
end;

{ TMyClass }

function TMyClass.print: string;
begin
  result:=format('[%d] [%s] [%s] [%d]',
    [data.int1, data.str1, data.str2, data.int2]);
end;

procedure TMyClass.setdata(const _data: TMyData);
begin
  data:=_data;
end;
It will print out

Code: [Select]

[3] [String1 = 0] [String2 = 10] [0]
[6] [String1 = 1] [String2 = 11] [0]
[9] [String1 = 2] [String2 = 14] [0]
[12] [String1 = 3] [String2 = 19] [0]
[15] [String1 = 4] [String2 = 26] [0]
[18] [String1 = 5] [String2 = 35] [0]
[21] [String1 = 6] [String2 = 46] [0]
[24] [String1 = 7] [String2 = 59] [0]
[27] [String1 = 8] [String2 = 74] [0]
[30] [String1 = 9] [String2 = 91] [0]Where you can see int2 values are all 0 by the call of FillByte(). Also because it's not packed record, its not even aligned.

And heaptrc says no memory lost.

[garlar27]

I'm sorry User137. This is what I get when I run your code from Linux' console:

Code: [Select]

eric@ubuntu1004:~/projects/lazarus/FillByteMemoryLeakInString$ ./MemLeak
Heap dump by heaptrc unit
1302 memory blocks allocated : 1542054/1546088
1284 memory blocks freed     : 1541685/1545656
18 unfreed memory blocks : 369
True heap size : 262144
True free heap : 260416
Should be : 260560
Call trace for block $B76DAB80 size 21
  $080811D3  TCUSTOMFORM__DOCREATE,  line 877 of ./include/customform.inc
  $0807F867  TCUSTOMFORM__AFTERCONSTRUCTION,  line 79 of ./include/customform.inc
  $08085ACE  TFORM__CREATE,  line 2838 of ./include/customform.inc
  $0808D018  TAPPLICATION__CREATEFORM,  line 2087 of ./include/application.inc
  $0805DC47  main,  line 18 of MemLeak.lpr
  $0064BBD6
  $082BECE2
Call trace for block $B76DAB20 size 20
  $080811D3
  $0807F867
  $08085ACE
  $0808D018
  $0805DC47
  $0064BBD6
  $082BECE2
Call trace for block $B76DAA60 size 21
  $080811D3
  $0807F867
  $08085ACE
  $0808D018
  $0805DC47
  $0064BBD6
  $082BECE2
Call trace for block $B76DAA00 size 20
  $080811D3
  $0807F867
  $08085ACE
  $0808D018
  $0805DC47
  $0064BBD6
  $082BECE2
Call trace for block $B76DA940 size 21
  $080811D3
  $0807F867
  $08085ACE
  $0808D018
  $0805DC47
  $0064BBD6
  $082BECE2
Call trace for block $B76DA8E0 size 20
  $080811D3
  $0807F867
  $08085ACE
  $0808D018
  $0805DC47
  $0064BBD6
  $082BECE2
Call trace for block $B76DA820 size 21
  $080811D3
  $0807F867
  $08085ACE
  $0808D018
  $0805DC47
  $0064BBD6
  $082BECE2
Call trace for block $B76DA7C0 size 20
  $080811D3
  $0807F867
  $08085ACE
  $0808D018
  $0805DC47
  $0064BBD6
  $082BECE2
Call trace for block $B76DA6A0 size 21
  $080811D3
  $0807F867
  $08085ACE
  $0808D018
  $0805DC47
  $0064BBD6
  $082BECE2
  $080AB432
Call trace for block $B76DA640 size 20
  $080811D3
  $0807F867
  $08085ACE
  $0808D018
  $0805DC47
  $0064BBD6
  $082BECE2
  $080ACEED
Call trace for block $B76DA580 size 21
  $080811D3
  $0807F867
  $08085ACE
  $0808D018
  $0805DC47
  $0064BBD6
  $082BECE2
  $08121BE4
Call trace for block $B76D9C80 size 20
  $080811D3
  $0807F867
  $08085ACE
  $0808D018
  $0805DC47
  $0064BBD6
  $082BECE2
  $08121BE4
Call trace for block $B76DA280 size 21
  $080811D3
  $0807F867
  $08085ACE
  $0808D018
  $0805DC47
  $0064BBD6
  $082BECE2
  $08121BE4
Call trace for block $B76D9CE0 size 20
  $080811D3
  $0807F867
  $08085ACE
  $0808D018
  $0805DC47
  $0064BBD6
  $082BECE2
  $08121BE4
Call trace for block $B76D9BC0 size 21
  $080811D3
  $0807F867
  $08085ACE
  $0808D018
  $0805DC47
  $0064BBD6
  $082BECE2
  $0805DC47
Call trace for block $B76D9AA0 size 20
  $080811D3
  $0807F867
  $08085ACE
  $0808D018
  $0805DC47
  $0064BBD6
  $082BECE2
  $0808D018
Call trace for block $B76DA5E0 size 21
  $080811D3
  $0807F867
  $08085ACE
  $0808D018
  $0805DC47
  $0064BBD6
  $082BECE2
  $08121BE4
Call trace for block $B76D9A40 size 20
  $080811D3
  $0807F867
  $08085ACE
  $0808D018
  $0805DC47
  $0064BBD6
  $082BECE2
  $0064BBD6

But if I change the code a little:

Code: [Select]

type
   TMyData = record
     int1: integer;
     str1: string;
     str2: string;
     int2: byte;
   end;

   { TMyClass }

   TMyClass = class
   private
     data: TMyData;
   public
     function print: string;
     procedure setdata(const _data: TMyData);
   end;


   { TForm1 }

   TForm1 = class(TForm)
      Memo1: TMemo;
      procedure FormCreate(Sender: TObject);
      procedure FormDestroy(Sender: TObject);
   private { private declarations }
   public  { public declarations }
      list: array of TMyClass;
      count: integer;
   end;

const   // ******** CHANGED ************
   EMPTY_MY_DATA : TMyData = (   // ******** CHANGED ************
      int1: 0;   // ******** CHANGED ************
      str1: '';   // ******** CHANGED ************
      str2: '';   // ******** CHANGED ************
      int2: 0;   // ******** CHANGED ************
   );

var
   Form1: TForm1;

implementation

{$R *.lfm}

{ TMyClass }

function TMyClass.print: string;
begin
  result:=format('[%d] [%s] [%s] [%d]',
    [data.int1, data.str1, data.str2, data.int2]);
end;

procedure TMyClass.setdata(const _data: TMyData);
begin
  data:=_data;
end;


{ TForm1 }

procedure TForm1.FormCreate(Sender: TObject);
var i: integer; data: TMyData;
begin
  count:=10;
  setlength(list, count);
  for i:=0 to count-1 do begin
    //fillbyte(data, sizeof(data), 0);   // ******** CHANGED ************
    data := EMPTY_MY_DATA;   // ******** CHANGED ************
    data.str1:='String1 = '+inttostr(i);
    data.str2:='String2 = '+inttostr(i*i+10);
    data.int1:=(i+1)*3;
    list[i]:=TMyClass.Create;
    list[i].setdata(data);
  end;

  for i:=0 to count-1 do
    memo1.lines.add(list[i].print);
end;

procedure TForm1.FormDestroy(Sender: TObject);
var i: integer;
begin
  for i:=0 to count-1 do
    list[i].Free;
end;

end.   
I had the following result:

Code: [Select]

eric@ubuntu1004:~/projects/lazarus/FillByteMemoryLeakInString$ ./MemLeak Heap dump by heaptrc unit
1302 memory blocks allocated : 1542054/1546088
1302 memory blocks freed     : 1542054/1546088
0 unfreed memory blocks : 0
True heap size : 229376
True free heap : 229376


[User137]

Hmm, i might understand what's going on, although i don't understand why my Win32 version doesn't make it show leaking. Maybe compiler settings have something to do with handling dynamic arrays like strings.

Alternative solution might be to give strings specific maxlength. It would make them not be treated as pointers:

Code: [Select]

  TMyData = record
    int1: integer;
    str1: string[50];
    str2: string[50];
    int2: byte;
  end;Your own solution for empty variable base is good one too though.

[garlar27]

Hmm, i might understand what's going on, although i don't understand why my Win32 version doesn't make it show leaking. Maybe compiler settings have something to do with handling dynamic arrays like strings.

Alternative solution might be to give strings specific maxlength. It would make them not be treated as pointers:

Code: [Select]

  TMyData = record
    int1: integer;
    str1: string[50];
    str2: string[50];
    int2: byte;
  end;Your own solution for empty variable base is good one too though.

Yes, I thought that too. But is a little restrictive on string length and I prefer use a more general solution.

[KpjComp]

I prefer use a more general solution.

The TMyData has already be initialized automatically, the problem is that Lazarus/Delphi doesn't zero the rest of the record structure, only the strings are getting initialized.

You have two options.
1. Finalize, Zero the data, and then Initialize again
2. Allocate the memory yourself

Option 1, of course implicitly means that your Initializing & Finalizing the record structure twice.
Option 2, avoids this, but the coding involves pointers, and manually initializing/finalizing.

Below is an example showing both methods.

Code: [Select]

program project1;

{$mode objfpc}{$H+}

uses
  {$IFDEF UNIX}{$IFDEF UseCThreads}
  cthreads,
  {$ENDIF}{$ENDIF}
  Classes, SysUtils, CustApp
  { you can add units after this };

type

  PTest = ^TTest;
  TTest = record
    str1:string;
    int1:integer;
  end;

procedure ShowRec(const r:TTest);
begin
  writeln('str1 = '+r.str1);
  writeln('int1 = '+inttostr(r.int1));
end;

procedure DoTest;
var
  pRec:PTest;
  Rec:TTest;
begin
  //Test one, double Initialize & Finalize
  Finalize(Rec);
  FillByte(Rec,sizeof(TTest),0);
  Initialize(Rec);
  Rec.int1:=88;
  ShowRec(Rec);

  //Test two, lets alocate & initialize/finalize ourselfs.
  pRec := Getmemory(sizeof(TTest));
  FillByte(pRec^,sizeof(TTest),0);
  Initialize(pRec^);
  pRec^.str1 := 'Hello record using pointers';
  ShowRec(pRec^);
  Finalize(pRec^);
  freeMemory(pRec);
end;

begin
  DoTest;
end.