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

[Tony Whyman]

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.