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@lists.freepascal.org
http://lists.freepascal.org/cgi-bin/mailman/listinfo/fpc-pascal
_______________________________________________
fpc-pascal maillist - fpc-pascal@lists.freepascal.org
http://lists.freepascal.org/cgi-bin/mailman/listinfo/fpc-pascal
