[Delphi] Interface による Singleton

Object Pascal で Singleton は難しい

よく言われているように Delphi / Object Pascal で Singleton を作るのは非常に難しいのです。
それはインスタンスを生成する constructor Create がルートオブジェクトの TObject で public に設定されているためです。

System.TObject宣言部引用

  TObject = class
  public
    constructor Create; // ←これ
  // 以下略

そのため Delphi では紳士協定として

• Current や Instance といったクラス変数が用意されている場合はそれを使いインスタンスを作らない

• Printer 関数のように変数に見える関数が定義されている場合はそれを使いインスタンスを作らない

という作法があります。

実装を隠蔽しよう

そもそも何が問題かというと前項でも述べたように TObject.Create が見えているのが問題です。

では、これを見えないようにする方法はあるでしょうか？
その方法は class その物を見えないようにする、ぐらいしかありません。

class が見えないならば、当然コンストラクタも見えません。
もちろん TObject.Create も見えなくなり問題解決です！
つまり class を隠蔽してしまえば良いのです。

最も簡単な隠蔽方法は class を implementation 下で宣言する事です。
こうすると他の unit から class を参照できなくなります。
これで、class は隠蔽されました。

とはいえ、これだと他の unit から class の機能を呼び出せず本末転倒です。

interface を使おう

interface は単なる宣言であり、class と違ってインスタンス化できません。
ですので、interface は見えていても何の問題もありません。
そこで、隠蔽したクラスの必要な機能を interface 経由で呼べるようにします。

具体的には

interface

type
  // 提供する機能を宣言
  // interface は見えていても何も問題ない
  ISample = interface
    procedure Foo(ABar: String);
    function Bar: String;
  end;

implementation

type
  // interface の実装はこちらに書く
  // ここは他の unit からは見えない
  TSample = class(TNoRefCountObject, ISample)
  private
    procedure Foo(ABar: String);
    function Bar: String;
  end;

// 省略

↑このようにします。

そして、この Interface を返す為に「変数にみえる関数」を定義し、interface を返すようにします。

interface

type
  ISample = interface
    procedure Foo(ABar: String);
    function Bar: String;
  end;

// Interface を返す関数
function Sample: ISample; // ←これ！

implementation

var
  // インスタンスを保持するグローバル変数
  // インスタンスは initialization で生成
  GSample: TSample;

function Sample: ISample;
begin
  Result := GSample; // インスタンスを Interface として返すだけ
end;

// 省略

関数を介して機能を呼び出す

ここまでを実装すると、下記の様に Sample 関数を介して class の機能にアクセスできるようになります。
しかも class が見えていないのでインスタンスが複数できる事はありません。

uses
  uSingletonSample;

begin
  Sample.Foo('こんにちは世界');
  var Baz := Sample.Bar;  
end.

サンプルコード全文

ここまでの全文は下のサンプルコード全文を見てください。

サンプルコード全文

unit uSingletonSample;

interface

type
  ISample = interface
    procedure Foo(ABar: String);
    function Bar: String;
  end;

function Sample: ISample;

implementation

type
  TSample = class(TNoRefCountObject, ISample)
  private
    procedure Foo(ABar: String);
    function Bar: String;
  end;

var
  // TSample のインスタンスを保持するグローバル変数
  // インスタンスは initialization で生成
  GSample: TSample; 

function Sample: ISample;
begin
  Result := GSample;
end;

{ TSample }

function TSample.Bar: String;
begin
  Result := 'Bar';
end;

procedure TSample.Foo(ABar: String);
begin
  Writeln('Foo: ', ABar);
end;

initialization
  GSample := TSample.Create;

finalization
  GSample.Free;

end.

サンプルコードに出てくる TNoRefCountObject は参照カウントが必用無い場合のもっとも単純な基底型です。
class の機能を interface を介して呼び出すだけなので参照カウントは必要ありません。
また TComponent の子孫、たとえば TFmxObject 等でも参照カウントは無視されます（コンポーネントが勝手に廃棄されたら困りますからね）。

まとめ

Interface を返す関数を定義することで Singleton を実現します。

この手法は大規模プロジェクトで大人数が関わる場合（紳士協定を理解していない人が居たとしても）インスタンスを複数作れなくなるので大変有効です。