Object destroyed too soon?

[Primož Gabrijelčič 223]

Dear all,

 

I'm being stupid and I can't figure why in the following code the `TTestObj` is destroyed before its owner. Can you please help?

 

Full code is available here and is also posted at the end of this post.

 

Basically, I have an interface `IWorkItem` which owns record `TOmniValue` which owns interface `IAutoDestroyObject`.

 

The code creates an instance of `IWorkItem` and then calls:

 

procedure Test(const workItem: IWorkItem);
begin
  workItem.Result.AsOwnedObject := TTestObj.Create;
end;

This sets the `IAutoDestroyObject` field of the nested `TOmniValue` record.

 

When the `Test` function exits (during the procedure finalization code) this `TTestObj` gets destroyed, and I can't figure out why.

 

program ObjectDestroyedTooSoon;

{$APPTYPE CONSOLE}

{$R *.res}

uses
  Winapi.Windows,
  System.SysUtils;

type
  TTestObj = class
  public
    destructor Destroy; override;
  end;

  IAutoDestroyObject = interface ['{30CF4CCF-9383-41C0-BBA3-E24F7C4EFF71}']
    function  GetObj: TObject;
    property Obj: TObject read GetObj;
  end;

  TAutoDestroyObject = class(TInterfacedObject, IAutoDestroyObject)
  strict private
    FObject: TObject;
  protected
    function GetObj: TObject;
  public
    constructor Create(obj: TObject);
    destructor  Destroy; override;
    property Obj: TObject read GetObj;
  end;

  TOmniValue = record
  private
    FOwnedObject: IAutoDestroyObject;
    function GetAsOwnedObject: TObject;
    procedure SetAsOwnedObject(const Value: TObject);
  public
    property AsOwnedObject: TObject read GetAsOwnedObject write SetAsOwnedObject;
  end;

  IWorkItem = interface ['{7C583FC8-90DD-46A5-81B9-81B911AA1CBE}']
    function GetResult: TOmniValue;
    procedure SetResult(const Value: TOmniValue);
    property Result: TOmniValue read GetResult write SetResult;
  end;

  TWorkItem = class(TInterfacedObject, IWorkItem)
  strict private
    FResult: TOmniValue;
  strict protected
    function GetResult: TOmniValue;
    procedure SetResult(const Value: TOmniValue);
  public
    destructor Destroy; override;
    property Result: TOmniValue read GetResult write SetResult;
  end;

{ TTestObj }

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

{ TWorkItem }

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

function TWorkItem.GetResult: TOmniValue;
begin
  Result := FResult;
end;

procedure TWorkItem.SetResult(const Value: TOmniValue);
begin
  FResult := Value;
end;

{ TOmniValue }

function TOmniValue.GetAsOwnedObject: TObject;
begin
  Result := FOwnedObject.Obj;
end;

procedure TOmniValue.SetAsOwnedObject(const Value: TObject);
begin
  FOwnedObject := TAutoDestroyObject.Create(Value);
end;

{ TAutoDestroyObject }

constructor TAutoDestroyObject.Create(obj: TObject);
begin
  inherited Create;
  FObject := obj;
end;

destructor TAutoDestroyObject.Destroy;
begin
  FreeAndNil(FObject);
  inherited;
end;

function TAutoDestroyObject.GetObj: TObject;
begin
  Result := FObject;
end;

{ main }

procedure Test(const workItem: IWorkItem);
begin
  workItem.Result.AsOwnedObject := TTestObj.Create;
end;

var
  workItem: IWorkItem;

begin
  try
    workItem := TWorkItem.Create;
    Test(workItem);
    Writeln('After Test');
    workItem := nil;
    Writeln('workItem destroyed');
    Readln;
  except
    on E: Exception do
      Writeln(E.ClassName, ': ', E.Message);
  end;
end.

 

[Guest]

I extended your program with a little more log info.

program ObjectDestroyedTooSoon;

{$APPTYPE CONSOLE}
{$R *.res}

uses
  Winapi.Windows,
  System.SysUtils;

type
  TTestObj = class
  public
    destructor Destroy; override;
  end;

  IAutoDestroyObject = interface
    ['{30CF4CCF-9383-41C0-BBA3-E24F7C4EFF71}']
    function GetObj: TObject;
    property Obj: TObject read GetObj;
  end;

  TAutoDestroyObject = class(TInterfacedObject, IAutoDestroyObject)
  strict private
    FObject: TObject;
  protected
    function GetObj: TObject;
  public
    constructor Create(Obj: TObject);
    destructor Destroy; override;
    property Obj: TObject read GetObj;
  end;

  TOmniValue = record
  private
    FOwnedObject: IAutoDestroyObject;
    function GetAsOwnedObject: TObject;
    procedure SetAsOwnedObject(const Value: TObject);
  public
    property AsOwnedObject: TObject read GetAsOwnedObject write SetAsOwnedObject;
  end;

  IWorkItem = interface
    ['{7C583FC8-90DD-46A5-81B9-81B911AA1CBE}']
    function GetResult: TOmniValue;
    procedure SetResult(const Value: TOmniValue);
    property Result: TOmniValue read GetResult write SetResult;
  end;

  TWorkItem = class(TInterfacedObject, IWorkItem)
  strict private
    FResult: TOmniValue;
  strict protected
    function GetResult: TOmniValue;
    procedure SetResult(const Value: TOmniValue);
  public
    destructor Destroy; override;
    property Result: TOmniValue read GetResult write SetResult;
  end;

  { TTestObj }

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

{ TWorkItem }

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

function TWorkItem.GetResult: TOmniValue;
begin
  Result := FResult;
end;

procedure TWorkItem.SetResult(const Value: TOmniValue);
begin
  Writeln('TWorkItem.SetResult'); // This one I added
  FResult := Value;
end;

{ TOmniValue }

function TOmniValue.GetAsOwnedObject: TObject;
begin
  Result := FOwnedObject.Obj;
end;

procedure TOmniValue.SetAsOwnedObject(const Value: TObject);
begin
  FOwnedObject := TAutoDestroyObject.Create(Value);
end;

{ TAutoDestroyObject }

constructor TAutoDestroyObject.Create(Obj: TObject);
begin
  inherited Create;
  FObject := Obj;
end;

destructor TAutoDestroyObject.Destroy;
begin
  FreeAndNil(FObject);
  inherited;
end;

function TAutoDestroyObject.GetObj: TObject;
begin
  Result := FObject;
end;

{ main }

procedure Test(const workItem: IWorkItem);
begin
  workItem.Result.AsOwnedObject := TTestObj.Create;
end;

var
  workItem: IWorkItem;

begin
  try
    workItem := TWorkItem.Create;
    Test(workItem);
    Writeln('After Test');
    workItem := nil;
    Writeln('workItem destroyed');
    Readln;
  except
    on E: Exception do
      Writeln(E.ClassName, ': ', E.Message);
  end;

end.

Now you should see, that you do not see it and now you should see why ...

 

Or even shorter and more clear

procedure Test(const workItem: IWorkItem);
begin
  workItem.Result.AsOwnedObject := TTestObj.Create;

  if not Assigned(workItem.Result.FOwnedObject) then
    Writeln('Hmmm, I had to think about that');
end;

 

Edited January 31, 2019 by Guest

[Attila Kovacs 629]

I'd say thats why: property Result: TOmniValue read GetResult write SetResult;

A Record property.

[Primož Gabrijelčič 223]

Doh! I knew I was just stupid.

 

To recap (for people who don't want to dig through ton of code).

procedure Test(const workItem: IWorkItem);
begin
  workItem.Result.AsOwnedObject := TTestObj.Create;
end;

is equivalent to:

procedure Test(const workItem: IWorkItem);
var
  tmp: TOmniValue;
begin
  tmp := workItem.Result;
  tmp.AsOwnedObject := TTestObj.Create;
end;

To do it correctly, one must change the code to:

procedure Test(const workItem: IWorkItem);
var
  ov: TOmniValue;
begin
  ov.AsOwnedObject := TTestObj.Create;
  workItem.Result := ov;
end;

Thank you, guys!

[Primož Gabrijelčič 223]

Do we have any neat solution for that problem?

 

I can change `IWorkItem` to:

IWorkItem = interface ['{7C583FC8-90DD-46A5-81B9-81B911AA1CBE}']
  function GetResult: POmniValue;
  procedure SetResult(const Value: TOmniValue);
  property Result: POmniValue read GetResult;
end;

This allows me to use:

workItem.Result.AsOwnedObject := TTestObj.Create;

But it also prevents me from doing:

workItem.Result := TTestObj.Create;

Which is more common usage. 

 

Grrrrr!

[Attila Kovacs 629]

Of course. Question is, how do you like it and how does it interfere with the existing lib.

 

I've no clue of this lib, but this should give you some ideas wrapping the record into something.

 

 

TWorkItem = class;

TOmniValue = record
  private
    FOwner: TWorkItem;    // <-------
    FOwnedObject: IAutoDestroyObject;
    function GetAsOwnedObject: TObject;
    procedure SetAsOwnedObject(const Value: TObject);
  public
    property AsOwnedObject: TObject read GetAsOwnedObject write SetAsOwnedObject;
  end;

TWorkItem = class(TInterfacedObject, IWorkItem)
  strict private
    FResult: TOmniValue;
  strict protected
    function GetResult: TOmniValue;
  protected // <------------
    procedure SetResult(const Value: TOmniValue);
  public
    destructor Destroy; override;
    property Result: TOmniValue read GetResult write SetResult;
  end;



function TWorkItem.GetResult: TOmniValue;
begin
  Result := FResult;
  Result.FOwner := Self;  // <------------
end;

procedure TOmniValue.SetAsOwnedObject(const Value: TObject);
begin
  FOwnedObject := TAutoDestroyObject.Create(Value);
  FOwner.SetResult(Self); // <-------------------
end;                                           


                                           

 

Edited January 31, 2019 by Attila Kovacs

[Primož Gabrijelčič 223]

Hmmm, I'll have to think about it. That can be a solution but I'm afraid I will cause too big mess. Thanks.

[Attila Kovacs 629]

@Primož Gabrijelčič Yup. Still, let me know if you find an other way, I'm also interested.

Especially if you can avoid the extra copyrecord's and still have the original syntax.

Edited January 31, 2019 by Attila Kovacs

[Primož Gabrijelčič 223]

I'm thinking about changing `IWorkItem.Result` into `TOmniValueClass = class ...` where `TOmniValueClass` exports same API as `TOmniValue` and forwards all requests to a private `TOmniValue` record.

 

LTR: Meh, doesn't work. That makes the getter work fine, but again stops the setter from working 😞

Edited January 31, 2019 by Primož Gabrijelčič

[Primož Gabrijelčič 223]

This works, but requires lots of code if I would want to implement it with the original (very rich) `TOmniValue` record:

 

  IOmniValueFwd = interface;

  TOmniValue = record
  private
    FOwnedObject: IAutoDestroyObject;
    function GetAsOwnedObject: TObject;
    procedure SetAsOwnedObject(const Value: TObject);
  public
    class operator Implicit(const ov: TOmniValue): IOmniValueFwd;
    property AsOwnedObject: TObject read GetAsOwnedObject write SetAsOwnedObject;
  end;

  IOmniValueFwd = interface ['{4CCE0702-1CBF-4467-8185-8C38C37BA624}']
    function GetAsOwnedObject: TObject;
    function GetValue: TOmniValue;
    procedure SetAsOwnedObject(const Value: TObject);
    property AsOwnedObject: TObject read GetAsOwnedObject write SetAsOwnedObject;
    property Value: TOmniValue read GetValue;
  end;

  TOmniValueFwd = class(TInterfacedObject, IOmniValueFwd)
  strict private
    FOmniValue: TOmniValue;
  strict protected
    function GetAsOwnedObject: TObject;
    function GetValue: TOmniValue;
    procedure SetAsOwnedObject(const Value: TObject);
  public
    constructor Create(const ov: TOmniValue);
    property AsOwnedObject: TObject read GetAsOwnedObject write SetAsOwnedObject;
    property Value: TOmniValue read GetValue;
  end;

  IWorkItem = interface ['{7C583FC8-90DD-46A5-81B9-81B911AA1CBE}']
    function GetResult: IOmniValueFwd;
    procedure SetResult(const Value: IOmniValueFwd);
    property Result: IOmniValueFwd read GetResult write SetResult;
  end;

I can then use:

procedure Test(const workItem: IWorkItem);
begin
  workItem.Result.AsOwnedObject := TTestObj.Create;
end;

or:

procedure Test(const workItem: IWorkItem);
var
  ov: TOmniValue;
begin
  ov.AsOwnedObject := TTestObj.Create;
  workItem.Result := ov;
end;

And both work fine.

 

full code here

[Attila Kovacs 629]

@Primož Gabrijelčič Nice. I like that the wrapper/forwarder is now a common thing, even if this solution has the same amount of copyrecords plus some IF handling.

[Primož Gabrijelčič 223]

Yes, it is definitely not a fast solution. It is elegant for the user, though.

[Primož Gabrijelčič 223]

Got it.

type
  POmniValue = ^TOmniValue;
  TOmniValue = record
  private
    FOwnedObject: IAutoDestroyObject;
    function GetAsOwnedObject: TObject;
    procedure SetAsOwnedObject(const Value: TObject);
  public
    class operator Implicit(var ov: TOmniValue): POmniValue; static;
    property AsOwnedObject: TObject read GetAsOwnedObject write SetAsOwnedObject;
  end;

  IWorkItem = interface ['{7C583FC8-90DD-46A5-81B9-81B911AA1CBE}']
    function GetResult: POmniValue;
    procedure SetResult(const Value: POmniValue);
    property Result: POmniValue read GetResult write SetResult;
  end;

  TWorkItem = class(TInterfacedObject, IWorkItem)
  strict private
    FResult: TOmniValue;
  strict protected
    function GetResult: POmniValue;
    procedure SetResult(const Value: POmniValue);
  public
    destructor Destroy; override;
    property Result: POmniValue read GetResult write SetResult;
  end;

class operator TOmniValue.Implicit(var ov: TOmniValue): POmniValue;
begin
  Result := @ov;
end;

function TWorkItem.GetResult: POmniValue;
begin
  Result := @FResult;
end;

procedure TWorkItem.SetResult(const Value: POmniValue);
begin
  FResult := Value^;
end;

 

It's quite possible that this breaks quite easily, though, as this solution looks quite fragile to me. It is simple and efficient, though.

 

full code here

[Attila Kovacs 629]

@Primož Gabrijelčič Yes, this was the original problem which I've used to solved with the wrapper. Rather more code/resource than record pointers. I like to sleep well.