DelphiオブジェクトへのWeak参照

Interfaceの[Weak]参照を使ったオブジェクトへの弱参照

いつ頃のバージョンからか把握していませんがInterfaceの参照には[Weak] Attributeを付けることで弱参照にすることができます。これを使ってオブジェクトへの弱参照を実現しようという記事です。

ARCがあった頃はモバイル向けに関しては通常オブジェクトにも[Weak]が使えたのでWindowsに来るのを心待ちにしていましたが、結局来ずにDelphi10.4ではARCが消えました。

日付	履歴
2021/8/30	TWeakObject<T>に型チェックや派生型へのTryUpgradeを追加
2021/8/30	TWeakObject<T>の使い方を間違っていたのでこそっと修正
2021/8/31	TWeakObject<T>のinterface部の更新を忘れていたのでこそっと修正
2021/8/31	TWeakInterface<I>の汎用版も追加しておく

Interfaceの[Weak]参照

[Weak]参照には二つの機能があって

• 循環参照によるリークを回避するために、参照カウンタを増減させずに参照を保持する
• 参照先が無くなった時にnilになる。(ダングリング状態にならない)

これら二つの機能は密接に関係してはいますが、それぞれ独立な機能です。DelphiでInterfaceを使うときに自動解放の機能は使わずに、他言語での所謂Interfaceとして使う場合、_AddRefや_Releaseを下記のようにしたクラスを書いて参照カウンタの増減を無効にすることが良くあるのですが、この使い方をするときは参照カウンタを増減させないという目的では[Weak]を使わないので、二つ目の機能が使えるかどうかを気にしていませんでした。

// 自動解放(参照カウンタ)機能を使わずにInterfaceを使うためのベースクラス
type
　TInterfacedBaseObject = class(TObject)
　　function QueryInterface(const IID: TGUID; out Obj): HRESULT; stdcall;
　　function _AddRef: Integer; stdcall;
　　function _Release: Integer; stdcall;
　end;

implementation

{ TInterfacedBaseObject }

function TInterfacedBaseObject.QueryInterface(const IID: TGUID; out Obj): HRESULT;
const
　E_NOINTERFACE = HResult($80004002);
begin
　if GetInterface(IID, Obj) then Result := 0 else Result := E_NOINTERFACE;
end;

function TInterfacedBaseObject._AddRef: Integer;
begin
　Result := -1;
end;

function TInterfacedBaseObject._Release: Integer;
begin
　Result := -1;
end;

リンク先がもうないのですが、TOBY Softさんの記事を参考にしているというかほぼそのままです

で、参照がダングリング状態にならないようにする目的では、以前に投稿したDelphi(10.4)でスマートポインタのTRc<>とTWeak<>を使っていたんですが、参照カウンタが欲しいわけではない(唯一のオーナーが生成・破棄を行い、他の参照は破棄されたことがわかるだけでよい)場合にTRc<>を使うのは気持ち悪いなと思い、ふと[Weak]を使えば独自スマートポインタを使わなくていいんじゃないかと試したらちゃんとできました。

※私が今まで気にしていなかっただけで、知っている方には自明なことだったはず...

type
  TTest = class(TInterfacedBaseObject, IInterface)
    procedure DoSomething();
  end;

procedure Test();
begin
  var obj := TTest.Create();
  var [Weak] w : IInterface := obj;
  
  obj.Free; // この時点でwがnilになる
  
  if w <> nil then // nilチェック
  begin
    (w as TTest).DoSomething(); // obj.Freeした場合はここに到達しない。安全！
  end;
end;

便利ですね。これから使っていきましょう。

Delphiの[Weak]の問題

...
上記のようにダングリングポインタになることを防ぐことができるので便利ですが、オブジェクトが解放されるとnilにはなります。なので上のソースのようにnilチェックが必要になりますが、Delphiはnilチェックをしていなくても怒ってくれません。
rustであればWeakのままでは使えず、一度強参照にupgradeする必要があるのでこのような問題は生じません。
なので、nilチェックしてupgradeにトライする(nilなら何もしない)ユーティリティレコードを作ります。

//interface部

type
  TRcUnwrapProc<T> = reference to procedure(const data : T); // Ownership.pasと共用するためこの名前

  TWeakIntf<I : IInterface> = record
  private
    [Weak] FWeakRef : I;
  public
    class operator Implicit(const Src : I) : TWeakIntf<I>; overload;

    function TryUpgrade(var Dest : I) : Boolean; overload;
    function TryUpgrade(func : TRcUnwrapProc<I>) : Boolean; overload;
  end;

//implementation部

{ TWeakIntf<I> }

class operator TWeakIntf<I>.Implicit(const Src: I): TWeakIntf<I>;
begin
  result.FWeakRef := Src;
end;

function TWeakIntf<I>.TryUpgrade(var Dest: I): Boolean;
begin
  Dest := FWeakRef;
  result := Dest <> nil;
end;

function TWeakIntf<I>.TryUpgrade(func: TRcUnwrapProc<I>): Boolean;
begin
  var Dest := FWeakRef;
  result := Dest <> nil;
  if result then func(Dest);
end;

短いソースなので詳細は書きませんが、次のような感じで使います

type
  TTest = class(TInterfacedBaseObject, IInterface)
    procedure DoSomething();
  end;

procedure Test();
begin
  var obj := TTest.Create();
  var w : TWeakIntf<IInterface> := obj;
  
  obj.Free; // この時点でw.FWeakRefがnilになる

  var sref : IInterface;
  if w.TryUpgrade(sref) then
  begin
    (sref as TTest).DoSomething(); // obj.Freeした場合はここに到達しない。安全！
  end;
end;

wのままでは何もできず、TryUpgradeしないと保持している参照にアクセスできないのでより安全になりました。
これで、ほぼ目的達成です。(※おまけ参照)

Interfaceからのキャストをしたくない

ですよね。やはりインターフェイス経由ではなくオブジェクトに対する弱参照が欲しいところです。なので以下のようなレコードも作りました。

//interface部

  TWeakObject<T : class> = record
  private
    [Weak] FWeakRef : IInterface;
  private class var
    FIID : TGUID;
  public
    class constructor Create;
    class operator Implicit(const Src : T) : TWeakObject<T>; overload;

    function TryUpgrade(var Dest : T) : Boolean; overload;
    function TryUpgrade(func : TRcUnwrapProc<T>) : Boolean; overload;
    function TryUpgradeAs<U:class>(var Dest : U) : Boolean; overload;
    function TryUpgradeAs<U:class>(func : TRcUnwrapProc<U>) : Boolean; overload;

    function IsType<U:class> : Boolean;
  end;

  TWeakObject = record
    class function Wrap<T : class>(Data : T) : TWeakObject<T>; static;
  end;

//implementation部

{ TWeakObject<T> }

class constructor TWeakObject<T>.Create;
begin
  // Tが持つインターフェイスを探しIIDを保持
  var cls := PTypeInfo(System.TypeInfo(T))^.TypeData^.ClassType;
  var cls_stock := cls;
  repeat
    var intftable := cls.GetInterfaceTable;
    if intftable <> nil then
    begin
      FIID := intftable.Entries[0].IID; // interfaceならばなんでも良いので一番目のIIDを保存
      break;
    end;
    cls := cls.ClassParent;
  until cls = nil;

  if cls = nil then
  begin
    raise Exception.Create(Format('TWeakObject<%s> : %s have not any Interface!', [cls_stock.ClassName, cls_stock.ClassName]));
  end;
end;

class operator TWeakObject<T>.Implicit(const Src: T): TWeakObject<T>;
begin
  var intf : IInterface;
  if Src.GetInterface(FIID, intf) then
  begin
    result.FWeakRef := intf;
  end else begin
    result := Default(TWeakObject<T>);
  end;
end;

function TWeakObject<T>.IsType<U>: Boolean;
begin
  result := (FWeakRef as T) is U;
end;

function TWeakObject<T>.TryUpgrade(var Dest: T): Boolean;
begin
  result := FWeakRef <> nil;
  if result then
  begin
    Dest := FWeakRef as T;
  end;
end;

function TWeakObject<T>.TryUpgrade(func: TRcUnwrapProc<T>): Boolean;
begin
  result := FWeakRef <> nil;
  if result then
  begin
    var Dest := FWeakRef as T;
    func(Dest);
  end;
end;

function TWeakObject<T>.TryUpgradeAs<U>(func: TRcUnwrapProc<U>): Boolean;
begin
  result := FWeakRef <> nil;
  if result then
  begin
    var obj := FWeakRef as T;
    if obj is U then
    begin
      func(obj as U);
    end else begin
      result := false;
    end;
  end;
end;

function TWeakObject<T>.TryUpgradeAs<U>(var Dest: U): Boolean;
begin
  result := FWeakRef <> nil;
  if result then
  begin
    var obj := FWeakRef as T;
    if obj is U then
    begin
      Dest := obj as U;
    end else begin
      result := false;
    end;
  end;
end;

{ TWeakObject }

class function TWeakObject.Wrap<T>(Data: T): TWeakObject<T>;
begin
  result := Data;
end;

TWeakObject<T : class, IInterface> = record等のような制約を書いて、特定のinterfaceを持つ場合に制限しても良かったのですが、今回の目的で使う場合はどんなinterfaceでも持っていればOKなので、class constructorで適当なインターフェイスのIIDを探して保持する形にしています。

interfaceを全く持たないオブジェクトを渡した場合、class constructorで例外を送出するので起動時に気が付けます。

以下使い方の例 (基本)

type
  // 流れ上TInterfacedBaseObjectを派生したクラスにしていますがinterfaceを持つ
  // クラスなら何でもよい
  TTest = class(TInterfacedBaseObject, IInterface)
    procedure DoSomething();
  end;

procedure Test();
begin
  var obj := TTest.Create();
  var w : TWeakObject<TTest> := obj;
  //var w := TWeakObject.Wrap(obj); // 型推論を使う場合
  
  obj.Free; // この時点でw.FWeakRefがnilになる

  var obj2 : TTest;
  if w.TryUpgrade(obj2) then
  begin
    obj2.DoSomething(); // キャスト不要。
  end;
end;

基本的に弱参照はクラスのフィールドとして使うことが多いと思うので型推論はあまり使えませんが、ローカル変数として一時的に使う場合はTWeakObject.Wrap()を使うことで型推論が使えます。

使い方の例2 (派生元の参照として保持して、指定型で取り出す)

procedure TForm1.Test();
begin
  var btn := TButton.Create(self); // FMXのコンポーネントは何かしらInterfaceを持っている
  btn.parent := self;
  btn.Position.Point := PointF(100,0); // 適当な位置に配置
	
  var w : TWeakObject<TStyledControl>:= btn; // TButtonの派生元TStyledControlとして保持

//  btn.Free;

  var data : TButton;
  if w.TryUpgradeAs(data) then // TButtonとして取り出す
  begin
    data.text := '!!!';
  end;

  btn.Free;

  // TButtonとして取り出す。こちらの書き方の方が取り出した変数がスコープ外に
  // 出ないので気持ちが良いが、記述が多い
  w.TryUpgradeAs<TButton>(procedure(const data : TButton)
  begin
    data.text := 'unreached';
  end);

end;

これで目的であったオブジェクトに対する[Weak]参照が実現できました。
それなりにコストがかかるし、スレッドセーフではないはずなので使いどころが限定されますが、GUIを作っている時によくある、「とあるイベント内のコードで保持した参照を別のイベント内で使いたいけど、参照先は任意のタイミングで解放したい」ケース等では便利に使えるはずです。(まだ数日ですが使い始めています)

おまけ(TWeakIntf<I>)の汎用版

話の流れ上、TWeakIntf<I>の説明でほぼ目的達成と書いてますが、このレコードは汎用的なInterfaceを持てるように見えながらIInterfaceしか扱えません。(制約で<I : IInterface>と書いているため) 。また、このIにはIInterfaceだけでなくIInterfaceを持つクラスを指定できてしまいますが、その場合は正しく動作しません。
今回の記事の目的はオブジェクト用のWeak参照実装なので目的外ではありますが汎用的なInterface向け版も張り付けておきます。制約で指定するのをやめてTWeakObject<T>と同じ様にclass constructorでintarface型かどうかを判断しています。
(おまけなので折りたたんでます)

ソース

  TWeakIntf<I> = record
  private
    [Weak] FWeakRef : IInterface;
  public
    class constructor Create;
    class operator Implicit(const Src : I) : TWeakIntf<I>; overload;

    function TryUpgrade(var Dest : I) : Boolean; overload;
    function TryUpgrade(func : TRcUnwrapProc<I>) : Boolean; overload;
  end;
	

{ TWeakIntf<I> }

class constructor TWeakIntf<I>.Create;
begin
  if GetTypeKind(I) <> tkInterface then
  begin
    // IがInterface以外なら例外送出
    var typname := PTypeInfo(System.TypeInfo(I))^.Name;
    raise Exception.Create(Format('TWeakIntf<%s> : %s is not Interface!', [typname, typname]));
  end;
end;

class operator TWeakIntf<I>.Implicit(const Src: I): TWeakIntf<I>;
var
  p : I;
  intf : IInterface absolute p;
begin
  p := Src;
  result.FWeakRef := intf;
end;

function TWeakIntf<I>.TryUpgrade(var Dest: I): Boolean;
var
  intf : IInterface absolute Dest;
begin
  intf := FWeakRef;
  result := intf <> nil;
end;

function TWeakIntf<I>.TryUpgrade(func: TRcUnwrapProc<I>): Boolean;
var
  Dest : I;
  intf : IInterface absolute Dest;
begin
  intf := FWeakRef;
  result := intf <> nil;
  if result then func(Dest);
end;