DelphiでSingletonパターンを実装する(続き)

前回の実装では基本的にinitialization (ja)/finalization (ja)部でインスタンス変数を処理していましたが、この方法だと(T)Singletonを実際には使用していなくてもDelphiのリンカがそれを認識できず、TSingletonのコードを常にリンク対象としてしまう、という問題点があります(それ以上にあんまりオブジェクト指向っぽくない、という点も…)。そこでinitialization/finalization部の処理をDelphi 2010で導入されたクラスコンストラクタ (ja)/クラスデストラクタ (ja)で置き換えて、必要ないコードのリンクが行われないようにしてみます。

まず"シングルトンもどき"です。

unit Unit4;

interface

type
  TSingleton = class(TObject)
  private
    FTestValue: Integer;
  public
    class constructor Create;
    class destructor  Destroy;
    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;

class constructor TSingleton.Create;
begin

  FSingleton := nil;

end;

class destructor TSingleton.Destroy;
begin

  FSingleton.Free;

end;

constructor TSingleton.Create;
begin

  inherited;

  { Initialize }
  FTestValue := 0;

end;

destructor TSingleton.Destroy;
begin

  { Finalize }

  inherited;

end;

end.

次に"本当の"シングルトンです。

unit Unit8;

interface

uses
  SysUtils;

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

  ECreateSingleton = class(Exception)
  end;


implementation

{ TSingleton }

class constructor TSingleton.Create;
begin

  FSingleton := nil;

end;

class destructor TSingleton.Destroy;
begin

  FSingleton.Free;

end;

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;

end.

CriticalSectionによる排他処理を加えたものです。

unit Unit12;

interface

uses
  SysUtils, Windows;

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

  ECreateSingleton = class(Exception)
  end;


implementation

{ TSingleton }

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

const
  CRITICAL_SECTION_NO_DEBUG_INFO = $01000000;

class constructor TSingleton.Create;
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;

class destructor TSingleton.Destroy;
begin

  DeleteCriticalSection(FCriticalSection);
  FSingleton.Free;

end;

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;

end.

最後に事前初期化版です。

unit Unit16;

interface

uses
  SysUtils, Windows;

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

  ECreateSingleton = class(Exception)
  end;


implementation

{ TSingleton }

class constructor TSingleton.Create;
begin

  FSingleton := TSingleton.CreateInstance;

end;

class destructor TSingleton.Destroy;
begin

  FSingleton.Free;

end;

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;

end.

プロジェクト内でTSingletonを使用していない場合、TSingleton関係のコードがリンクされないことがわかります。