DelphiでSingletonパターンを実装する

GoFによるデザインパターンのシングルトンパターンをDelphiで実装することを考えてみます。シングルトンパターン(Singleton pattern)とは、

あるクラスに対してインスタンスが1つしか存在しないことを保証し、それにアクセスするためのグローバルな方法を提供する。

ことを目的とした"生成に関するパターン"の一つです。

最初に"シングルトンもどき"です。Delphiプログラマがシングルトンと聞くと、Printerオブジェクト(Printers.Printer (ja))を思い浮かべることが多いのではないでしょうか。Printerは厳密な意味でのシングルトンではありませんが、実用上はこの程度の実装で十分なことが多いのも確かです。この"シングルトンもどき"("Printerパターン"？)は、唯一となるべきインスタンスを格納する変数を隠蔽して、代わりにインスタンスを返す関数を用意しておき、最初のアクセスでインスタンスを生成する、というやりかたで、実際には複数のインスタンスを生成することが可能なのですが、逆にグローバルなインスタンスは一つでも、ローカル/一時的なインスタンスはそれとは別に生成したい、というような場合にはとても適合しています。

unit Unit2;

interface

type
  TSingleton = class(TObject)
  private
    FTestValue: Integer;
  public
    constructor Create;
    destructor  Destroy; override;
    property    TestValue: Integer
                  read  FTestValue
                  write FTestValue;
  end;

function Singleton: TSingleton;


implementation

var
  FSingleton: TSingleton;

function Singleton: TSingleton;
begin

  if FSingleton = nil then
  begin
    FSingleton := TSingleton.Create;
  end;

  Result := FSingleton;

end;

constructor TSingleton.Create;
begin

  inherited;

  { Initialize }
  FTestValue := 0;

end;

destructor TSingleton.Destroy;
begin

  { Finalize }

  inherited;

end;

initialization
  FSingleton := nil;

finalization
  FSingleton.Free;

end.

Singleton関数を通してグローバルな唯一のインスタンスを取得することができ、必要に応じてコンストラクタを呼び出すことでローカル/一時的なインスタンスを生成することもできます。

次に"本当の"シングルトンを考えてみます。ただしDelphiでは、全てのクラスがpublicなconstructor Create (ja)を持つTObject (ja)から派生しており、かつメンバ関数のスコープを狭めることができないという言語仕様から、C++やJavaのように通常のコンストラクタ呼び出しをコンパイルエラーにすることができません。そこで次善の策としてpublicなコンストラクタを呼び出すと例外がraiseされ、インスタンスの生成に失敗するようにしてみました。

unit Unit6;

interface

uses
  SysUtils;

type
  TSingleton = class(TObject)
  private
    FTestValue: Integer;
    constructor CreateInstance;
  public
    constructor Create;
    destructor  Destroy; override;
    class function GetInstance: TSingleton;
    property    TestValue: Integer
                  read  FTestValue
                  write FTestValue;
  end;

  ECreateSingleton = class(Exception)
  end;


implementation

var
  FSingleton: TSingleton;

{ TSingleton }

constructor TSingleton.Create;
begin

  raise ECreateSingleton.Create('TSingleton.Create cannot use.');

end;

constructor TSingleton.CreateInstance;
begin

  inherited Create;

  { Initialize }
  FTestValue := 0;

end;

destructor TSingleton.Destroy;
begin

  { Finalize }

  inherited;

end;

class function TSingleton.GetInstance: TSingleton;
begin

  if FSingleton = nil then
  begin
    FSingleton := TSingleton.CreateInstance;
  end;

  Result := FSingleton;

end;

initialization
  FSingleton := nil;

finalization
  FSingleton.Free;

end.

TSingleton.GetInstanceを呼び出すことでTSingletonの唯一のインスタンスにアクセスすることができます。

しかしよく指摘されるように、これらの実装には、マルチスレッドになっているプログラム上で別々のスレッドから競合するタイミングでTSingleton.GetInstanceを呼び出すとインスタンスが多重に生成される可能性がある、という問題が存在しています。これを避けるためにCriticalSectionで排他をかけてみます。なおWindows Vista以降ではクリティカルセクション構造体をInitializeCriticalSectionで初期化するとリソースリークし、一方でWindows 2000ではInitializeCriticalSectionで初期化すると残りメモリが逼迫したときにEnterCriticalSectionで例外が発生するという問題があるので、可能であればInitializeCriticalSectionExを、それ以外ではInitializeCriticalSectionAndSpinCount (ja)を呼び出すようにしています。

unit Unit10;

interface

uses
  SysUtils, Windows;

type
  TSingleton = class(TObject)
  private
    FTestValue: Integer;
    constructor CreateInstance;
  public
    constructor Create;
    destructor  Destroy; override;
    class function GetInstance: TSingleton;
    property    TestValue: Integer
                  read  FTestValue
                  write FTestValue;
  end;

  ECreateSingleton = class(Exception)
  end;


implementation

var
  FSingleton: TSingleton;
  FCriticalSection: TRTLCriticalSection;

{ TSingleton }

constructor TSingleton.Create;
begin

  raise ECreateSingleton.Create('TSingleton.Create cannot use.');

end;

constructor TSingleton.CreateInstance;
begin

  inherited Create;

  { Initialize }
  FTestValue := 0;

end;

destructor TSingleton.Destroy;
begin

  { Finalize }

  inherited;

end;

class function TSingleton.GetInstance: TSingleton;
begin

  EnterCriticalSection(FCriticalSection);
  try
    if FSingleton = nil then
    begin
      FSingleton := TSingleton.CreateInstance;
    end;

  finally
    LeaveCriticalSection(FCriticalSection);
  end;

  Result := FSingleton;

end;

type
  TInitializeCriticalSectionExFunc = function(var lpCriticalSection: TRTLCriticalSection;
                                              dwSpinCount: DWORD;
                                              Flags: DWORD): BOOL; stdcall;

const
  CRITICAL_SECTION_NO_DEBUG_INFO = $01000000;

procedure InitializeSingleton;
var
  InitializeCriticalSectionEx: TInitializeCriticalSectionExFunc;
begin

  FSingleton := nil;

  @InitializeCriticalSectionEx := GetProcAddress(GetModuleHandle(kernel32),
                                                 'InitializeCriticalSectionEx');
  if Assigned(InitializeCriticalSectionEx) = True then
  begin
    InitializeCriticalSectionEx(FCriticalSection,0,CRITICAL_SECTION_NO_DEBUG_INFO);
  end
  else
  begin
    InitializeCriticalSectionAndSpinCount(FCriticalSection,0);
  end;

end;

initialization
  InitializeSingleton;

finalization
  DeleteCriticalSection(FCriticalSection);
  FSingleton.Free;

end.

上記の例と同様にTSingleton.GetInstanceでTSingletonの唯一のインスタンスにアクセスすることができますが、GetInstanceを呼び出す毎にEnterCriticalSection/LeaveCriticalSectionするため、一旦インスタンスが生成された後でも本質的に必要のないオーバヘッドが存在しています。

排他処理のコストを無視することができない場合は、通常のシングルトンパターンの実装の長所の一つである"インスタンスの生成を必要になるまで遅延する"を捨てて、インスタンスをアプリケーションの初期化時に生成してしまう、という方法もあります。

unit Unit14;

interface

uses
  SysUtils;

type
  TSingleton = class(TObject)
  private
    FTestValue: Integer;
    constructor CreateInstance;
  public
    constructor Create;
    destructor  Destroy; override;
    class function GetInstance: TSingleton;
    property    TestValue: Integer
                  read  FTestValue
                  write FTestValue;
  end;

  ECreateSingleton = class(Exception)
  end;


implementation

var
  FSingleton: TSingleton;

{ TSingleton }

constructor TSingleton.Create;
begin

  raise ECreateSingleton.Create('TSingleton.Create cannot use.');

end;

constructor TSingleton.CreateInstance;
begin

  inherited Create;

  { Initialize }
  FTestValue := 0;

end;

destructor TSingleton.Destroy;
begin

  { Finalize }

  inherited;

end;

class function TSingleton.GetInstance: TSingleton;
begin

  Result := FSingleton;

end;

initialization
  FSingleton := TSingleton.CreateInstance;

finalization
  FSingleton.Free;

end.

現実のアプリケーションでは常にトレードオフが存在しますので、必要に応じてこれらのいずれかの(あるいはこれ以外でも)実装を選択する、ということになります。なお"これらのシングルトンに必要な実装を行った基底クラス"と"実際に使用するシングルトンの派生クラス"、というアプローチは(個人的には)いろんな意味で望ましいとは思えません。

元ねたはオブジェクト指向における再利用のためのデザインパターン(改訂版) (amazon) (Erich Gamma、Richard Helm、Ralph Johnson、John M. Vlissides著/本位田 真一、吉田 和樹監訳/ソフトバンククリエイティブ/ISBN4-7973-1112-6(ISBN978-4797311129)/5,040円)とHead Firstデザインパターン (amazon) (Eric Freeman、Elisabeth Freeman、Kathy Sierra、Bert Bates著/木下 哲也、有限会社 福龍興業訳/佐藤 直生監訳/ISBN4-87311-249-4/4,830円)。