Реализация Smart Pointers в Delphi, и еще немного

В последних версиях Delphi появилось много новых, интересных возможностей. Сейчас попробуем сделать, с их помощью, что-нибудь полезное. Конкретно, создадим тип, который владеет объектом, ведет себя как этот объект, но при этом автоматически освобождается, когда на него больше нет ссылок.

Для начала приведу пример двух процедур, первая классическая, вторая использует новые типы. Далее рассмотрим как это реализовано.

procedure ClassicVersion;
var
  Reader, Writer: TFileStream;
begin
  Reader := TFileStream.Create('C:\hiberfil.sys', fmOpenRead);
  try
    Writer := TFileStream.Create('D:\dummy.sys', fmCreate);
    try
      // Делаем что-то полезное
    finally
      Writer.Free;
    end;
  finally
    Reader.Free;
  end;
end;

procedure ARCVersion;
var
  Reader, Writer: AutoRef<TFileStream>;
begin
  Reader := Ref<TFileStream>(TFileStream.Create('C:\hiberfil.sys', fmOpenRead));
  Writer := Ref<TFileStream>(TFileStream.Create('D:\dummy.sys', fmCreate));
  // Делаем что-то полезное
end;

В процедуре ClassicVersion, используется обычный подход, с портянкой из try .. finally для гарантированного освобождения ресурсов. Вторая содержит всего две строки, создания объектов, все остальное (освобождение объектов) происходит автоматически. Разница очевидна, две строки кода, вместо девяти. Код короче и нагляднее. Я думаю для многих Delphi разработчиков это выглядит как немного магии. Давайте рассмотрим, как это работает.

type
  AutoRef<T: class> = reference to function: T;

Выглядит как объявление ссылки на функцию - так и есть. Самое интересное - реализация в Delphi, оказывается это не только ссылка, но и интерфейс! Для меня, например, это была новость. Если это интерфейс, значит: он реализует Automatic Reference Counting (ARC) и мы можем создать класс, который его реализует:

TAutoRef = class(TInterfacedObject, AutoRef<T>)
protected
  function Invoke: T;
end;

Обратите внимание, в интерфейсе должен присутствовать метод Invoke повторяющий сигнатуру нашей функции. Попробуйте - это работает! По сути осталось немного, добавить владение объектом:

TAutoRef = class(TInterfacedObject, AutoRef<T>)
private
  FValue: T;
protected
  function  Invoke: T;
public
  constructor Create(const Value: T);
  destructor Destroy; override;
end;

И так, у нас есть класс, который ведет себя как функция, т.е. возвращает наш объект, и мы можем обращаться к его членам. И который, при этом, реализует интерфейс AutoRef<T>, т.е. реализует ARC, и соответственно в деструкторе освобождение объекта <T>.

Осталось добавить немного синтаксического сахара, с явным и не явным созданием нашего интерфейса:

Ref<T: class> = record
private type
  TAutoRef = class(TInterfacedObject, AutoRef<T>)
  private
    FValue: T;
  protected
    function  Invoke: T;
  public
    constructor Create(const Value: T);
    destructor Destroy; override;
  end;
private
  FValue: T;
public
  class function Create(const Value: T): AutoRef<T>; static; inline;
  class operator Implicit(const Value: Ref<T>): AutoRef<T>; static; inline;
  class operator Explicit(const Value: T): Ref<T>; static; inline;
end;

Реализация, этих типов, тривиальна, но в конце статьи я приведу полный текст Unit'а с реализацией. Интересно наличие двух перегруженных операторов явного и неявного приведения типов, они позволяют код, к в первом примере: MyRef := Ref<TObject>(MyObj); а не вызывать функцию Create.

Если мы хотим освободить объект (ну или по крайней мере уменьшить счетчик ссылок), все просто, мы нашему объекту присваиваем nil. Когда в программе не останется ссылок на объект, он будет автоматически освобожден.

Маленький бонус, создадим тип DeferredRef, который возвращает тот же интерфейс, но создает его только при первом обращении к нему, для этого, ему в качестве параметра передается тот-же AutoRef<T>, который вызывается при создании объекта.

DeferredRef<T: class> = record
private type
  TDeferredRef = class(TInterfacedObject, AutoRef<T>)
  private
    FCreator: AutoRef<T>;
    FValue: T;
  protected
    function  Invoke: T;
  public
    constructor Create(const Creator: AutoRef<T>);
    destructor Destroy; override;
  end;
private
  FCreator: AutoRef<T>;
public
  class function Create(const Creator: AutoRef<T>): AutoRef<T>; static; inline;
  class operator Implicit(const Value: DefferedRef<T>): AutoRef<T>; static; inline;
  class operator Explicit(const Value: AutoRef<T>): DefferedRef<T>; static; inline;
end;

Честно говоря, в реальной жизни, подобное, отложенное создание не часто нужно, ну по крайней мере мне. Но подобные задачи встречались при при разработке многопоточных систем, поэтому создание объекта реализовано Thread Safe.

Как обещал, полный исходный текст:

unit Primitives;

interface

uses
  System.Types, System.SysUtils;

type
  ///<summary>
  ///  Because of Delphi realisation of anonymous methods,
  ///  this type can be treated not only as Delegate,
  ///  but also as interface with Invoke method that returns generics type <T>
  ///</summary>
  AutoRef<T: class> = reference to function: T;

  Shared = class
  private
    class var FLock: TObject;
  protected
    class constructor Create;
    class destructor Destroy;
  public
    class procedure Initialize<T: class>(var Value: T; const Initializer: AutoRef<T>); static; inline;
  end;

  ///<summary>
  ///  This type realizes creating ARC owner of object instance type that freed
  ///  owned object when out of scope (reference count = 0)
  ///</summary>
  Ref<T: class> = record
  private type
    TAutoRef = class(TInterfacedObject, AutoRef<T>)
    private
      FValue: T;
    protected
      function  Invoke: T;
    public
      constructor Create(const Value: T);
      destructor Destroy; override;
    end;
  private
    FValue: T;
  public
    class function Create(const Value: T): AutoRef<T>; static; inline;
    class operator Implicit(const Value: Ref<T>): AutoRef<T>; static; inline;
    class operator Explicit(const Value: T): Ref<T>; static; inline;
  end;

  ///<summary>
  ///  This type same as Ref<T>, but with deferred creation of owned object.
  ///  Also, this type is thread safe.
  ///</summary>
  DeferredRef<T: class> = record
  private type
    TDeferredRef = class(TInterfacedObject, AutoRef<T>)
    private
      FCreator: AutoRef<T>;
      FValue: T;
    protected
      function  Invoke: T;
    public
      constructor Create(const Creator: AutoRef<T>);
      destructor Destroy; override;
    end;
  private
    FCreator: AutoRef<T>;
  public
    class function Create(const Creator: AutoRef<T>): AutoRef<T>; static; inline;
    class operator Implicit(const Value: DeferredRef<T>): AutoRef<T>; static; inline;
    class operator Explicit(const Value: AutoRef<T>): DeferredRef<T>; static; inline;
  end;

implementation

{ Shared }

class constructor Shared.Create;
begin
  FLock := TObject.Create;
end;

class destructor Shared.Destroy;
begin
  FreeAndNil(FLock);
end;

class procedure Shared.Initialize<T>(var Value: T; const Initializer: AutoRef<T>);
begin
  if not Assigned(Value) then
  begin
    System.TMonitor.Enter(FLock);
    try
      if not Assigned(Value) then
        Value := Initializer();
    finally
      System.TMonitor.Exit(FLock);
    end;
  end;
end;

{ Ref<T>.TAutoRef }

constructor Ref<T>.TAutoRef.Create(const Value: T);
begin
  FValue := Value;
end;

destructor Ref<T>.TAutoRef.Destroy;
begin
  FreeAndNil(FValue);
end;

function Ref<T>.TAutoRef.Invoke: T;
begin
  Result := FValue;
end;

{ Ref<T> }

class function Ref<T>.Create(const Value: T): AutoRef<T>;
begin
  Result := TAutoRef.Create(Value);
end;

class operator Ref<T>.Implicit(const Value: Ref<T>): AutoRef<T>;
begin
  Result := TAutoRef.Create(Value.FValue);
end;

class operator Ref<T>.Explicit(const Value: T): Ref<T>;
begin
  Result.FValue := Value;
end;

{ DeferredRef<T> }

class function DeferredRef<T>.Create(const Creator: AutoRef<T>): AutoRef<T>;
begin
  Result := TDeferredRef.Create(Creator);
end;

class operator DeferredRef<T>.Explicit(const Value: AutoRef<T>): DeferredRef<T>;
begin
  Result.FCreator := Value;
end;

class operator DeferredRef<T>.Implicit(const Value: DeferredRef<T>): AutoRef<T>;
begin
  Result := TDeferredRef.Create(Value.FCreator);
end;

{ DeferredRef<T>.TDeferredRef }

constructor DeferredRef<T>.TDeferredRef.Create(const Creator: AutoRef<T>);
begin
  FCreator := Creator;
  FValue := nil;
end;

destructor DeferredRef<T>.TDeferredRef.Destroy;
begin
  FreeAndNil(FValue);
end;

function DeferredRef<T>.TDeferredRef.Invoke: T;
begin
  Shared.Initialize<T>(FValue, FCreator);
  Result := FValue;
end;

Надеюсь, кому то это окажется полезно.

@ap1973
03.11.2021 19:32 UTC
Первоисточник

Комментарии

@kapas19
03.11.2021 14:51 UTC
0

Зачем так усложнять smart pointers?

@ap1973
05.11.2021 07:49 UTC
0

Можно расшифровать, в чем усложнение?

07.11.2021 10:53 UTC
0

Можете привести сценарий использования DeferredRef<T: class>?

08.11.2021 13:55 UTC
0

Вот только сегодня столкнулся с интереснейшей ситуацией с дочерними процессами созданными через CreateProcess. Ситуация следующая, есть Win32 приложение, которое регулярно порождает дочерние, коротко живущие, процессы, все это дело завернуто в Job. И все это генерирует вполне заметную утечку памяти. Исследование показало, что при создании первого дочернего процесса создается еще и print driver host, в принципе это нормально, но оно начинает жрать память, которая не освобождается при завершение дочерних процессов. Т.е. каждый запуск дочернего процесса вызывает отжор памяти всего джоба, которая не возвращается. Краткое исследованные показало, что такое поведение проявляется только при обращении к функциям модуля Vcl.Printers. Я пока не разобрался, почему это вызывает утечку, баг это в нашей системе, или в системном модуле (он какой-то слегка странный), это еще предстоит выяснить, что не так с Printers и почему, даже при завершении процесса, spooler продолжает жрать память. Но, в реальной жизни, эти дочерние процессы, функции печати используют крайне редко. Завернув получение текущего принтера в Deferred я практически избавился от проблемы, конечно, в данной ситуации, это не 100% процентов корректное решение (с этим еще предстоит разбираться), но тем не менее...

08.11.2021 14:28 UTC
0

Понятно что вы решали какую-то свою конкретную проблему. Но меня заинтересовал вопрос: как это использовать? Можно какой-нибудь привести демо-пример?

08.11.2021 14:37 UTC
0

var Printer := DeferredRef(function: TPrinter begin Result := Vcl.Printers.Printer; end);

08.11.2021 14:45 UTC
0

Хм... Спасибо

08.11.2021 14:46 UTC
0

Парсер сожрал угловые скобки, но думаю смысл понятен. Буду учиться пользоваться местным редактором.

08.11.2021 18:27 UTC
0

Местный редактор доступен только для элиты)

08.11.2021 15:09 UTC
0

Теперь, вроде бы, встало на свои места.

@kapas19
03.11.2021 15:03 UTC
0
class procedure Shared.Initialize<T>(var Value: T; const Initializer: AutoRef<T>);
begin
  if not Assigned(Value) then // вы уверены что это сработает?
  begin
..........................
..........................
..........................
  end;
end;
@alan008
03.11.2021 22:17 UTC
0

Если дженерик будет специфицирован в коде ссылочным типом T, то конечно сработает.

@galatyn
05.11.2021 07:33 UTC
0

В общем случае нет, например для локальной переменной никто не гарантирует инициализацию в nil.
Но в данном коде все будет работать, так вызывается только для поля обьекта, а поля обьектов в Delphi гарантированно инициализируюся в nil при создании.
Но это некрасиво, этой проверке здесь в самом деле не место.

05.11.2021 07:34 UTC
0

Согласен, проверка лишняя

05.11.2021 15:23 UTC
0

вызывается только для поля объекта, а поля объектов в Delphi гарантированно инициализируются в nil при создании.

Особенность (на которую наверно ссылочку GunSmoker и давал) как раз и заключается в том, что инициализация для объектного поля записи в nil не гарантирована и эта особенность сохраняться начиная 2009 версии (с чем и столкнулся при своей реализации smartpounter-ов). Про самые последние версии сказать ничего не могу (но там уже есть М-записи, которые позволяют во многих случаях отказаться от smartpoiter-ов). Как  правило в объектном поле записи (record-а) сидит "мусор" -  Assigned(FValue) практически гарантировано может вернуть  true (может быть кто-нибудь сможет найти способ? Люди искали такой способ – на нашли). Об этом на протяжении по-меньшей мере лет 12 написано уже достаточно много (см. например блог  H. Vassbotn). Чтобы не наткнуться на этот «подводный камень» в DeferredRef<T: class>  необходимо проверять поле интерфейса  (его почему-то компилятор не забывает инициализировать nil-ом) – FCreator.

Похожее на описанное в данной статье решение, например, есть в статье Александра Багеля и многих др. Подобные «вещички» есть например в DeHL, DSharp и  Spring4D.

05.11.2021 17:39 UTC
0

@GunSmoker давал ссылку на другую проблему, точнее особенность, которую есть смысл помнить. Выход за пределы блока, например begin/end, не гарантирует освобождение ссылки на интерфейс созданный внутри этого блока. В примере там внутри блока вызывается функция, которая возвращает интерфейс. И там автор надеялся, что после выхода из блока begin/end интерфейс точно освобожден. По факту никто этого не гарантирует и поведение может варьироваться в зависимости от компилятора или например настроек оптимизации. Гарантированно ссылка освободится только после выхода из процедуры/функции. Хотя даже эта гарантия так себе, если например функция инлайнится компилятором, то не исключено что освободится после выхода из внешней функции...

То что вы пишете о записях не противоречит тому что я написал ранее вроде бы.
В коде автора Initialize вызывается только в одном месте, только для поля FValue обьекта класса DeferredRef<T>.TDeferredRef и никогда для поля записи.

То есть вопрос сводится к тому, всегда ли экземляр класса TDeferredRef сконструирован при обращении к нему. Я такого сценария, когда он не сконструирован, не вижу. Хотя здесь легко что то упустить, приведенный код не отличается ясностью. А Вы видите такой сценарий?

07.11.2021 10:02 UTC
0

...для поля FValue объекта класса DeferredRef<T>.TDeferredRef и никогда для поля записи...

Да это так.

А Вы видите такой сценарий?

Также как и вы - никакого. Я поначалу вообще рассматривал этот код как "классический" SP в том числе с точки зрения вариантов его использования. Сработал стереотип мышления.

Если говорить о DeferredRef<T>, то к моему глубокому сожалению я вообще не вижу какого-либо варианта его использования. Необходимости в чем-то подобном в моей практике не возникало. Может быть ap1973 приведет какой-либо пример?

06.11.2021 20:20 UTC
0

В версии 10.4+ добавили возможность добавлять конструкторы и деструкторы для записей (record)

07.11.2021 04:53 UTC
0

добавлять конструкторы и деструкторы для записей

Только ради полноты картины (прошу HemulGM не обижаться):

  1. конструкторы и деструкторы записей были введены в Delphi достаточно давно.

  2. У управляемых (менеджируемые, M-record-ы) записи, окончательно введенные в версии 10.4 и о которых я упомянул в своем комментарии, появилась возможность определять операторы инициализации (class operator Intialaze), финализации (class operator Finalize) и присваивания (class operator Assign). Собственно о них вы говорите. Так что функционал "классического" SmPt можно реализовать без использования техники SmPt нужным образом определяя Finalize и Assign. Конечно же у M-записей есть свои "рифы"...

07.11.2021 08:19 UTC
0

Про деструкторы записей я погорячился...

08.11.2021 14:18 UTC
0

Правда погорячились, и про конструкторы тоже. Они хоть и есть, но по факту это не конструкторы, т.к. записи в принципе не динамические объекты (не в куче они лежат).

Про SP на records, их у меня тоже есть, но как вы верно заметили, это только с версии 10.4.2 (по моему) есть Initialize, Finalize и Assign. Кроме того, по факту, там надо делать тот-же ARC, только руками.

08.11.2021 14:38 UTC
0

Правда погорячились, и про конструкторы тоже...

Конструктор в том числе отвечает за инициализацию полей записей. Можно конечно использовать для этого class function. Не зря такие конструкторы обязаны иметь параметры. Но все же синтаксическая конструкция имеется... А class operator Initialize именно для этого и предназначен. Ничего другого от них и не требуется. В вашем понимании он также не будет полноценным конструктором.

08.11.2021 14:44 UTC
0

Я с вами согласен, просто уточнил, что для записей constructor, это не тот конструктор, как обычно он понимается. А философские рассуждения является Initialize конструктором или нет - оставим философам, на мой взгляд смысл одинаков, ну может почти одинаков.

@GunSmoker
04.11.2021 07:33 UTC
+1

Тут хорошо бы помнить про такую особенность: https://quality.embarcadero.com/browse/RSP-30050

@ap1973
05.11.2021 07:47 UTC
0

Можно тут продублировать? Что-то меня в QC не пускает (давно не заходил).

10.11.2021 04:42 UTC
0

Можно здесь посмотреть: Delphi 10.4 / Delphi 11 Alexandria Breaking Changes.


Но в данном случае все нормально — ссылки на интерфейс явно хранятся в локальных переменных.

@SanchoB
05.11.2021 07:34 UTC
0

Для этой нужды я прeдлагал Embarcadero's Quality Portal вот такой синтакс.

using var Reader := TFileStream.Create('C:\hiberfil.sys', fmOpenRead) do

begin

  // Делаем что-то полезное

end; 
@ap1973
05.11.2021 07:36 UTC
0

Это из мира C#. Удобно конечно, но синтаксис сомнительный, на мой взгляд.

@Groramar
06.11.2021 21:21 UTC
0

А зачем так сложно, если можно так

with TFileStream.Create('C:\hiberfil.sys', fmOpenRead) do

begin

// Делаем что-то полезное

end;

07.11.2021 12:53 UTC
+1

В этом случае экземпляр класса TFileStream никогда не будет освобожден.
PS Не по теме статьи, но IMHO `With` вообще весьма сомнительная штука и его присутствие в современном языке сложно чем то оправдать. Внутри такого блока никогда нельзя быть уверенным, что именно используется, что то из текущей области видимости или что то из обьекта/записи для которой использован With.
И даже если в момент написания кода все корректно, достаточно добавить в класс новый член, и код использования этого класса/записи через with может перестать работать.

08.11.2021 14:21 UTC
0

Полностью поддерживаю, видел комментарий выше, но только добрался до хабра. Я бы with уничтожил. Конечно поздно уже, но можно через директивы их угнать в obsolete.

09.11.2021 09:10 UTC
0

конструкция using это синтаксический сахар для конструкции

var O := TFileStream.Create('C:\hiberfil.sys', fmOpenRead);
try
  // Делаем что-то полезное
finally
	O.Free;
end;
14.11.2021 19:23 UTC
0

Тогда уж

With TFileStream.Create('C:\hiberfil.sys', fmOpenRead) do
try
  // Делаем что-то полезное
finally
	Free;
end;
@third112
05.11.2021 21:51 UTC
0
Осталось добавить немного синтаксического сахара, с явным и не явным созданием нашего интерфейса

Я не против сахара и использую Delphi-7, но когда сахара много — бывает приторно.