Search the Community

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.