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

[Tony Whyman]

On 07/10/16 12:29, stdreamer wrote:
The point is that you are trying to equate delegation with contained 
objects/interfaces and that is not what delegates are about. 
Delegation has nothing to do with the underlined mechanism you choose 
to use. 

Hmm, not so sure about that. I have updated my original example from 
August to use TContainedObject (see below). As a workaround for the 
interface delegation problem it works, as long as you don't try and use 
TDelegateClass on its own. This is because although it appears as a 
reference counted com interface, it still relies upon another object to 
free it. The example returns:

Creating TDelegateClass
Creating TMyClass
Creating TDelegateClass
Destroying TMyClass
Destroying TDelegateClass

i.e. there is a missing call to the TDelegateClass destructor. This is 
because I created it standalone (in "DoRun) just to illustrate the point.

There is a real need to update the FPC manual to include 
TContainedObject. It's importance for interface delegation and its 
limitations. How you implement interface delegation clearly has a big 
outcome on how the interface is used by the user.

program project1;

{$mode objfpc}{$H+}

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

type

  { TDelegateTest }

  TDelegateTest = class(TCustomApplication)
  protected
    procedure DoRun; override;
  public
    constructor Create(TheOwner: TComponent); override;
    destructor Destroy; override;
    procedure WriteHelp; virtual;
  end;

  IMyInterface = interface
     procedure P1;
   end;

      { TDelegateClass }

   TDelegateClass = class(TContainedObject, IMyInterface)
   private
     procedure P1;
   public
     constructor Create(aController: IUnknown);
     destructor Destroy; override;
   end;

   { TMyClass }

   TMyClass = class(TInterfacedObject, IMyInterface)
   private
     FMyInterface: TDelegateClass;
     property MyInterface: TDelegateClass
       read FMyInterface implements IMyInterface;
   public
     constructor Create;
     destructor Destroy; override;
   end;

{ TDelegateClass }

procedure TDelegateClass.P1;
begin
  writeln('P1');
end;

constructor TDelegateClass.Create(aController: IUnknown);
begin
  inherited Create(aController);
  writeln('Creating ',ClassName);
end;

destructor TDelegateClass.Destroy;
begin
  writeln('Destroying ',ClassName);
  inherited Destroy;
end;

{ TMyClass }

constructor TMyClass.Create;
begin
  inherited Create;
  FMyInterface := TDelegateClass.Create(self);
  writeln('Creating ',ClassName);
end;

destructor TMyClass.Destroy;
begin
  writeln('Destroying ',ClassName);
  if FMyInterface <> nil then FMyInterface.Free;
  inherited Destroy;
end;

{ TDelegateTest }

procedure TDelegateTest.DoRun;
var Intf: IUnknown;
    Intf2: IMyInterface;
begin
   Intf := TMyClass.Create;
   Intf2 := TDelegateClass.Create(Intf); {never destroyed}
  // stop program loop
  Terminate;
end;

constructor TDelegateTest.Create(TheOwner: TComponent);
begin
  inherited Create(TheOwner);
  StopOnException := True;
end;

destructor TDelegateTest.Destroy;
begin
  inherited Destroy;
end;

procedure TDelegateTest.WriteHelp;
begin
  { add your help code here }
  writeln('Usage: ', ExeName, ' -h');
end;

var
  Application: TDelegateTest;
begin
  Application := TDelegateTest.Create(nil);
  Application.Title := 'Interface Delegation Test';
  Application.Run;
  Application.Free;
end.

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