Interface delegation + overriding

Question

Due to the lack of multiple inheritance in Delphi, I need to work with interface delegation. This is a very new topic to me and I have a problem with combining overridding with interface delegation.

The class TMyNode must inherit from TBaseClass and needs to implement IAddedStuff . I want to have the default implementation of all functions of IAddedStuff in TAddedStuffDefaultImplementation , so I don't need to have duplicate code for getters/setters everywhere. So, I have delegated those things using DefaultBehavior .

The problem is, that TAddedStuffDefaultImplementation is meant to have virtual methods, so I want to override them directly in TMyNode . This does work if I write FDefaultImplementation: TAddedStuffDefaultImplementation; instead of FDefaultImplementation: IAddedStuff; .

But now, for some reasons TAddedStuffDefaultImplementation will increase the Ref-Counter for x: TBaseClass;, so it cannot be freed. What should I do?

My simplified reproduction code is below:

program Project2;

{$APPTYPE CONSOLE}

{$R *.res}

uses
  System.SysUtils;

type
  IAddedStuff = interface(IInterface)
  ['{9D5B00D0-E317-41A7-8CC7-3934DF785A39}']
    function GetCaption: string; {virtual;}
  end;

  TAddedStuffDefaultImplementation = class(TInterfacedObject, IAddedStuff)
    function GetCaption: string; virtual;
  end;

  TBaseClass = class(TInterfacedObject);

  TMyNode = class(TBaseClass, IAddedStuff)
  private
    FDefaultImplementation: TAddedStuffDefaultImplementation;
  public
    property DefaultBehavior: TAddedStuffDefaultImplementation read FDefaultImplementation
      write FDefaultImplementation implements IAddedStuff;
    destructor Destroy; override;

    // -- IAddedStuff
    // Here are some functions which I want to "override" in TMyNode.
    // All functions not declared here, should be taken from FDefaultImplementation .
    function GetCaption: string; {override;}
  end;

{ TAddedStuffDefaultImplementation }

function TAddedStuffDefaultImplementation.GetCaption: string;
begin
  result := 'PROBLEM: CAPTION NOT OVERRIDDEN';
end;

{ TMyNode }

destructor TMyNode.Destroy;
begin
  if Assigned(FDefaultImplementation) then
  begin
    FDefaultImplementation.Free;
    FDefaultImplementation := nil;
  end;

  inherited;
end;

function TMyNode.GetCaption: string;
begin
  Result := 'OK: Caption overridden';
end;

var
  x: TBaseClass;
  gn: IAddedStuff;
  s: string;
begin
  x := TMyNode.Create;
  try
    TMyNode(x).DefaultBehavior := TAddedStuffDefaultImplementation.Create;
    Assert(Supports(x, IAddedStuff, gn));
    WriteLn(gn.GetCaption);
  finally
    WriteLn('RefCount = ', x.RefCount);
    // x.Free; // <-- FREE fails since FRefCount is 1
  end;
  ReadLn(s);
end.

Answer 1

If you are delegating the IAddedStuff then you should also implement non-default behavior on another class and pass it by constructor injection.

Also if you are mixing object and interface references, make sure the ref counting does not conflict. When using interface delegation the reference of the container object gets changed.

program Project1;

{$APPTYPE CONSOLE}

uses
  Classes,
  SysUtils;

type
  IAddedStuff = interface(IInterface)
  ['{9D5B00D0-E317-41A7-8CC7-3934DF785A39}']
    function GetCaption: string; {virtual;}
  end;

  TAddedStuffDefaultImplementation = class(TInterfacedObject, IAddedStuff)
    function GetCaption: string; virtual;
  end;

  TAddedStuffOverriddenImplementation = class(TAddedStuffDefaultImplementation)
    function GetCaption: string; override;
  end;

  TBaseClass = class(TInterfacedPersistent);

  TMyNode = class(TBaseClass, IAddedStuff)
  private
    FAddedStuff: IAddedStuff;
    property AddedStuff: IAddedStuff read FAddedStuff implements IAddedStuff;
  public
    constructor Create(const addedStuff: IAddedStuff);
  end;

{ TAddedStuffDefaultImplementation }

function TAddedStuffDefaultImplementation.GetCaption: string;
begin
  result := 'PROBLEM: CAPTION NOT OVERRIDDEN';
end;

{ TAddedStuffOverriddenImplementation }

function TAddedStuffOverriddenImplementation.GetCaption: string;
begin
  Result := 'OK: Caption overridden';
end;

{ TMyNode }

constructor TMyNode.Create;
begin
  FAddedStuff := addedStuff;
end;

var
  x: TBaseClass;
  gn: IAddedStuff;
begin
  x := TMyNode.Create(TAddedStuffOverriddenImplementation.Create);
  try
    Assert(Supports(x, IAddedStuff, gn));
    WriteLn(gn.GetCaption);
  finally
    x.Free;
  end;
  Readln;
  ReportMemoryLeaksOnShutdown := True;
end.

Edit:

After the discussion in the comments I would suggest the following:

program Project1;

{$APPTYPE CONSOLE}

uses
  Classes,
  SysUtils;

type
  IAddedStuff = interface(IInterface)
  ['{9D5B00D0-E317-41A7-8CC7-3934DF785A39}']
    function GetCaption: string;
  end;

  TAddedStuffDefaultImplementation = class(TInterfacedObject, IAddedStuff)
    function GetCaption: string; virtual;
  end;

  TBaseClass = class(TInterfacedPersistent);

  TMyNode = class(TBaseClass, IAddedStuff)
  private
    FAddedStuff: IAddedStuff;
    property AddedStuff: IAddedStuff read FAddedStuff implements IAddedStuff;
  public
    constructor Create;
  end;

  TAddedStuffOverriddenImplementation = class(TAddedStuffDefaultImplementation)
  private
    FMyNode: TMyNode;
  public
    constructor Create(AMyNode: TMyNode);
    function GetCaption: string; override;
  end;

{ TAddedStuffDefaultImplementation }

function TAddedStuffDefaultImplementation.GetCaption: string;
begin
  result := 'PROBLEM: CAPTION NOT OVERRIDDEN';
end;

{ TMyNode }

constructor TMyNode.Create;
begin
  FAddedStuff := TAddedStuffOverriddenImplementation.Create(Self);
end;

{ TAddedStuffOverriddenImplementation }

constructor TAddedStuffOverriddenImplementation.Create(AMyNode: TMyNode);
begin
  FMyNode := AMyNode;
end;

function TAddedStuffOverriddenImplementation.GetCaption: string;
begin
  Result := 'OK: Caption overridden';
end;


var
  x: TBaseClass;
  gn: IAddedStuff;
begin
  x := TMyNode.Create;
  try
    Assert(Supports(x, IAddedStuff, gn));
    WriteLn(gn.GetCaption);
  finally
    x.Free;
  end;
  ReadLn;
  ReportMemoryLeaksOnShutdown := True;
end.