Смарт-указатели плохо работают с общим c TObjectlist в Delphi

Question

Я тестирую интеллектуальные указатели в Delphi 10.3 Rio с помощью Spring4D. Вот моя тестовая программа. Я создал общий c TObjectList и хочу добавить в этот список простые TObject s, используя Shared.Make(TTestObj.Create). Проблема в том, что всякий раз, когда я добавляю объект в список, предыдущий объект освобождается. Смотрите результат моей программы. Кто-нибудь знает, как решить эту проблему?

program TestSmartPointer;

{$APPTYPE CONSOLE}

uses
  Spring,
  Diagnostics,
  Classes,
  SysUtils,
  System.Generics.Collections;

type
  TTestObj = class
  private
    FDescription: string;
  public
    property Description: string read FDescription write FDescription;
    destructor Destroy; override;
  end;
  TTestList = class(TObjectList<TTestObj>)
    destructor Destroy; override;
  end;

var
  LISTITEMCOUNT: integer;
  LISTCOUNT: integer;

procedure Test_SmartPointer;
begin
  Writeln('SmartPointer test started');
  var lTestList := Shared.Make(TTestList.Create)();
  lTestList.OwnsObjects := false;
  for var i := 1 to 10 do
  begin
    var lTestObj := Shared.Make(TTestObj.Create)();
//    var lTestObj := TTestObj.Create;
    lTestObj.Description := i.ToString;
    Writeln('TestObj added to Testlist with description ' + lTestObj.Description);
    lTestList.Add(lTestObj);
  end;
  Writeln('SmartPointer test finished');
end;

{ TTestObj }

destructor TTestObj.Destroy;
begin
  Writeln(format('TTestObj with description %s is destroyed', [FDescription]));
  inherited;
end;

{ TTestList }

destructor TTestList.Destroy;
begin
  Writeln('TTestList is destroyed');
  inherited;
end;

begin
  Test_SmartPointer;
  Readln;
end.

Answer 1

Проблема в том, что ваш TObjectList содержит необработанные TTestObj указатели на объекты, а не IShared<TTestObj> интерфейсы, которые возвращает Shared.Make<T>().

В var lTestList := Shared.Make(TTestList.Create)(); вы создаете IShared<TTestList> ( a reference to function: TTestList), который является оболочкой для объекта TTestList, который вы создаете. Вы вызываете () в IShared, который вызывает функцию для возврата необработанного TTestList указателя на объект. В этом примере это нормально, потому что IShared будет храниться в скрытой переменной в течение всего времени жизни Test_SmartPointer(), поэтому его refcount равен 1, сохраняя TTestList живым.

In var lTestObj := Shared.Make(TTestObj.Create)(); вы делаете то же самое, на этот раз для IShared<TTestObj>, возвращающего TTestObj указатель на объект. Однако, когда lTestObj выходит за пределы области видимости в конце каждой l oop итерации, счетчик ссылок IShared уменьшается. Поскольку больше нет ссылок на этот интерфейс, его refcount падает до 0, уничтожая объект за IShared, который, в свою очередь, уничтожает связанный с ним объект TTestObj, оставляя TObjectList с висящим указателем TTestObj (но вы не столкнетесь с какими-либо сбоями, так как вы никоим образом не обращаетесь к сохраненным объектам TTestObj, даже в деструкторе TObjectList из-за OwnsObjects=false).

Вам нужно изменить TTestList для хранения IShared<TTestObj> элементов вместо TTestObj элементов (в этом случае вы должны использовать TList<T> вместо TObjectList<T>) и избавиться от вызовов () на интерфейсах IShared при вызове Shared.Make():

program TestSmartPointer;

{$APPTYPE CONSOLE}

uses
  Spring,
  Diagnostics,
  Classes,
  SysUtils,
  System.Generics.Collections;

type
  TTestObj = class
  private
    FDescription: string;
  public
    property Description: string read FDescription write FDescription;
    destructor Destroy; override;
  end;

  TTestList = class(TObjectList<IShared<TTestObj>>)
    destructor Destroy; override;
  end;

var
  LISTITEMCOUNT: integer;
  LISTCOUNT: integer;

procedure Test_SmartPointer;
begin
  Writeln('SmartPointer test started');
  var lTestList := Shared.Make(TTestList.Create);
  for var i := 1 to 10 do
  begin
    var lTestObj := Shared.Make(TTestObj.Create);
    lTestObj.Description := i.ToString;
    Writeln('TestObj added to Testlist with description ' + lTestObj.Description);
    lTestList.Add(lTestObj);
  end;
  Writeln('SmartPointer test finished');
end;

{ TTestObj }

destructor TTestObj.Destroy;
begin
  Writeln(Format('TTestObj with description %s is destroyed', [FDescription]));
  inherited;
end;

{ TTestList }

destructor TTestList.Destroy;
begin
  Writeln('TTestList is destroyed');
  inherited;
end;

begin
  Test_SmartPointer;
  Readln;
end.

Answer 2

Вот код, который работает (спасибо Реми Лебо). Поскольку Delphi не имеет сборщика мусора, а AR C удален, я искал общую структуру для автоматического освобождения объектов. Мое впечатление от smartpointers состоит в том, что это слишком сложно для использования в качестве простой в использовании общей структуры для автоматического освобождения объектов.

program TestSmartPointer;

{$APPTYPE CONSOLE}

uses
  Spring,
  Diagnostics,
  Classes,
  SysUtils,
  System.Generics.Collections;

type
  TTestObj = class
  private
    FDescription: string;
  public
    property Description: string read FDescription write FDescription;
    destructor Destroy; override;
  end;
  TTestList = class(TList<IShared<TTestObj>>)
  public
    destructor Destroy; override;
  end;

procedure Test_SmartPointer;
var
  lTestList: IShared<TTestList>;
  lTestObj: IShared<TTestObj>;
  i: integer;
begin
  Writeln('SmartPointer test started');
  lTestList := Shared.Make(TTestList.Create);
  for i := 1 to 10 do
  begin
    lTestObj := Shared.Make(TTestObj.Create);
    lTestObj.Description := i.ToString;
    Writeln(format('TestObj with description %s added to Testlist', [lTestObj.Description]));
    lTestList.Add(lTestObj);
  end;
  for lTestObj in lTestList do
  begin
    writeln(lTestObj.Description);
  end;

  Writeln('SmartPointer test finished');
end;

{ TTestObj }

destructor TTestObj.Destroy;
begin
  Writeln(format('TestObj with description %s is destroyed', [FDescription]));
  inherited;
end;

{ TTestList }

destructor TTestList.Destroy;
begin
  Writeln('TTestList is destroyed');
  inherited;
end;

begin
  Test_SmartPointer;
  Readln;
end.

Вывод