[fpc-pascal] Delegate Interface class does not seem to be referenced counted [Solved]

[Tony Whyman]

I think that I have now found why the test program below (originally 
posted a couple of weeks ago) did not work. It seems that when an 
interface is delegated, the compiler may take a reference directly on 
the delegated part of the interface and not to the object doing the 
delegation.

In my original post, the main procedure was:

procedure TDelegateTest.DoRun;
var Intf: IMyInterface;
     Intf2: IMyInterface;
begin
    Intf := TMyClass.Create(TDelegateClass.Create);
    Intf2 := TDelegateClass.Create;
...

and the output showed that TMyClass was not being automatically 
destroyed. Changing the local variables declaration to:

procedure TDelegateTest.DoRun;
var Intf: IUnknown;
     Intf2: IMyInterface;

results in this output:

Creating TDelegateClass
Creating TMyClass
Creating TDelegateClass
Destroying TMyClass
Destroying TDelegateClass

That is TMyClass is now being automatically destroyed, while the 
TDelegateClass used to delegate the interface is not.

Changing the class definition to:

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

gives the output:

Creating TDelegateClass
Creating TMyClass
Creating TDelegateClass
Destroying TMyClass
Destroying TDelegateClass
Destroying TDelegateClass

which is really what I wanted. On the other hand, if I change the 
procedure header back to:

procedure TDelegateTest.DoRun;
var Intf: IMyInterface;
     Intf2: IMyInterface;
begin

the output is now back to:

Creating TDelegateClass
Creating TMyClass
Creating TDelegateClass
Destroying TDelegateClass

It seems that the main problem I had is due to the way the compiler 
chooses which interface to reference count when you get an interface 
from an object that has a delegated interface. If the type of the left 
hand side of the assignment is that of the delegated interface, it 
simply extracts that interface and only references it. On the other 
hand, if it is any other compatible interface type (even IUnknown) then 
the interface reference is to the object on the right hand side of the 
assignment rather than to the delegated object.

This is probably a feature rather than a bug, but is certainly 
confusing. It took me some time to get my head around it. The worst 
thing is that I took the example from the FPC Documentation. The FPC 
documentation on reference counting does not mention how it interacts 
with delegated interfaces. It probably should.

Tony Whyman
MWA


On 10/08/16 13:42, Tony Whyman wrote:
> I'm using fpc 3.0.0 and trying to debug a program using COM 
> interfaces. While reference counting seems to be working fine, there 
> is one exception, that is when an interface is being used by 
> delegation. In this case, the object doing the delegation does not 
> seem to be reference counted. Is this a bug, a feature, or have I 
> missed something?
>
> A simple test program follows. The output is:
>
> Creating TDelegateClass
> Creating TMyClass
> Creating TDelegateClass
> Destroying TDelegateClass
> Destroying TDelegateClass
>
> In the example, TMyClass is the interface class doing the delegation 
> and while TDelegateClass is being destroyed when it goes out of scope, 
> TMyClass is not.
>
> Tony Whyman
>
> MWA
>
> 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(TInterfacedObject, IMyInterface)
>    private
>      procedure P1;
>    public
>      constructor Create;
>      destructor Destroy; override;
>    end;
>
>    { TMyClass }
>
>    TMyClass = class(TInterfacedObject, IMyInterface)
>    private
>      FMyInterface: TDelegateClass; // class type
>      property MyInterface: TDelegateClass
>        read FMyInterface implements IMyInterface;
>    public
>      constructor Create(obj: TDelegateClass);
>      destructor Destroy; override;
>    end;
>
> { TDelegateClass }
>
> procedure TDelegateClass.P1;
> begin
>   writeln('P1');
> end;
>
> constructor TDelegateClass.Create;
> begin
>   inherited Create;
>   writeln('Creating ',ClassName);
> end;
>
> destructor TDelegateClass.Destroy;
> begin
>   writeln('Destroying ',ClassName);
>   inherited Destroy;
> end;
>
> { TMyClass }
>
> constructor TMyClass.Create(obj: TDelegateClass);
> begin
>   inherited Create;
>   FMyInterface := obj;
>   writeln('Creating ',ClassName);
> end;
>
> destructor TMyClass.Destroy;
> begin
>   writeln('Destroying ',ClassName);
>   inherited Destroy;
> end;
>
> { TDelegateTest }
>
> procedure TDelegateTest.DoRun;
> var Intf: IMyInterface;
>     Intf2: IMyInterface;
> begin
>    Intf := TMyClass.Create(TDelegateClass.Create);
>    Intf2 := TDelegateClass.Create;
>   // 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 at lists.freepascal.org
> http://lists.freepascal.org/cgi-bin/mailman/listinfo/fpc-pascal