Jump to content

Recommended Posts

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.


 

Share this post


Link to post

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 by Schokohase

Share this post


Link to post

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!

Share this post


Link to post

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!

Share this post


Link to post

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 by Attila Kovacs

Share this post


Link to post

@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 by Attila Kovacs

Share this post


Link to post

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 by Primož Gabrijelčič

Share this post


Link to post

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

  • Like 1

Share this post


Link to post

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

Share this post


Link to post

Create an account or sign in to comment

You need to be a member in order to leave a comment

Create an account

Sign up for a new account in our community. It's easy!

Register a new account

Sign in

Already have an account? Sign in here.

Sign In Now

×