ObjectDestroyedOK.dpr

program ObjectDestroyedOK;

{$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;

  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;

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

{ TTestObj }

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

{ TWorkItem }

constructor TWorkItem.Create;
var
  ov: TOmniValue;
begin
  inherited;
  FResult := TOmniValueFwd.Create(ov);
end;

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

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

procedure TWorkItem.SetResult(const Value: IOmniValueFwd);
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;

class operator TOmniValue.Implicit(const ov: TOmniValue): IOmniValueFwd;
begin
  Result := TOmniValueFwd.Create(ov);
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;

{ TOmniValueFwd }

constructor TOmniValueFwd.Create(const ov: TOmniValue);
begin
  inherited Create;
  FOmniValue := ov;
end;

function TOmniValueFwd.GetAsOwnedObject: TObject;
begin
  Result := FOmniValue.GetAsOwnedObject;
end;

function TOmniValueFwd.GetValue: TOmniValue;
begin
  Result := FOmniValue;
end;

procedure TOmniValueFwd.SetAsOwnedObject(const Value: TObject);
begin
  FOmniValue.SetAsOwnedObject(Value);
end;

{ main }

procedure Test(const workItem: IWorkItem);
//var
//  ov: TOmniValue;
begin
  workItem.Result.AsOwnedObject := TTestObj.Create;
//  ov.AsOwnedObject := TTestObj.Create;
//  workItem.Result := ov;
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.

ObjectDestroyedOK2.dpr

program ObjectDestroyedOK2;

{$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;

  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;

{ TTestObj }

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

{ TWorkItem }

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

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

procedure TWorkItem.SetResult(const Value: POmniValue);
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;

class operator TOmniValue.Implicit(var ov: TOmniValue): POmniValue;
begin
  Result := @ov;
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);
var
  ov: TOmniValue;
begin
//  workItem.Result.AsOwnedObject := TTestObj.Create;
  ov.AsOwnedObject := TTestObj.Create;
  workItem.Result := ov;
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.

ObjectDestroyedTooSoon.dpr

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.