[SOLVED] Weird Memory Leak!!

[garlar27]

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.


@KpjComp: I didn't run your program but I did a set of procedures to test what you said and added to the User137's code. And yes the memory leak disappeared !!
Then I decided to change a little User137's code. So I removed mathematical operations involved so we have something easer to see (0..9) and skipped assignment in some parts of the record to check if the structure was cleaned correctly.

the new code is:

Code: [Select]

unit FrmMain;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls;

type
   PMyData = ^TMyData;
   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
   EMPTY_MY_DATA : TMyData = (
      Int1: 0;
      Str1: '';
      str2: '';
      Int2: 0;
   );

var
   Form1: TForm1;

implementation

{$R *.lfm}

procedure Init_1(var x);
begin
  Finalize(x);
  Initialize(x);
end;

procedure Init_2(var x);
begin
  Finalize(x);
  FillByte(x, SizeOf(x), 0);
  Initialize(x);
end;

procedure Init_3(var x);
begin
  Finalize(x);
  Initialize(x);
  FillByte(x, SizeOf(x), 0);
end;

procedure Init_4(var x);
begin
  Finalize(x);
  FillByte(x, SizeOf(x), 0);
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;

{ 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
    // ***** USE ONLY ONE OF THESE *****
    //FillByte(Data, sizeof(Data), 0);
    //Data := EMPTY_MY_DATA;
    //Init_1(Data);
    //Init_2(Data);
    //Init_3(Data);
    Init_4(Data);
    //----------------------------------
    Data.Int1 := i;
    Data.Str1 := 'String1 = ' + IntToStr(i);
    if odd(i) then begin
       Data.str2 := 'String2 = ' + IntToStr(i);//(*i+10);
       Data.Int2 := i;//(i+1)*3;
    end;
    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.

and I have the following results for each method used:

Code: [Select]

USING: FillByte(Data, sizeof(Data), 0);
Output:
[0] [String1 = 0] [] [0]
[1] [String1 = 1] [String2 = 1] [1]
[2] [String1 = 2] [] [0]
[3] [String1 = 3] [String2 = 3] [3]
[4] [String1 = 4] [] [0]
[5] [String1 = 5] [String2 = 5] [5]
[6] [String1 = 6] [] [0]
[7] [String1 = 7] [String2 = 7] [7]
[8] [String1 = 8] [] [0]
[9] [String1 = 9] [String2 = 9] [9]
Heap dump by heaptrc unit
1278 memory blocks allocated : 1540002/1544048
1265 memory blocks freed     : 1539742/1543736
13 unfreed memory blocks : 260
True heap size : 229376
True free heap : 228128
Should be : 228232

USING: Data := EMPTY_MY_DATA;
Output:
[0] [String1 = 0] [] [0]
[1] [String1 = 1] [String2 = 1] [1]
[2] [String1 = 2] [] [0]
[3] [String1 = 3] [String2 = 3] [3]
[4] [String1 = 4] [] [0]
[5] [String1 = 5] [String2 = 5] [5]
[6] [String1 = 6] [] [0]
[7] [String1 = 7] [String2 = 7] [7]
[8] [String1 = 8] [] [0]
[9] [String1 = 9] [String2 = 9] [9]

USING: Init_1(Data);
Output:
[0] [String1 = 0] [] [8]
[1] [String1 = 1] [String2 = 1] [1]
[2] [String1 = 2] [String2 = 1] [1]
[3] [String1 = 3] [String2 = 3] [3]
[4] [String1 = 4] [String2 = 3] [3]
[5] [String1 = 5] [String2 = 5] [5]
[6] [String1 = 6] [String2 = 5] [5]
[7] [String1 = 7] [String2 = 7] [7]
[8] [String1 = 8] [String2 = 7] [7]
[9] [String1 = 9] [String2 = 9] [9]

USING: Init_2(Data);
Output:
[0] [String1 = 0] [] [232]
[1] [String1 = 1] [String2 = 1] [1]
[2] [String1 = 2] [String2 = 1] [1]
[3] [String1 = 3] [String2 = 3] [3]
[4] [String1 = 4] [String2 = 3] [3]
[5] [String1 = 5] [String2 = 5] [5]
[6] [String1 = 6] [String2 = 5] [5]
[7] [String1 = 7] [String2 = 7] [7]
[8] [String1 = 8] [String2 = 7] [7]
[9] [String1 = 9] [String2 = 9] [9]

USING: Init_3(Data);
Output:
[0] [String1 = 0] [] [72]
[1] [String1 = 1] [String2 = 1] [1]
[2] [String1 = 2] [String2 = 1] [1]
[3] [String1 = 3] [String2 = 3] [3]
[4] [String1 = 4] [String2 = 3] [3]
[5] [String1 = 5] [String2 = 5] [5]
[6] [String1 = 6] [String2 = 5] [5]
[7] [String1 = 7] [String2 = 7] [7]
[8] [String1 = 8] [String2 = 7] [7]
[9] [String1 = 9] [String2 = 9] [9]

USING: Init_4(Data);
Output:
[0] [String1 = 0] [] [248]
[1] [String1 = 1] [String2 = 1] [1]
[2] [String1 = 2] [String2 = 1] [1]
[3] [String1 = 3] [String2 = 3] [3]
[4] [String1 = 4] [String2 = 3] [3]
[5] [String1 = 5] [String2 = 5] [5]
[6] [String1 = 6] [String2 = 5] [5]
[7] [String1 = 7] [String2 = 7] [7]
[8] [String1 = 8] [String2 = 7] [7]
[9] [String1 = 9] [String2 = 9] [9]

The result I expected is the one achieved with a constant assignment and FillByte (which causes a memory leak).

So I guess I'm missing something.

I didn't try anything with PMyData since its a new memory position and when FillByte overwrites the refcount, it set the same value it had previously.

Does anybody knows where i can find documentation about Initialize and Finalize?

[marcov]

So I guess I'm missing something.

Initialize Finalize only works on properly typed data. Not on arbitrary VAR pointers.
 

[garlar27]

So I guess I'm missing something.

Initialize Finalize only works on properly typed data. Not on arbitrary VAR pointers.

Thanks marcov.

[KpjComp]

Yes,

Like marcov has pointed out, Initialize/Finalize won't work on a VAR pointer, it has no TypeInfo for it too work from.

But if your willing to pass the TypeInfo to the procedure, then you can make a function to clear the record.

It's not complete for all field types, but if you look at the source you should be able to figure out what to change.  For simple types just add them to the SimpleClear Enum, and for managed types update the case statement, I've done AnsiString & Widestring to get you started.

Once done, clearing a record is as simple as ->

Code: [Select]

ClearRecord(Rec,typeinfo(Rec));

The only problem I foresee, is if the RTTI structure for Records change in the future, so be aware of this.

Here is an example ->

Code: [Select]


program project1;

{$mode objfpc}{$H+}

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

type

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

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

type
  PRecordElement=^TRecordElement;
  TRecordElement=packed record
    TypeInfo: Pointer;
    Offset: Longint;
  end;

  PRecordInfo=^TRecordInfo;
  TRecordInfo=packed record
    Size: Longint;
    Count: Longint;
    { Elements: array[count] of TRecordElement }
  end;

const
  SimpleClear = [ tkInteger, tkInt64, tkUChar, tkQWord ];

procedure ClearRecord(var x; tp:PTypeInfo);
var
  p,pt,pdata:PByte;
  eti:PTypeInfo;
  pr:PRecordInfo;
  re:PRecordElement;
  l,lastoffset:integer;
  SimpleClearLast:boolean;
begin
  p := @x;
  if PTypeInfo(tp)^.Kind <> tkRecord then
    raise Exception.Create('Var not a record');
  pr := PRecordInfo(
        PByte(tp)+ord(PTypeInfo(tp)^.Name[0]) +1 +sizeof(TTypeKind));
  re := PRecordElement(
        PByte(pr)+sizeof(TRecordInfo));
  lastoffset := 0;
  SimpleClearLast := false;
  for l := 0 to pr^.Count-1 do
  begin
    if SimpleClearLast then
      FillByte( (p+lastoffset)^, re^.Offset - lastoffset, 0);
    eti := PTypeInfo(re^.TypeInfo);
    if eti^.Kind in SimpleClear then
      SimpleClearLast := true
    else begin
      SimpleClearLast := false;
      pdata := pbyte(p+re^.offset);
      case PTypeInfo(re^.TypeInfo)^.Kind of
        tkAString: PAnsiString(pdata)^ := '';
        tkWString: PWideString(pdata)^ := '';
      else
        raise Exception.Create('type not implemented:'+
          GetEnumName(TypeInfo(TTypeKind),ord(PTypeInfo(re^.TypeInfo)^.Kind)));
      end;
    end;
    lastoffset := re^.Offset;
    inc(re,1);
  end;
  if SimpleClearLast then
    FillByte( (p+lastoffset)^, pr^.Size - lastoffset,0);
end;

procedure DoTest;
var
  pRec:PTest;
  Rec:TTest;
begin
  Rec.str1:='These should';
  Rec.str2:='Clear';
  Rec.int1:=99;
  ShowRec(Rec);
  writeln('Now clear...');
  ClearRecord(Rec,typeinfo(Rec));
  ShowRec(Rec);
end;

begin
  DoTest;
end.

The output on my machine ->

Code: [Select]

str1 = These should
int1 = 99
widestr = Clear
Now clear...
str1 =
int1 = 0
widestr =
Heap dump by heaptrc unit
71 memory blocks allocated : 1641/1792
71 memory blocks freed     : 1641/1792
0 unfreed memory blocks : 0
True heap size : 163840 (96 used in System startup)
True free heap : 163744


[garlar27]

It seems like I need to understand a little more about the knots and bolts of FPC.

I will try to expand the example to see if I understand what is going on.

[Martin_fr]

Have you tried

Code: [Select]

procedure MyFillByte(out x;count:SizeInt;value:byte);
begin
  FillByte(x, count,value);
end;

AFAIK the "out" resets all the managed types

However if you use AllocMem, then you must (once, the first time) use the real fillbyte

[garlar27]

Have you tried

Code: [Select]

procedure MyFillByte(out x;count:SizeInt;value:byte);
begin
  FillByte(x, count,value);
end;

AFAIK the "out" resets all the managed types

However if you use AllocMem, then you must (once, the first time) use the real fillbyte

Wow!! It worked!!!
And it's simple!!!

KpjComp's example works too, but is a little complicated.

This procedure goes directly to my toolbox!!
Or even better: it should be included in the System unit!!! 

Thank you very much!

[KpjComp]

KpjComp's example works too, but is a little complicated.

Yes, I did wonder if there was an easer way.  I'm new to Lazarus, and trying to get my head around why the out parameter works. 

I assume it goes like this..
1.  The out parameter is telling the compiler it's expecting a return, as such it needs to reset the structure (finalize).
2.  While inside the procedure, the out parameter is undefined, as such Initialize isn't called at this point, so it's safe to do the FillByte.
3.  When the function returns, the compiler knows it's not been initialized (it can't have been, because no type was sent to the function), so now it initialize's the record buffer.

I assume the magic here, is that the out parameter is undefined type, if it had been a defined type then the initialize would have been done inside the function instead.

[garlar27]

KpjComp's example works too, but is a little complicated.

Yes, I did wonder if there was an easer way.  I'm new to Lazarus, and trying to get my head around why the out parameter works. 

I assume it goes like this..
1.  The out parameter is telling the compiler it's expecting a return, as such it needs to reset the structure (finalize).
2.  While inside the procedure, the out parameter is undefined, as such Initialize isn't called at this point, so it's safe to do the FillByte.
3.  When the function returns, the compiler knows it's not been initialized (it can't have been, because no type was sent to the function), so now it initialize's the record buffer.

I assume the magic here, is that the out parameter is undefined type, if it had been a defined type then the initialize would have been done inside the function instead.

At first sight, when I saw what Martin_fr did. I thought it was pretty obvious and felt ashamed of not have think about that before. But now, reading your post and giving a second thought, I realize that I have no clue why it works

Shame on me!!!