DelphiでSingletonパターンを実装する(再考)

初回のアーティクルにシングルトンのインスタンスは外部から破棄可能だけどいいの？(意訳)というご意見を高橋さんから頂きました。確かにどの実装も、取得したインスタンスに対してFree(あるいはDestroy)を行うことで解放できてしまいます。

シングルトンに求められる条件を考えれば、インスタンスを破棄された後でアクセスされたときはインスタンスを再度生成する("Phoenix Singleton")か、外部からは破棄できないようにするか、いずれかが望ましいと考えられます。

まず再生成する場合です。こちらはインスタンスの破棄時にインスタンスへの参照を初期化することで、次回参照時にインスタンスを再度生成します。initialization/finalization版から。

unit Unit20;

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

  { Delete singleton reference }
  FSingleton := nil;

  { 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.

再生成する場合のclass constructor/class destructor版です。

unit Unit22;

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

  { Delete singleton reference }
  FSingleton := nil;

  { Finalize }

  inherited;

end;

class function TSingleton.GetInstance: TSingleton;
begin

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

  Result := FSingleton;

end;

end.

次に外部からの破棄を禁止する場合です。destructor Destroy (ja)もconstructor Create (ja)と同様にTObjectでpublicとされていてスコープを狭化できないため、例外を送出することでインスタンスの破棄をブロックしています(コンストラクタと違いドキュメントなどで明示されていませんが、逆アセンブル表示で見る限りデストラクタもまた例外の送出で処理をブロックできると考えます)。ただし通常のコンストラクタ呼び出しからデストラクタが呼ばれる場合と、終了時にデストラクタが呼ばれる場合はフラグで区別して通常の処理を行います。
こちらもinitialization/finalization版から。

unit Unit24;

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;

  EDestroySingleton = class(Exception)
  end;


implementation

var
  FSingleton: TSingleton;
  FInternalDestroy: Boolean;

{ TSingleton }

constructor TSingleton.Create;
begin

  FInternalDestroy := True;
  raise ECreateSingleton.Create('TSingleton.Create cannot use.');

end;

constructor TSingleton.CreateInstance;
begin

  inherited Create;

  { Initialize }
  FTestValue := 0;

end;

destructor TSingleton.Destroy;
begin

  if FInternalDestroy = False then
  begin
    raise EDestroySingleton.Create('TSingleton.Destroy cannnot use.');
  end;
  FInternalDestroy := False;

  { 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
  FInternalDestroy := True;
  FSingleton.Free;

end.

最後に外部から破棄を禁止する場合のclass constructor/class destructor版です。

unit Unit26;

interface

uses
  SysUtils;

type
  TSingleton = class(TObject)
  private
    FTestValue: Integer;
    class var
      FSingleton: TSingleton;
      FInternalDestroy: Boolean;
    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;

  EDestroySingleton = class(Exception)
  end;


implementation

{ TSingleton }

class constructor TSingleton.Create;
begin

  FSingleton := nil;

end;

class destructor TSingleton.Destroy;
begin

  FInternalDestroy := True;
  FSingleton.Free;

end;

constructor TSingleton.Create;
begin

  FInternalDestroy := True;
  raise ECreateSingleton.Create('TSingleton.Create cannot use.');

end;

constructor TSingleton.CreateInstance;
begin

  inherited Create;

  { Initialize }
  FTestValue := 0;

end;

destructor TSingleton.Destroy;
begin

  if FInternalDestroy = False then
  begin
    raise EDestroySingleton.Create('TSingleton.Destroy cannnot use.');
  end;
  FInternalDestroy := False;

  { Finalize }

  inherited Destroy;

end;

class function TSingleton.GetInstance: TSingleton;
begin

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

  Result := FSingleton;

end;

end.