[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.