Containers 2. My own implementation of IUnknown and reference counting. And mixins

Original in Russian: http://18delphi.blogspot.ru/2013/04/iunknown.html

About containers. Table of contents

Borland (now - Embarcadero), naturally, has implementation of IUnknown. It is called TInterfacedObject.

And it is not bad.

But I personally am not satisfied with its dissymmetry. If one has created the interface, he should work through the interface and, I pray, forget about the object. Put it in container as interface and pass on as interface. Compared to the object, the interface is extra expenses – for the extra indirect character of the calls of methods (something like virtual) and for the extra AddRef/Release while assigning to local variables. The more so because of the fact that the public methods of the object are different from those of the interface. That is as it should be. The public character of methods can depend on the authority of the user of the object (that is, by the way, a subject of a separate post, which, besides, gunsmoker has approached in some way here: http://www.gunsmoker.ru/2013/02/delphi-friendliness.htm
I hope I understood him correctly and did not interpret his thoughts the way I liked).

I am not happy with it in my daily tasks. Moreover, historically, my implementation of reference counting dates back to Delphi 1, even BEFORE the concept of interfaces has been introduced. And the interfaces I emulated using hack VMT and message (as far as I can tell, gunsmoker also writes about the similar technique).

The history of how my own reference counting has appeared is worth of special post. Meanwhile, briefly – editor and Undo/Redo. Where objects do not have the centralized "dad" (Owner/Parent). All objects equally can contain a reference to other objects. It is guaranteed that the objects they refer to are “alive” as long as they contain the reference correctly.

Of course, the true holy war could be raised on “do as they say” and “wise men do not think up with no purpose”. But I would like to address this issue in a separate post, and here I’ll tell about my implementation and at the same time demonstrate one more time “micro”-UML and the technique of using “mixins”.

The previous series were here:
http://18delphi.blogspot.com/2015/02/containers-1-implementation-of.html 

Basing on this knowledge, let’s construct an object that implements IUnknown.

Let’s draw a pair of diagrams:

-- this is a “mixin” implementation of IUnknown.

And the specific implementation (inherited from TObject) is as follows:

The code for this all is like this:

RefCountedPrim.imp.pas:

{$IfNDef RefCountedPrim_imp}
 
//
// The library "L3$Basic Concepts"
// Generated from UML model, root element: <<impurity::class>> Shared Delphi Requirements for low-level libraries::L3$Basic Concepts::Ref Counting::RefCountedPrim
//
 
{$Define RefCountedPrim_imp}
 _RefCountedPrim_ = {mixin} class(_RefCountedPrim_Parent_)
 private
 // private fields
   f_RefCount : Integer;
    {* Field for the property RefCount}
 protected
 // overridden protected methods
   procedure FreeInstance; override;
 public
 // overridden public methods
   destructor Destroy; override;
   class function NewInstance: TObject; override;
 protected
 // protected methods
   procedure Cleanup; virtual;
     {* the function of object fields cleaning. }
 public
 // public methods
   function Use: Pointer;
     {* increment the reference counter by 1 and return the pointer to itself. }
   function SetRefTo(var F): Boolean;
 public
 // public properties
   property RefCount: Integer
     read f_RefCount;
 end;//_RefCountedPrim_
 
{$Else RefCountedPrim_imp}
 
// start class _RefCountedPrim_
 
procedure _RefCountedPrim_.Cleanup;
begin
end;//_RefCountedPrim_.Cleanup
 
function _RefCountedPrim_.Use: Pointer;
begin
 if (Self <> nil) then
  InterlockedIncrement(f_RefCount);
 Result := Self;
end;//_RefCountedPrim_.Use
 
function _RefCountedPrim_.SetRefTo(var F): Boolean;
begin
 if (Pointer(F) = Self) then
  Result := false
 else
 begin
  Result := true;
  TObject(F).Free;
  Pointer(F) := Self.Use;
 end;//Pointer(F) = V
end;//_RefCountedPrim_.SetRefTo
 
destructor _RefCountedPrim_.Destroy;
begin
  if (InterlockedDecrement(f_RefCount) = 0) then
  begin
   Inc(f_RefCount);
   try
    try
     Cleanup;
    finally
     inherited Destroy;
    end;//try..finally
   finally
    Dec(f_RefCount);
   end;{try..finally}
  end;//InterlockedDecrement(f_RefCount) = 0
end;//_RefCountedPrim_.Destroy
 
class function _RefCountedPrim_.NewInstance: TObject;
begin
 Result := inherited NewInstance;
 _RefCounted_(Result).Use;
end;//_RefCountedPrim_.NewInstance
 
procedure _RefCountedPrim_.FreeInstance;
begin
 if (f_RefCount = 0) then
  inherited FreeInstance;
end;//_RefCountedPrim_.FreeInstance
 
{$EndIf RefCountedPrim_imp}



-------------------------------
RefCounted.imp.pas:


{$IfNDef RefCounted_imp}
 
// The library "L3$Basic Concepts"
// Generated from UML model, root element: <<impurity::class>> Shared Delphi Requirements for low-level libraries::L3$Basic Concepts::Ref Counting::RefCounted
//
// In this class we collect methods which we are not allowed to override or call directly
//
 
{$Define RefCounted_imp}
 _RefCountedPrim_Parent_ = _RefCounted_Parent_;
 {$Include RefCountedPrim.imp.pas}
 _RefCounted_ = {mixin} class(_RefCountedPrim_)
  {* In this class we collect methods which we are not allowed to override or call directly }
 public
 // public methods
   destructor Destroy;
     {* To prevent being lured in overriding destroy. }
   class function NewInstance: TObject;
   procedure FreeInstance;
   procedure AfterConstruction;
   procedure BeforeDestruction;
 end;//_RefCounted_
 
{$Else RefCounted_imp}
 
{$Include RefCountedPrim.imp.pas}
 
// start class _RefCounted_
 
destructor _RefCounted_.Destroy;
begin
 assert(false, 'We are not supposed to get here'); 
 inherited;
end;//_RefCounted_.Destroy
 
class function _RefCounted_.NewInstance: TObject;
begin
 Result := nil;
 assert(false);
end;//_RefCounted_.NewInstance
 
procedure _RefCounted_.FreeInstance;
begin
 assert(false);
end;//_RefCounted_.FreeInstance
 
procedure _RefCounted_.AfterConstruction;
begin
 assert(false);
end;//_RefCounted_.AfterConstruction
 
procedure _RefCounted_.BeforeDestruction;
begin
 assert(false);
end;//_RefCounted_.BeforeDestruction
 
{$EndIf RefCounted_imp}

-------------------------------------------------
UnknownImpl.imp.pas:


{$IfNDef UnknownImpl_imp}
 
// The library "L3$Basic Concepts"
// Generated from UML model, root element: <<impurity::class>> Shared Delphi Requirements for the low-level libraries::L3$Basic Concepts::Ref Counting::UnknownImpl
//
 
{$Define UnknownImpl_imp}
 _RefCounted_Parent_ = _UnknownImpl_Parent_;
 {$Include RefCounted.imp.pas}
 _UnknownImpl_ = {mixin} class(_RefCounted_)
 public
 // realized methods
   function _AddRef: Integer; stdcall;
     {* Increments reference counter. }
   function _Release: Integer; stdcall;
     {* Decrements reference counter. }
   function QueryInterface(const IID: TGUID;
    out Obj): HResult; stdcall;
     {* Brings base interface to the required, if it is possible. }
 end;//_UnknownImpl_
 
{$Else UnknownImpl_imp}
 
{$Include RefCounted.imp.pas}
 
// start class _UnknownImpl_
 
function _UnknownImpl_._AddRef: Integer;
begin
 Use;
 Result := RefCount;
 // - here we’ve got problems with multithreading
end;//_UnknownImpl_._AddRef
 
function _UnknownImpl_._Release: Integer;
var
 l_RC : Integer;
begin
 l_RC := RefCount - 1;
 Free;
 Result := l_RC;
 // - here we’ve got problems with multithreading
end;//_UnknownImpl_._Release
 
function _UnknownImpl_.QueryInterface(const IID: TGUID;
  out Obj): HResult;
begin
 if TObject(Self).GetInterface(IID, Obj) then
  Result := S_Ok
 else
  Result := E_NoInterface;
end;//_UnknownImpl_.QueryInterface
 
{$EndIf UnknownImpl_imp}
---------------------------------
Unknown.imp.pas:


{$IfNDef Unknown_imp}
 
// The library "L3$Basic Concepts"
// Generated from UML model, root element: <<impurity::class>> Shared Delphi Requirements for the low-level libraries::L3$Basic Concepts::Ref Counting::Unknown
//
 
{$Define Unknown_imp}
 _UnknownImpl_Parent_ = _Unknown_Parent_;
 {$Include UnknownImpl.imp.pas}
 _Unknown_ = {mixin} class(_UnknownImpl_, IUnknown)
 end;//_Unknown_
 
{$Else Unknown_imp}
 
{$Include UnknownImpl.imp.pas}
 
 
{$EndIf Unknown_imp}
---------------------------------
myInterfacedObject.pas:


 
unit myInterfacedObject;
 
// The library "SandBox"
Interfaces::TmyInterfacedObject
//
interface
 
type
 _Unknown_Parent_ = TObject;
 {$Include Unknown.imp.pas}
 TmyInterfacedObject = class(_Unknown_)
 end;//TmyInterfacedObject
 
implementation
 
uses
  Windows
  ;
 
{$Include Unknown.imp.pas}
 
end.

The diagram of the tests of this all:

And the code of the test:

unit myInterfacedObjectTest;
 
// The library "SandBoxTest"
// Generated from UML model, root element: <<testcase::class>> Shared Delphi Sand Box::SandBoxTest::Core::TmyInterfacedObjectTest
//
//
 
interface
 
uses
  TestFrameWork
  ;
 
type
 TmyInterfacedObjectTest = class(TTestCase)
 published
 // published methods
   procedure DoIt;
 end;//TmyInterfacedObjectTest
 
implementation
 
uses
  myInterfacedObject,
  SysUtils
  ;
 
// start class TmyInterfacedObjectTest
 
procedure TmyInterfacedObjectTest.DoIt;
var
 l_O : TmyInterfacedObject;
 l_AnotherRef : TmyInterfacedObject;
 l_A : IUnknown;
 l_B : IUnknown;
begin
 l_AnotherRef := nil;
 try
  l_O := TmyInterfacedObject.Create;
  try
   Check(l_O.RefCount = 1);
   l_A := l_O;
   Check(l_O.RefCount = 2);
   l_A := nil;
   Check(l_O.RefCount = 1);
   l_AnotherRef := l_O.Use;
   Check(l_O.RefCount = 2);
   l_B := l_O;
   Check(l_O.RefCount = 3);
  finally
   FreeAndNil(l_O);
  end;//try..finally
  Check(l_AnotherRef.RefCount = 2);
  l_B := nil;
  Check(l_AnotherRef.RefCount = 1);
 finally
  FreeAndNil(l_AnotherRef);
 end;//try..finally
end;//TmyInterfacedObjectTest.DoIt
 
initialization
 TestFramework.RegisterTest(TmyInterfacedObjectTest.Suite);
 
end.

I hope the “symmetry” of reference counting is clear.

Let’s move on.

We’ll add an object that implements the “real” interface.

Let’s draw a pair of diagrams:

-- the classes diagram.

-- the diagram of implementation.

And the code:

myReferenceCountGuard.pas:

unit myReferenceCountGuard;
 
// The library "SandBox"
// Generated from UML model, root element: <<simpleclass::class>> Shared Delphi Sand Box::SandBox::Basic Interfaces::TmyReferenceCountGuard
//
// Class for examples only
//
 
interface
 
uses
  myInterfacedObject
  ;
 
type
 ImyReferenceCountGuard = interface(IUnknown)
  {* Interface for examples only }
   ['{84AAAF31-F3AC-4BBC-A1B7-4E338748921F}']
   function GetRefCount: Integer;
 end;//ImyReferenceCountGuard
 
 TmyReferenceCountGuard = class(TmyInterfacedObject, ImyReferenceCountGuard)
  {* Class for examples only }
 protected
 // realized methods
   function GetRefCount: Integer;
 public
 // public methods
   class function Make: ImyReferenceCountGuard; reintroduce;
     {* Factory TmyReferenceCountGuard.Make }
 end;//TmyReferenceCountGuard
 
implementation
 
// start class TmyReferenceCountGuard
 
class function TmyReferenceCountGuard.Make: ImyReferenceCountGuard;
var
 l_Inst : TmyReferenceCountGuard;
begin
 l_Inst := Create;
 try
  Result := l_Inst;
 finally
  l_Inst.Free;
 end;//try..finally
end;
 
function TmyReferenceCountGuard.GetRefCount: Integer;
begin
 Result := RefCount;
end;//TmyReferenceCountGuard.GetRefCount
 
end.

And the test for this all:

And the code:

myReferenceCountGuardTest.pas:

unit myReferenceCountGuardTest;
 
// The library "SandBoxTest"
// Generated from UML model, root element: <<testcase::class>> Shared Delphi Sand Box::SandBoxTest::Core::TmyReferenceCountGuardTest
//
 
interface
 
uses
  TestFrameWork
  ;
 
type
 TmyReferenceCountGuardTest = class(TTestCase)
 published
 // published methods
   procedure DoIt;
   procedure CheckWithClause;
 end;//TmyReferenceCountGuardTest
 
implementation
 
uses
  SysUtils,
  myReferenceCountGuard
  ;
 
// start class TmyReferenceCountGuardTest
 
procedure TmyReferenceCountGuardTest.DoIt;
var
 l_G : ImyReferenceCountGuard;
 l_Another : ImyReferenceCountGuard;
begin
 l_G := TmyReferenceCountGuard.Make;
 Check(l_G.GetRefCount = 1);
 l_Another := l_G;
 Check(l_G.GetRefCount = 2);
 l_G := nil;
 Check(l_Another.GetRefCount = 1);
 l_Another := nil;
end;//TmyReferenceCountGuardTest.DoIt
 
procedure TmyReferenceCountGuardTest.CheckWithClause;
var
 l_G : ImyReferenceCountGuard;
begin
 // - here I wanted to show that inside the operator with the compiler increments the reference counter on interface/object “in parasite manner”, but I did not succeed in it: it turns out that in trivial cases it does not do it; when I find a non-trivial case I’ll show
 l_G := TmyReferenceCountGuard.Make;
 Check(l_G.GetRefCount = 1);
 with l_G do
 begin
  Check(GetRefCount = 1);
  Check(GetRefCount = 1);
 end;//with l_G
 Check(l_G.GetRefCount = 1);
end;//TmyReferenceCountGuardTest.CheckWithClause
 
initialization
 TestFramework.RegisterTest(TmyReferenceCountGuardTest.Suite);
 
end.

That is all about it...

The next series will be devoted to the implementation of various containers.

P.S. ??? It is obvious that I can write:

---------------------------------
myInterfacedPersistentObject.pas:


unit myInterfacedPersistentObject;
 
// The library "SandBox"
// Generated from UML model, root element: <<simpleclass::class>> Shared Delphi Sand Box::SandBox::Basic Interfaces::TmyInterfacedPersistentObject
//
interface
 
type
 _Unknown_Parent_ = TPersistent;
 {$Include Unknown.imp.pas}
 TmyInterfacedPersistentObject = class(_Unknown_)
 end;//TmyInterfacedPersistentObject
 
implementation
 
uses
  Windows
  ;
 
{$Include Unknown.imp.pas}
 
end.

-- and get  TmyInterfacedPersistentObject inherited from TPersistent ???

There are certain problems with such an inheritance from TComponent or TControl due to RegisterClass. Later – I will describe them. But if RegisterClass is not called for such classes, then EVERYTHING IS OK. This technique can be used. If it is called, it means I’ve “hacked” VCL in some way. Later – I will tell how. I just don’t understand – why uniqueness of the names in RegisterClass should be controlled. I have disabled the control and all works. For already 10 years.

Oh! For TComponent (and its descendants, particularly – Tcontrol) implicit instantiation of mixin” should be applied, because it - ALREADY - has QueryInterface and there’s no need to redefine it (and it is harmful). Later I’ll tell how. In a nutshell – of course, using IfDef.

Actually, “partial admixing” is fun :-) That is when mixin is not fully admixed and just a part of it, that the right IfDef has got.

------------------------------------
This symmetry of reference counting eliminates the problem described here: http://www.gunsmoker.ru/2013/04/plugins-9.html
("Mixing of manual and automatic management of lifetime " and "Double interfaces release").