Собственная реализация IUnknown и подсчёт ссылок. И примеси

У Борланда (теперь Embarcadero) конечно есть реализация IUnknown. TInterfacedObject называется.

Она неплоха.

Но она меня лично не устраивает своей несимметричностью. Если уж создал интерфейс, то и работай через интерфейс, а про объект - "будь любезен забудь". И в контейнеры клади как интерфейс. И дальше передавай как интерфейс. А интерфейс по сравнению с объектом - это лишние накладные расходы. На ту же лишнюю косвенность вызова методов (ну примерно как virtual) и на лишние AddRef/Release при присвоении локальным переменным. Тем более, что есть ещё тот факт, что у объекта бывают одни публичные методы, а у интерфейса - другие. И это - правильно. Публичность методов может зависеть от полномочий пользователя объектом (но это кстати тоже тема для отдельного поста, gunsmoker кстати этой темы немного касался - вот тут - http://www.gunsmoker.ru/2013/02/delphi-friendliness.html , ну если я конечно правильно его понял, а не интерпретировал его мысли так как мне хочется).

Меня это не устраивает в моих повседневных задачах. Тем более, что если уж рассматривать "в исторической перспективе" - моя реализация подсчёта ссылок появилась ещё в Delphi 1. ДО вообще введения понятия интерфейсов. Я и интерфейсы то - "эмулировал" путём хака VMT и использования message (gunsmoker по-моему про подобную технику - тоже пишет).

История появления моего собственного подсчёта ссылок - заслуживает отдельного поста. Пока кратко - редактор и Undo/Redo. Где у объектов нет ЦЕНТРАЛИЗОВАННОГО "папы" (Owner/Parent). Все объекты - равнозначно могут держать ссылку на другие объекты. И им ГАРАНТИРУЕТСЯ тот факт, что пока они корректным образом держат ссылку - объекты на которые они ссылаются - "живые".

Тут можно развести целый холивар конечно на тему "делай как тебе говорят" и "умные люди не зря придумали". Но я бы хотел коснуться этого в отдельном посте, а здесь - просто рассказать о своей реализации и заодно ещё раз продемонстрировать "микро"-UML и технику использования "примесей".

Предыдущие серии были тут:
http://18delphi.blogspot.com/2013/03/blog-post_4606.html
http://18delphi.blogspot.com/2013/03/generic-generic.html

Теперь давайте на основе этих знаний сконструируем объект, реализующий IUnknown.

Нарисуем пару диаграмм:

- это собственно "примесная" реализация IUnknown.

А вот - конкретная реализация (унаследованная от TObject):

Код всего этого хозяйства такой:

RefCountedPrim.imp.pas:

{$IfNDef RefCountedPrim_imp}
 
//
// Библиотека "L3$Basic Concepts"
// Generated from UML model, root element: <<Impurity::Class>> Shared Delphi Требования к низкоуровневым библиотекам::L3$Basic Concepts::Ref Counting::RefCountedPrim
//
 
{$Define RefCountedPrim_imp}
 _RefCountedPrim_ = {mixin} class(_RefCountedPrim_Parent_)
 private
 // private fields
   f_RefCount : Integer;
    {* Поле для свойства 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;
     {* Функция очистки полей объекта. }
 public
 // public methods
   function Use: Pointer;
     {* увеличить счетчик ссылок на 1 и вернуть указатель на себя. }
   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}
 
// Библиотека "L3$Basic Concepts"
// Generated from UML model, root element: <<Impurity::Class>> Shared Delphi Требования к низкоуровневым библиотекам::L3$Basic Concepts::Ref Counting::RefCounted
//
// В этом классе собираем методы, которые запрещено перекрывать и вызывать напрямую
//
 
{$Define RefCounted_imp}
 _RefCountedPrim_Parent_ = _RefCounted_Parent_;
 {$Include RefCountedPrim.imp.pas}
 _RefCounted_ = {mixin} class(_RefCountedPrim_)
  {* В этом классе собираем методы, которые запрещено перекрывать и вызывать напрямую }
 public
 // public methods
   destructor Destroy;
     {* Это чтобы не было соблазна перекрывать 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, 'По идее мы попасть сюда не должны');
 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}
 
// Библиотека "L3$Basic Concepts"
// Generated from UML model, root element: <<Impurity::Class>> Shared Delphi Требования к низкоуровневым библиотекам::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;
     {* Увеличивает счетчик ссылок. }
   function _Release: Integer; stdcall;
     {* Уменьшает счетчик ссылок. }
   function QueryInterface(const IID: TGUID;
    out Obj): HResult; stdcall;
     {* Приводит базовый интерфейс к запрашиваемому, если это возможно. }
 end;//_UnknownImpl_
 
{$Else UnknownImpl_imp}
 
{$Include RefCounted.imp.pas}
 
// start class _UnknownImpl_
 
function _UnknownImpl_._AddRef: Integer;
begin
 Use;
 Result := RefCount;
 // - тут есть проблемы с многопоточностью
end;//_UnknownImpl_._AddRef
 
function _UnknownImpl_._Release: Integer;
var
 l_RC : Integer;
begin
 l_RC := RefCount - 1;
 Free;
 Result := l_RC;
 // - тут есть проблемы с многопоточностью
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}
 
// Библиотека "L3$Basic Concepts"
// Generated from UML model, root element: <<Impurity::Class>> Shared Delphi Требования к низкоуровневым библиотекам::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;
 
// Библиотека "SandBox"
// Generated from UML model, root element: <<SimpleClass::Class>> Shared Delphi Sand Box::SandBox::Basic Interfaces::TmyInterfacedObject
//
interface
 
type
 _Unknown_Parent_ = TObject;
 {$Include Unknown.imp.pas}
 TmyInterfacedObject = class(_Unknown_)
 end;//TmyInterfacedObject
 
implementation
 
uses
  Windows
  ;
 
{$Include Unknown.imp.pas}
 
end.

Теперь диаграмма теста этого хозяйства:

И код теста:

unit myInterfacedObjectTest;
 
// Библиотека "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.

-- надеюсь, что "симметрия" подсчёта ссылок - понятна.

Движемся дальше.

Реализуем теперь объект, реализующий "реальный" интерфейс.

Нарисуем пару диаграмм:

-- диаграмма классов

-- диаграмма реализации.

И код:

myReferenceCountGuard.pas:

unit myReferenceCountGuard;
 
// Библиотека "SandBox"
// Generated from UML model, root element: <<SimpleClass::Class>> Shared Delphi Sand Box::SandBox::Basic Interfaces::TmyReferenceCountGuard
//
// Класс исключительно для примеров
//
 
interface
 
uses
  myInterfacedObject
  ;
 
type
 ImyReferenceCountGuard = interface(IUnknown)
  {* Интерфейс исключительно для примеров }
   ['{84AAAF31-F3AC-4BBC-A1B7-4E338748921F}']
   function GetRefCount: Integer;
 end;//ImyReferenceCountGuard
 
 TmyReferenceCountGuard = class(TmyInterfacedObject, ImyReferenceCountGuard)
  {* Класс исключительно для примеров }
 protected
 // realized methods
   function GetRefCount: Integer;
 public
 // public methods
   class function Make: ImyReferenceCountGuard; reintroduce;
     {* Фабрика 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.

И тест к этому хозяйству:

И код:

myReferenceCountGuardTest.pas:

unit myReferenceCountGuardTest;
 
// Библиотека "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
 // - тут я хотел показать, что внутри оператора with компилятор "паразитно" взводит счётчик ссылок на интерфейсе/объекте, но у меня этого не получилось, оказывается, что в тривиальных случаях он этого не делает, найду нетривиальный случай - покажу
 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.

-- "вот собственно и всё, что я знаю о креветках"...

Следующей серией будет рассказ о реализации различных контейнеров.

P.S. ??? Понятно, что можно написать:

---------------------------------

myInterfacedPersistentObject.pas:

unit myInterfacedPersistentObject;
 
// Библиотека "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.

-- и получить TmyInterfacedPersistentObject наследующийся от TPersistent ???

С подобным наследованием от TComponent или TControl есть определённые проблемы связанные с RegisterClass. Я их позже - опишу. Но если RegisterClass для подобных классов не вызывается, то ВСЁ ХОРОШО. Можно использовать эту технику. А если вызывается, то я у себя - немного "подхачил" VCL. Позже - расскажу как. Я только одного не понимаю - зачем контроллировать в RegisterClass уникальность имён ClassParent. Я эту проверку отключил и всё работает. Лет десять как уже.

Да! Для TComponent (и его наследников, в частности - TControl) надо применять "условное инстанцирование примеси". Ибо там QueryInterface - УЖЕ - есть и его незачем (да и вредно) определять заново. Позже расскажу как. В двух словах - через IfDef конечно же.

Вообще "частичное примешивание" - это - весёлая тема :-) Когда примешивается не вся примесь, а лишь её часть. Попавшая под нужный IfDef.
------------------------------------
Описанная симметрия подсчёта ссылок позволяет избежать проблемы описанной тут - http://www.gunsmoker.ru/2013/04/plugins-9.html ("Смешивание ручного и автоматического управления временем жизни" и "Двойное освобождение интерфейсов").