Object destroyed too soon?
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.