[fpc-devel] Interface delegation - workaround?

[Graeme Geldenhuys]

Hi

Regarding bug #12778
   http://bugs.freepascal.org/view.php?id=12778


Like I said before, I am no expert in using Interfaces. But why can't
I do the following (see code below), which works perfectly when I run
the program. Using delegation define or usecorba define in any
combination. It's the same code as in the bug report, but I modified
the property Hook to be an interface type.

What's the difference having

  property Hook: ITestInterface ... implements...
vs
  property Hook: THook ... implements..."

On strange thing I have noticed in the code below, is that I get 1
memory leak. FHook is not freed in some cases.

========================================
program testdelegation;

// Use to enable/disable delegation. For FPC/Delphi
{$define usedelegation}

{$ifdef fpc}
  // Use to enable/disable corba only for fpc
  {.$define usecorba}
{$endif}

{$ifdef fpc}
  {$ifdef usecorba}
    {$interfaces corba}
  {$endif}
{$endif}

const
  STestInterface = '{3FB19775-F5FA-464C-B10C-D8137D742088}';

type
  ITestInterface = interface
    [STestInterface]
    procedure DoSomething;
  end;

  {$ifndef usecorba}
  TBaseObject = class(TInterfacedObject);
  {$else}
  TBaseObject = class(TObject);
  {$endif}


  THook = class(TBaseObject, ITestInterface)
    procedure DoSomething;
  end;


  TRealClass = class(TBaseObject, ITestInterface)
  private
    FHook: ITestInterface;
  public
    constructor Create;
    destructor Destroy; override;
    {$ifndef usedelegation}
    procedure DoSomething;
    {$else}
    property Hook: ITestInterface read FHook implements ITestInterface;
    {$endif}
  end;

  { TRealClass }

  constructor TRealClass.Create;
  begin
    FHook := THook.Create;
  end;

  destructor TRealClass.Destroy;
  begin
    {$ifdef usedelegation}
//    FHook.Free;
    {$endif}
    inherited Destroy;
  end;

  {$ifndef usedelegation}
  procedure TRealClass.DoSomething;
  begin
    Writeln('Manual delegation');
    FHook.DoSomething;
  end;
  {$endif}

  { THook }

  procedure THook.DoSomething;
  begin
    Writeln('Doing something !');
  end;

var
  R: TRealClass;
  I: ITestInterface;

begin
{$ifdef usecorba}
  Writeln('Using corba interfaces');
{$else}
  Writeln('Using regular interfaces');
{$endif}
  R := TRealClass.Create;
{$ifdef fpc}
  if R.GetInterface(STestInterface, I) then
{$else}
    if R.GetInterface(ITestInterface, I) then
{$endif}
    begin
      Writeln('Got interface OK. Calling it');
      I.DoSomething;
    end
    else
      Writeln('Interface not implemented !');
end.

========================================


Regards,
  - Graeme -


_______________________________________________
fpGUI - a cross-platform Free Pascal GUI toolkit
http://opensoft.homeip.net/fpgui/