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.

Hi,

See the "problem" bellow:

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

and...

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

You're treating the instance using class types instead of interface type.

You can:

1. Change FMyInterface: TDelegateClass to FMyInterface: IMyInterface; or
2. Destroy FMyInterface on destructor.

Best regards,
Marcos Douglas

Marcos,

Thanks for the suggestions, but I had already tried the first variation:

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

and that did not work.

Destroying FMyInterface in the destructor does not make a difference - mainly because the TMyClass destructor is not being called anyway.

Just trying some further variations:

with

   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;

the output is:

Creating TDelegateClass
Creating TMyClass
Creating TDelegateClass
Destroying TDelegateClass

so it is actually worse with both interfaces left dangling

You get the same result with:

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

It should be called, but is not. Strange.
I tried to change the code to not using Application, DoRun, etc but the result is same.

On Wed, Aug 10, 2016 at 10:14 AM, Tony Whyman
wrote:> the output is:

Yeah, I saw the same.
I think this is a bug. I not for FPC 3.0. I'm using FPC 2.6.

If no more answers, you should report this in Bugtrack.

I use Interfaces a lot, but not the 'implements' feature.

Best regards,
Marcos Douglas

In our previous episode, Marcos Douglas said:

There is still mixing of classes and interfaces going on.

Rule of thumb is that unless you are _VERY_ sure about what you are doing, create the class directly to an interface typed variable, and keep in interface typed variables.

The way how Tony passes owner is wrong and that messes up reference counting.

If in the test he would do TMyclass.Create(Tsomeclass.create); it probably would be ok.

But in my test, the code reads:

    Intf := TMyClass.Create(TDelegateClass.Create);

So, why didn't this work?

+1
Is the same as Michael wrote.

[off]
Tony,

You need to be careful when you use Interfaces and constructions like above. Using constructions like that, you always need to remember: "Now I need a local variable to the compiler do the refcount..." "Here isn't necessary, because the argument is an interface type variable..." ...and so on.

For this "problem" I have my own pattern. I wrote about it here http://objectpascalprogramming.com/posts/interfaces-e-o-metodo-estatico-new/ I write in Portuguese, but you can translate easily. [/off]

Marcos Douglas

Tony Whyman wrote

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.

Maybe I'm missing something, but here is a quick example I put together. Testing with FPC 2.6.4 under FreeBSD and classes are created and freed as they are supposed to.

Here is the console output:

$ ./test2
Creating TMyClass
Creating TMyInterface
TMyInterface.P1
TMyInterface.P2
Destroying TMyClass
Destroying TMyInterface

And the code for the test project.

===================[ test2.pas ]=======================
program test2;
{$mode objfpc}{$H+}

{ Delegating to an interface-type property }

type
  IMyInterface = interface
    procedure P1;
    procedure P2;
  end;
  TMyInterface = class(TInterfacedObject, IMyInterface)
  private
     procedure P1;
     procedure P2;
  public
    constructor Create;
    destructor Destroy; override;
  end;
  TMyClass = class(TObject, IMyInterface)
    FMyInterface: IMyInterface;
    property MyInterface: IMyInterface read FMyInterface implements
IMyInterface;
  public
    constructor Create;
    destructor Destroy; override;
  end;
procedure TMyInterface.P1;
begin
  writeln('TMyInterface.P1');
end;
procedure TMyInterface.P2;
begin
  writeln('TMyInterface.P2');
end;
constructor TMyInterface.Create;
begin
  writeln('Creating ',ClassName);
end;
destructor TMyInterface.Destroy;
begin
  writeln('Destroying ',ClassName);
  inherited Destroy;
end;
var
  MyClass: TMyClass;
  MyInterface: IMyInterface;

{ TMyClass }

constructor TMyClass.Create;
begin
  writeln('Creating ',ClassName);
end;
destructor TMyClass.Destroy;
begin
  writeln('Destroying ',ClassName);
  inherited Destroy;
end;
begin
  MyClass := TMyClass.Create;
  MyClass.FMyInterface := TMyInterface.Create;  // some object whose
class implements IMyInterface
  MyInterface := MyClass;
  MyInterface.P1;
  MyInterface.P2;
  MyClass.Free;
end.

========================[ end ]========================

Regards,
Graeme

Graeme,

You are explicitly freeing MyClass. My point is that with reference counted interfaces and in the example I posted, you shouldn't have to explicitly free the delegated interface. It should be freed automatically as soon as it goes out of scope.

Tony Whyman

MWA

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

So, in that way you will need to use 'cast' to work with Intf1 variable because it is not a IMyInterface type, right? Sounds like a workaround to me, not a good solution.

Maybe I may have missed something, but I still think this is a bug.

Best regards,
Marcos Douglas

Tony Whyman wrote

You are explicitly freeing MyClass. My point is that with reference counted interfaces and in the example I posted, you shouldn't have to explicitly free the delegated interface. It should be freed automatically as soon as it goes out of scope.

Let me explain with a slightly modified example. NOTE: I get the exact same behaviour under FPC 2.6.4 and under Delphi 7.

The reason I [must] free the TMyClass instance is because it is a TObject descendant. Obviously I can query the interface from that instance and don't have to free anything interface related.

In the second test project I create a TMyInterface instance, which is a TInterfaceObject descendant. I store it directly to a interface reference variable, and then use the interface as needed. I don't need to free anything here, because TInterfaceObject is reference counted and will free itself once it goes out of scope.

I think you are getting confused between TObject and TInterfaceObject instances, and what is required from both.

=====================[ test2.pas ]===========================
program test2;
{$mode objfpc}{$H+}
{$interfaces com}

{ Delegating to an interface-type property }

uses
Classes,

  SysUtils;

type
  IMyInterface = interface
  ['{9CF79E28-6527-11E6-9A7E-C86000E37EB0}']
    procedure P1;
    procedure P2;
  end;
  TMyInterface = class(TInterfacedObject, IMyInterface)
  private
     procedure P1;
     procedure P2;
  public
    constructor Create;
    destructor Destroy; override;
  end;
  TMyClass = class(TObject, IMyInterface)
    FMyInterface: IMyInterface;
    property MyInterface: IMyInterface read FMyInterface implements
IMyInterface;
  public
    constructor Create;
    destructor Destroy; override;
  end;
procedure TMyInterface.P1;
begin
  writeln('TMyInterface.P1');
end;
procedure TMyInterface.P2;
begin
  writeln('TMyInterface.P2');
end;
constructor TMyInterface.Create;
begin
  writeln('Creating ',ClassName);
end;
destructor TMyInterface.Destroy;
begin
  writeln('Destroying ',ClassName);
  inherited Destroy;
end;

{ TMyClass }

constructor TMyClass.Create;
begin
  writeln('Creating ',ClassName);
  FMyInterface := TMyInterface.Create;
end;
destructor TMyClass.Destroy;
begin
  writeln('Destroying ',ClassName);
  inherited Destroy;
end;
  procedure Test1;
  var
    MyClass: TMyClass;
    MyInterface: IMyInterface;
  begin
    MyInterface := nil;
    MyClass := TMyClass.Create;
    if Supports(MyClass, IMyInterface, MyInterface) then
    begin
      MyInterface.P1;
      MyInterface.P2;
    end;
    MyClass.Free; // because TMyClass is a TObject descendant
  end;
  procedure Test2;
  var
    MyInterface: IMyInterface;
  begin
    MyInterface := TMyInterface.Create;
    MyInterface.P1;
    MyInterface.P2;
    MyInterface := nil; // optional
  end;
begin
  Test1;
  writeln('=========================');
  Test2;
end.

===================[ end ]===================================

And the output of the program gives this....

$ ./test2.exe
Creating TMyClass
Creating TMyInterface
TMyInterface.P1
TMyInterface.P2
Destroying TMyClass
Destroying TMyInterface
=========================
Creating TMyInterface
TMyInterface.P1
TMyInterface.P2
Destroying TMyInterface

which is expected and correct.

Regards,
Graeme

Graeme Geldenhuys wrote

I think you are getting confused between TObject and TInterfaceObject instances, and what is required from both.

No, the problem is that I could not find a way of achieving what I wanted to achieve. That is ensuring that an interfaced object that used a delegated interface would be reference counted and hence automatically destroyed. The derived requirement is that I wanted neither a memory leak nor the risk of a double free.

What I eventually discovered is that if an interfaced object is defined as:

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

and then a TMyClass object is assigned to a variable of type IMyInterface, the result is that the compiler ignores the TMyClass object and references solely the object implementing IMyInterface i.e. the TDelegateClass object. Intuitively, I had expected the reference to be to the TMyClass Object as that was the one I assigned to the variable.

The result is that neither object gets freed automatically. The TMyClass object does not get freed because it was ignored when the interface was assigned and the TDelegateClass object was not freed because TMyClass still has a reference to it.

On the other hand, if I assign a TMyClass object to a variable of type IUnknown (which both TMyClass and TDelegateClass inherit), the compiler now takes the interface from TMyClass and references this object. The result is that at the end of the program both objects are automatically destroyed.

I would certainly argue that this is confusing and counter-intuitive. I can be persuaded either way that it is a bug or a feature, but I would also argue that the intuitive outcome would be for the compiler to take the reference to the TMyClass object in all cases.

Whatever view you take, the resulting behaviour needs to be carefully documented as it is inviting memory leaks/double frees.