Реализация подсчёта ссылок

Уже лет 15-ть думал на тему того - почему Борланд не сделал подсчёт ссылок на уровне базовых классов. А лишь сделал класс-недоразумение - TInterfacedObject.

Я вот - сделал. Давно. И счастливо - пользуюсь.

При этом надо ЧЁТКО разделять для себя - "подсчёт ссылок" и IUnknown. Первое это - КОНЦЕПЦИЯ, второе - ЛИШЬ ОДНА из РЕАЛИЗАЦИЙ этой концепции.

У меня подсчёт ссылок устроен так, что нельзя написать:

List.Add(TItem.Create);

можно лишь написать:

Item := TItem.Create;
// колическтво ссылок рано 1
try
 List.Add(Item);
// количество ссылок равно 2
finally
 FreeAndNil(Item);
// количество ссылок равно 1
end;

- многим это не нравится. Мне же - наоборот. Я люблю симметрию. Кто владеет объектом, тот его и освобождает.

Есть правда и "ходунки" для любителей "краткой записи" и борцов за количество строк. Они подсмотрены у Objective-C:

List.Add(TItem.Create.Autorelease);

Дальше хочется рассказать, о реализации.

Для начала надо понять одну простую вещь. Что при создании/объектов присутствует compiler-magic.

Из кода:

A := TMyClass.Create;

компилируется что-то вроде:

A := TMyClass.NewInstance;
A.Create;

а из кода:

A.Destroy;

компилируется:

A.Destroy;
A.DestroyInstance

Т.е. код конструктора - это всего лишь код инициализации, а код деструктора - код деинициализации.

А память под объект распределяется в NewInstance, а освобождается в DestroyInstance. Это можно почерпнуть из документации, да только кто ж её читает :-)

Диаграммы:

Код:

RefCountedPrim.imp.pas:

{$IfNDef RefCountedPrim_imp}
 
{$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}
 
{$Define RefCounted_imp}
 _RefCountedPrim_Parent_ = _RefCounted_Parent_;
 {$Include RefCountedPrim.imp.pas}
 _RefCounted_ = {mixin} class(_RefCountedPrim_)
 protected
 // protected methods
   destructor Destroy;
     {* Это чтобы не было соблазна перекрывать destroy. }
 end;//_RefCounted_
 
{$Else RefCounted_imp}
 
type _RefCountedPrim_R_ = _RefCounted_;
 
{$Include RefCountedPrim.imp.pas}
 
// start class _RefCounted_
 
destructor _RefCounted_.Destroy;
begin
 assert(false, 'По идее мы попасть сюда не должны');
 inherited;
end;//_RefCounted_.Destroy
 
{$EndIf RefCounted_imp}

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

Refcounted.pas:

unit Refcounted;
 
interface
 
type
 _RefCounted_Parent_ = TObject;
 {$Include RefCounted.imp.pas}
 TRefcounted = class(_RefCounted_)
 end;//TRefcounted
 
implementation
 
uses
  Windows
  ;
 
{$Include RefCounted.imp.pas}
 
end.

Ну и тест:

RefcountedTest.pas:

unit RefcountedTest;
 
interface
 
uses
  BaseTest
  ;
 
type
 TRefcountedTest = class(TBaseTest)
 published
 // published methods
   procedure DoIt;
 end;//TRefcountedTest
 
implementation
 
uses
  Refcounted,
  SysUtils,
  TestFrameWork
  ;
 
// start class TRefcountedTest
 
procedure TRefcountedTest.DoIt;
var
 l_A : TRefcounted;
 l_B : TRefcounted;
begin
 l_A := TRefcounted.Create;
 try
  Check(l_A.RefCount = 1);
  l_B := l_A.Use;
  try
   Check(l_A.RefCount = 2);
   Check(l_B.RefCount = 2);
  finally
   FreeAndNil(l_B);
  end;//try..finally
  Check(l_A.RefCount = 1);
 finally
  FreeAndNil(l_A);
 end;//try..finally
end;//TRefcountedTest.DoIt
 
initialization
 TestFramework.RegisterTest(TRefcountedTest.Suite);
 
end.

... to be continued ...