Re: [fpc-pascal] A serious Memleak using delegates/implements (was: Delegate Interface class does not seem to be referenced counted)

[Graeme Geldenhuys]

On 2016-10-05 16:26, Marcos Douglas wrote:
> So, I coded a new example — more simpler, I think — to demonstrate the same
> problem and prove that there is some wrong that is causing a memleak.

And here is that example converted to use CORBA style interfaces and no
memory leaks.


Program output:

==========================================================
[tmp]$ ./test.exe

IntegerValue:
TIntegerValue.Create
Number is 5
TIntegerValue.Destroy

MyApp:
TIntegerValue.Create
TMyApp.Create
Number is 10
TIntegerValue.Destroy
TMyApp.Destroy

MyAppAsInterface:
TIntegerValue.Create
TMyApp.Create
Number is 20
TIntegerValue.Destroy
TMyApp.Destroy

Heap dump by heaptrc unit
29 memory blocks allocated : 2045/2080
29 memory blocks freed     : 2045/2080
0 unfreed memory blocks : 0
True heap size : 1409024 (32 used in System startup)
True free heap : 1408992

==========================================================


Regards,
  Graeme

-- 
fpGUI Toolkit - a cross-platform GUI toolkit using Free Pascal
http://fpgui.sourceforge.net/

My public PGP key:  http://tinyurl.com/graeme-pgp

program Project1;

{$mode objfpc}{$H+}
{$interfaces corba}

uses
  Classes,
  SysUtils;

type
  IValue = interface
  ['{C3151460-CA9B-447A-A7E8-86399222E844}']
    function AsString: string;
  end;

  TIntegerValue = class(TObject, IValue)
  private
    FValue: Integer;
  public
    constructor Create(Value: Integer);
    destructor Destroy; override;
    function AsString: string;
  end;

  TMyApp = class(TObject, IValue)
  private
    FValue: TIntegerValue;
    function GetValue: IValue;
    // this interface property doesn't need to be public
    property Value: IValue read GetValue implements IValue;
  public
    constructor Create(AValue: Integer);
    destructor Destroy; override;
  end;

{ TIntegerValue }

constructor TIntegerValue.Create(Value: Integer);
begin
  inherited Create;
  FValue := Value;
  WriteLn('TIntegerValue.Create');
end;

destructor TIntegerValue.Destroy;
begin
  WriteLn('TIntegerValue.Destroy');
  inherited Destroy;
end;

function TIntegerValue.AsString: string;
begin
  Result := 'Number is ' + IntToStr(FValue);
end;

{ TMyApp }

function TMyApp.GetValue: IValue;
begin
  Result := FValue;
end;

constructor TMyApp.Create(AValue: Integer);
begin
  inherited Create;
  FValue := TIntegerValue.Create(AValue);
  WriteLn('TMyApp.Create');
end;

destructor TMyApp.Destroy;
begin
  FValue.Free;
  WriteLn('TMyApp.Destroy');
  inherited Destroy;
end;

// Program

procedure ExecuteIntegerValue;
var
  i: TIntegerValue;
  V: IValue;
begin
  WriteLn;
  WriteLn('IntegerValue:');
  i := TIntegerValue.Create(5);
  V := i;
  WriteLn(V.AsString);
  i.Free;
end;

procedure ExecuteMyApp;
var
  App: TMyApp;
begin
  WriteLn;
  WriteLn('MyApp:');
  App := TMyApp.Create(10);
  try
    WriteLn(App.Value.AsString);
  finally
    App.Free;
  end;
end;

procedure ExecuteMyAppAsInterface;
var
  app: TMyApp;
  V: IValue;
begin
  WriteLn;
  WriteLn('MyAppAsInterface:');
  try
    app := TMyApp.Create(20);
    V := app;
    WriteLn(V.AsString);
  finally
    app.Free;
  end;
end;

begin
  ExecuteIntegerValue;
  ExecuteMyApp;
  ExecuteMyAppAsInterface;
  ReadLn;
end.


_______________________________________________
fpc-pascal maillist  -  fpc-pascal@lists.freepascal.org
http://lists.freepascal.org/cgi-bin/mailman/listinfo/fpc-pascal