delphi - Interface delegation + overriding -

due lack of multiple inheritance in delphi, need work interface delegation. new topic me , have problem combining overridding interface delegation.

the class tmynode must inherit tbaseclass , needs implement iaddedstuff . want have default implementation of functions of iaddedstuff in taddedstuffdefaultimplementation , don't need have duplicate code getters/setters everywhere. so, have delegated things using defaultbehavior .

the problem is, taddedstuffdefaultimplementation meant have virtual methods, want override them directly in tmynode . work if write fdefaultimplementation: taddedstuffdefaultimplementation; instead of fdefaultimplementation: iaddedstuff; .

but now, reasons taddedstuffdefaultimplementation increase ref-counter x: tbaseclass;, cannot freed. should do?

my simplified reproduction code 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 functions want "override" in tmynode.     // functions not declared here, should taken 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)   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);       writeln('refcount = ', x.refcount);     // x.free; // <-- free fails since frefcount 1   end;   readln(s); end. 

if delegating iaddedstuff should implement non-default behavior on class , pass constructor injection.

also if mixing object , interface references, make sure ref counting not conflict. when using interface delegation reference of 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);       x.free;   end;   readln;   reportmemoryleaksonshutdown := true; end. 

edit:

after discussion in comments suggest 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);       x.free;   end;   readln;   reportmemoryleaksonshutdown := true; end.