Smartpointers do not work well with a generic TObjectlist in Delphi

Question

I am testing smart-pointers in Delphi 10.3 Rio using Spring4D. Here is my test program. I created a generic TObjectList and I want to add simple TObjects to this list using Shared.Make(TTestObj.Create). The problem is that whenever I add an object to the List, the previous object is released. See the output of my program. Does anyone know how to solve this problem?

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

The problem is that your TObjectList holds raw TTestObj object pointers, not the IShared<TTestObj> interfaces that Shared.Make<T>() returns.

In var lTestList := Shared.Make(TTestList.Create)();, you are creating an IShared<TTestList> (a reference to function: TTestList) that wraps a TTestList object you are creating. You are invoking () on the IShared, which calls the function to return the raw TTestList object pointer. Which is OK in this example, because the IShared will be held in a hidden variable for the lifetime of Test_SmartPointer(), thus its refcount is 1, keeping the TTestList alive.

In var lTestObj := Shared.Make(TTestObj.Create)(); you are doing the same thing, this time for an IShared<TTestObj> returning an TTestObj object pointer. However, when lTestObj goes out of scope at the end of each loop iteration, the refcount of the IShared is decremented. Since there are no further references to that interface, its refcount falls to 0, destroying the object behind the IShared, which in turn destroys its associated TTestObj object, leaving the TObjectList with a dangling TTestObj pointer (but you don't experience any crashes with that, since you are not accessing the stored TTestObj objects in any way, not even in the TObjectList destructor due to OwnsObjects=false).

You need to change TTestList to hold IShared<TTestObj> elements instead of TTestObj elements (in that case, you should use TList<T> instead of TObjectList<T>), and get rid of the () invocations on the IShared interfaces when calling 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.