Delphiでスマートポインタを実現し、オブジェクトのFree地獄から解放する方法を考えた

以下の記事の改良版です

先の記事では、開放するのはジェネリクス<T>で指定したオブジェクト限定でした。
しかし、多くの場合にやりたいことはモジュール内でCreateしたオブジェクト全部を、終了時に自動で開放することです。
そのためにコードを改良しました。

unit AutoFreeObjects;

interface

uses
  System.SysUtils, System.Generics.Collections;

type
  // 後からオブジェクトを登録するだけのシンプルなコンテナ
  TAutoFreeObjects = record
  private
    type
      TObjectOwner = class(TInterfacedObject)
      private
        FItems: TObjectList<TObject>;
      public
        constructor Create;
        destructor Destroy; override;
        procedure Add(AItem: TObject);
      end;
  private
    FOwner: TObjectOwner;
    FRef: IInterface;
    function GetOwner: TObjectOwner;
  public
    procedure Add(AItem: TObject);
  end;

implementation

{ TAutoFreeObjects.TObjectOwner }

constructor TAutoFreeObjects.TObjectOwner.Create;
begin
  inherited Create;
  // OwnsObjects = True で全自動Free
  FItems := TObjectList<TObject>.Create(True);
end;

destructor TAutoFreeObjects.TObjectOwner.Destroy;
begin
  FItems.Free;
  inherited;
end;

procedure TAutoFreeObjects.TObjectOwner.Add(AItem: TObject);
begin
  FItems.Add(AItem);
end;

{ TAutoFreeObjects }

function TAutoFreeObjects.GetOwner: TObjectOwner;
begin
  if FRef = nil then
  begin
    FOwner := TObjectOwner.Create;
    FRef := FOwner;
  end;
  Result := FOwner;
end;

procedure TAutoFreeObjects.Add(AItem: TObject);
begin
  GetOwner.Add(AItem);
end;
end.

使用例

program AutoFreeObjectsTest;

{$APPTYPE CONSOLE}

uses
  System.SysUtils,
  System.Classes,
  AutoFreeObjects in 'AutoFreeObjects.pas';

type
  // デストラクタでログを出力する検証用クラス
  TTestObject = class
  private
    FName: string;
  public
    constructor Create(const AName: string);
    destructor Destroy; override;
  end;

{ TTestObject }

constructor TTestObject.Create(const AName: string);
begin
  inherited Create;
  FName := AName;
  Writeln('  [Create] ', FName, ' が生成されました');
end;

destructor TTestObject.Destroy;
begin
  Writeln('  [Free]   ', FName, ' が解放されました');
  inherited;
end;

procedure Demo;
var
  AutoFree: TAutoFreeObjects;
  Stream: TStringStream;
  TestObj: TTestObject;
begin

  // 1. 生成して登録
  Stream := TStringStream.Create('データ');
  AutoFree.Add(Stream);

  TestObj := TTestObject.Create('テスト用オブジェクト');
  AutoFree.Add(TestObj);

  // 2. 普通に使う
  Writeln('  [Data]   Streamの内容: ', Stream.DataString);

  // スコープを抜けるタイミングで自動解放される
end;

begin
  Writeln('--- Demo 開始 ---');
  Demo;
  Writeln('--- Demo 終了---');
  Writeln;
  Writeln('Enter キーを押すと終了します...');
  Readln;
end.

元の記事のように凝ったことはせずに、シンプルにリストに追加するだけで、スコープを抜けると自動で開放されます。

応用

TAutoFreeObjects の仕組みを応用して、オブジェクトの破棄処理だけに限定されず、スコープ脱出時に任意の処理（TProc）を実行させる方法を考えました。
ファイルのクローズなど後処理が必要なものを予約させることが出来ます

やってることは、try ~ finallyとほとんど同じです。

type
  TAutoDefer = record
  private
    type
      TDeferOwner = class(TInterfacedObject)
      private
        FProcs: TList<TProc>;
      public
        constructor Create;
        destructor Destroy; override;
        procedure Add(const AProc: TProc);
      end;
  private
    FOwner: TDeferOwner;
    FRef: IInterface;
    function GetOwner: TDeferOwner;
  public
    // スコープ終了時に実行したい処理（無名関数）を追加します
    procedure Add(const AProc: TProc);
  end;

implementation

{ TAutoDefer.TDeferOwner }

constructor TAutoDefer.TDeferOwner.Create;
begin
  inherited Create;
  FProcs := TList<TProc>.Create;
end;

destructor TAutoDefer.TDeferOwner.Destroy;
var
  Proc: TProc;
begin
  for Proc in FProcs do
  begin
    Proc();
  end;
  FProcs.Free;
  inherited;
end;

procedure TAutoDefer.TDeferOwner.Add(const AProc: TProc);
begin
  FProcs.Add(AProc);
end;

{ TAutoDefer }

function TAutoDefer.GetOwner: TDeferOwner;
begin
  // 初回アクセス時に自動初期化（AutoFreeと同じ遅延初期化メカニズム）
  if FRef = nil then
  begin
    FOwner := TDeferOwner.Create;
    FRef := FOwner;
  end;
  Result := FOwner;
end;

procedure TAutoDefer.Add(const AProc: TProc);
begin
  GetOwner.Add(AProc);
end;

使用例

procedure Demo;
var
  Defer: TAutoDefer;
  Stream: TStringStream;
begin
  // 1. 関数の終了ログを出力させる
  Defer.Add(procedure begin Writeln('Demo関数を終了します'); end);

  Stream := TStringStream.Create('データ');
  // 2. 解放処理の予約
  Defer.Add(procedure begin Stream.Free; end);

  // 3. 普通に使う
  Writeln('Streamの内容: ', Stream.DataString);

end;

begin
  Writeln('--- Demo 開始 ---');
  Demo;
  Writeln('--- Demo 終了---');
  Writeln;
  Writeln('Enter キーを押すと終了します...');
  Readln;
end.

追記　2026/9/12

TAutoFreeObjectsとTAutoDeferを包括したオブジェクト
TScopeGuardを設計しました

実行順序も「後から登録したものを先に実行する（LIFO）」としました

unit ScopGuard;

interface

uses
  System.SysUtils, System.Generics.Collections;

type
  TScopeGuard = record
  private
    type
      TGuardOwner = class(TInterfacedObject)
      private
        FProcs: TList<TProc>;
      public
        constructor Create;
        destructor Destroy; override;
        procedure AddProc(const AProc: TProc);
        procedure AddObject(AObject: TObject);
      end;
  private
    FOwner: TGuardOwner;
    FRef: IInterface;
    function GetOwner: TGuardOwner;
  public
    procedure Add(const AProc: TProc); overload;
    procedure Add(AObject: TObject); overload;
  end;

implementation

{ TScopeGuard.TGuardOwner }

constructor TScopeGuard.TGuardOwner.Create;
begin
  inherited Create;
  FProcs := TList<TProc>.Create;
end;

destructor TScopeGuard.TGuardOwner.Destroy;
var
  i: Integer;
begin
  // 後入れ先出し（LIFO）で実行する：後から生成したものを先に破棄
  for i := FProcs.Count - 1 downto 0 do
  begin
    try
      FProcs[i]();
    except
      // スコープ脱出時の例外でアプリが落ちないよう安全対策
    end;
  end;
  FProcs.Free;
  inherited;
end;

procedure TScopeGuard.TGuardOwner.AddProc(const AProc: TProc);
begin
  FProcs.Add(AProc);
end;

procedure TScopeGuard.TGuardOwner.AddObject(AObject: TObject);
begin
  // オブジェクト破棄も TProc として統一登録する
  AddProc(procedure begin AObject.Free; end);
end;

{ TScopeGuard }

function TScopeGuard.GetOwner: TGuardOwner;
begin
  if FRef = nil then
  begin
    FOwner := TGuardOwner.Create;
    FRef := FOwner;
  end;
  Result := FOwner;
end;

procedure TScopeGuard.Add(const AProc: TProc);
begin
  GetOwner.AddProc(AProc);
end;

procedure TScopeGuard.Add(AObject: TObject);
begin
  GetOwner.AddObject(AObject);
end;

end.

LIFOが必須なサンプル

procedure SaveUserData;
var
  Guard: TScopeGuard;
  FileStream: TFileStream;
  Writer: TStreamWriter;
begin
  FileStream := TFileStream.Create('output.txt', fmCreate);
  Guard.Add(FileStream);
  Writer := TStreamWriter.Create(FileStream, TEncoding.UTF8);
  Guard.Add(Writer);
  Guard.Add(procedure begin Writeln('ファイル保存処理がすべて完了しました'); end);
  Writer.WriteLine('ユーザデータ');
end;

begin
  Writeln('--- Demo 開始 ---');
  SaveUserData;
  Writeln('--- Demo 終了---');
  Writeln;
  Writeln('Enter キーを押すと終了します...');
  Readln;
end.