1

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.

Output

Remy Lebeau
  • 555,201
  • 31
  • 458
  • 770

2 Answers2

4

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.
Remy Lebeau
  • 555,201
  • 31
  • 458
  • 770
  • Since Delphi has no garbage collector and ARC has been removed I was looking for a general structure to automatically free objects. My impression from smartpointers is that it's a bit too complicated to be used as an easy-to-use general stucture for automatically freeing objects. – Kees Dijksman May 07 '20 at 22:28
  • "*and ARC has been removed*" - well, not yet anyway, not until RAD Studio 10.4 is released. Not that it matters, as this issue exists in previous versions too, for non-ARC platforms like Windows. – Remy Lebeau May 07 '20 at 22:50
1

Here is the code that works (thanks to Remy Lebeau). Since Delphi has no garbage collector and ARC has been removed I was looking for a general structure to automatically free objects. My impression from smartpointers is that it's a bit too complicated to be used as an easy-to-use general stucture for automatically freeing objects.

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.

Output

  • You did not need to change your `Test_SmartPointer()` procedure (except to remove the assignment of `lTestList.OwnsObjects := false;`). Once you changed `TTestList` to use `TList>` instead of `TObjectList`, the rest of your code was fine. – Remy Lebeau May 07 '20 at 22:47
  • You might not have noticed the brackets after Shared.Make(TTestObj.Create)(). That was the real problem. – Kees Dijksman May 08 '20 at 07:22
  • No, I didn't notice that, thanks. I have tweaked the wording of my answer. But that doesn't change the core issue described by my answer. The original code was still storing raw `TTestObj` pointers into the list rather than the `IShared` interfaces. – Remy Lebeau May 08 '20 at 19:36