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

[Marcos Douglas]

Hi,

Tony Whyman had posted on August 10 a problem with the compiler using
Delegates.
He used a workaround to "solve" his problem and the thread died.

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.

=== BEGIN CODE ===

program Project1;

{$mode objfpc}{$H+}

uses
  Classes, SysUtils;

type
  IValue = interface
    function AsString: string;
  end;

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

  TMyApp = class(TInterfacedObject, IValue)
  private
    FValue: IValue;
  public
    constructor Create(Value: Integer);
    destructor Destroy; override;
    property Value: IValue read FValue implements IValue;
  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 }

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

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

// Program

procedure ExecuteIntegerValue;
var
  V: IValue;
begin
  WriteLn;
  WriteLn('IntegerValue:');
  V := TIntegerValue.Create(5);
  WriteLn(V.AsString);
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
  V: IValue;
begin
  WriteLn;
  WriteLn('MyAppAsInterface:');
  V := TMyApp.Create(20);
  WriteLn(V.AsString);
end;

begin
  ExecuteIntegerValue;
  ExecuteMyApp;
  ExecuteMyAppAsInterface;
  ReadLn;
end.

=== END CODE ===


Here is the output on my machine (Lazarus 1.7 r52880M FPC 3.0.1
i386-win32-win32/win64)


=== BEGIN OUTPUT ===

W:\temp>project1.exe

IntegerValue:
TIntegerValue.Create
Number is 5
TIntegerValue.Destroy

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

MyAppAsInterface:
TIntegerValue.Create
TMyApp.Create
Number is 20

Heap dump by heaptrc unit
83 memory blocks allocated : 2017/2200
81 memory blocks freed     : 1981/2160
2 unfreed memory blocks : 36
True heap size : 229376 (80 used in System startup)
True free heap : 229104
Should be : 229128
Call trace for block $01812928 size 20
  $004017DA  TMYAPP__CREATE,  line 59 of W:/temp/project1.lpr
  $00401B82  EXECUTEMYAPPASINTERFACE,  line 101 of W:/temp/project1.lpr
  $00401C08  main,  line 108 of W:/temp/project1.lpr
Call trace for block $018128C8 size 16
  $00401B82  EXECUTEMYAPPASINTERFACE,  line 101 of W:/temp/project1.lpr
  $00401C08  main,  line 108 of W:/temp/project1.lpr

W:\temp>

=== END OUTPUT ===


As you can see, the problem occurs just in the last test, when the classe
TMyApp is used as an instance of the interface IValue.

I don't know if this problem was solved on trunk. I would like to know.
If not solved, I will open an issue.

Best regards,
Marcos Douglas
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://lists.freepascal.org/pipermail/fpc-pascal/attachments/20161005/f6c8e225/attachment.html>