まず前回の"Phoenix Singleton"ですが、デストラクタを呼び出すことでインスタンスが完全に解放されてしまうため、次回のアクセスで新しいインスタンスが生成されてもその内容は初期状態に戻ってしまいます。そこで"予備"のインスタンスを用意しておき、ここに内容を退避して再生成時に復元します。まずinitialization/finalization版から。
unit Unit32; interface uses SysUtils; type TSingleton = class(TObject) private FTestValue: Integer; constructor CreateInstance; public constructor Create; destructor Destroy; override; procedure Assign(Source: TSingleton); class function GetInstance: TSingleton; property TestValue: Integer read FTestValue write FTestValue; end; ECreateSingleton = class(Exception) end; implementation var FSingleton: TSingleton; FShadowSingleton: 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 { Shadowing } if FShadowSingleton = nil then begin FShadowSingleton := TSingleton.CreateInstance; end; if FShadowSingleton <> Self then begin FShadowSingleton.Assign(Self); { Delete singleton reference } FSingleton := nil; end; { Finalize } inherited; end; procedure TSingleton.Assign(Source: TSingleton); begin { Copy from source } TestValue := Source.TestValue; end; class function TSingleton.GetInstance: TSingleton; begin if FSingleton = nil then begin FSingleton := TSingleton.CreateInstance; if FShadowSingleton <> nil then begin FSingleton.Assign(FShadowSingleton); end; end; Result := FSingleton; end; initialization FSingleton := nil; FShadowSingleton := nil; finalization FSingleton.Free; FShadowSingleton.Free; end.
次にclass constructor/class destructor版です。
unit Unit34; interface uses SysUtils; type TSingleton = class(TObject) private FTestValue: Integer; class var FSingleton: TSingleton; FShadowSingleton: TSingleton; constructor CreateInstance; public class constructor Create; class destructor Destroy; constructor Create; destructor Destroy; override; procedure Assign(Source: TSingleton); 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; FShadowSingleton := nil; end; class destructor TSingleton.Destroy; begin FSingleton.Free; FShadowSingleton.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 { Shadowing } if FShadowSingleton = nil then begin FShadowSingleton := TSingleton.CreateInstance; end; if FShadowSingleton <> Self then begin FShadowSingleton.Assign(Self); { Delete singleton reference } FSingleton := nil; end; { Finalize } inherited; end; procedure TSingleton.Assign(Source: TSingleton); begin { Copy from source } TestValue := Source.TestValue; end; class function TSingleton.GetInstance: TSingleton; begin if FSingleton = nil then begin FSingleton := TSingleton.CreateInstance; if FShadowSingleton <> nil then begin FSingleton.Assign(FShadowSingleton); end; end; Result := FSingleton; end; end.
いずれもシングルトンの内容の退避、復帰のためにインスタンスの内容をコピーするprocedure Assignというメソッドを用意し、これをコンストラクタ、デストラクタで使用します。なおシングルトンが別のクラスのインスタンスを所有するような場合、Assignはいわゆる"deep copy"の動作を実装する必要があります。またpublicなconstructor Createについてはとりあえず従来どおりの例外送出のままとしてあります。
次にコンストラクタ、デストラクタでの例外の送出、というアプローチですが、これは前述のとおりテストレベルでの問題コードの検出、修正を目的としています。しかしこの方法には問題コードが実行されない限り意味をもたない(コンパイル時には検出できない)、という欠点もあります。そこで例外の送出ではなく、constructor Create、destructor Destory、そして再定義したprocedure Freeに(少々目的は異なるものの)ヒント指令のdeprecatedを指定しておき、これらを呼び出しているコードをコンパイル時に警告されるようにする、という解決策を考えてみます。まずinitialization/finalization版から。
unit Unit28; interface uses SysUtils; type TSingleton = class(TObject) private FTestValue: Integer; constructor CreateInstance; destructor DestroyInstance; public constructor Create; deprecated {$IFDEF CONDITIONALEXPRESSIONS}{$IF CompilerVersion >= 20.00} 'Do not use TSingleton.Create.' {$IFEND}{$ENDIF}; destructor Destroy; override; deprecated {$IFDEF CONDITIONALEXPRESSIONS}{$IF CompilerVersion >= 20.00} 'Do not use TSingleton.Destory.' {$IFEND}{$ENDIF}; procedure Free; deprecated {$IFDEF CONDITIONALEXPRESSIONS}{$IF CompilerVersion >= 20.00} 'Do not use TSingleton.Free.' {$IFEND}{$ENDIF}; class function GetInstance: TSingleton; property TestValue: Integer read FTestValue write FTestValue; end; implementation var FSingleton: TSingleton; { TSingleton } constructor TSingleton.Create; begin { Place holder, do not use } end; destructor TSingleton.Destroy; begin { Place holder, do not use } end; constructor TSingleton.CreateInstance; begin inherited Create; { Initialize } FTestValue := 0; end; destructor TSingleton.DestroyInstance; begin { Finalize } inherited Destroy; end; procedure TSingleton.Free; begin { Place holder, do not use } end; class function TSingleton.GetInstance: TSingleton; begin if FSingleton = nil then begin FSingleton := TSingleton.CreateInstance; end; Result := FSingleton; end; initialization FSingleton := nil; finalization if FSingleton <> nil then begin FSingleton.DestroyInstance; end; end.
Delphi 2009以降({$IFDEF CONDITIONALEXPRESSIONS}{$IF CompilerVersion >= 20.00}で判定)ではdeprecatedに追加のメッセージを指定しています。
次にclass constructor/class destructor版です。
unit Unit30; interface uses SysUtils; type TSingleton = class(TObject) private FTestValue: Integer; class var FSingleton: TSingleton; constructor CreateInstance; destructor DestroyInstance; public class constructor Create; class destructor Destroy; constructor Create; deprecated 'Do not use TSingleton.Create.'; destructor Destroy; override; deprecated 'Do not use TSingleton.Destory.'; procedure Free; deprecated 'Do not use TSingleton.Free.'; class function GetInstance: TSingleton; property TestValue: Integer read FTestValue write FTestValue; end; implementation { TSingleton } class constructor TSingleton.Create; begin FSingleton := nil; end; class destructor TSingleton.Destroy; begin if FSingleton <> nil then begin FSingleton.DestroyInstance; end; end; constructor TSingleton.Create; begin { Place holder, do not use } end; destructor TSingleton.Destroy; begin { Place holder, do not use } end; constructor TSingleton.CreateInstance; begin inherited Create; { Initialize } FTestValue := 0; end; destructor TSingleton.DestroyInstance; begin { Finalize } inherited Destroy; end; procedure TSingleton.Free; begin { Place holder, do not use } end; class function TSingleton.GetInstance: TSingleton; begin if FSingleton = nil then begin FSingleton := TSingleton.CreateInstance; end; Result := FSingleton; end; end.
どちらもDelphi 2009以降であれば"プロジェクトオプション"の"Delphiコンパイラ"の"ヒントと警告"で"使用を推奨されていないシンボル"をエラーにするか、シングルトンを使用している側のユニットに
{$WARN SYMBOL_DEPRECATED ERROR}
を指定することでconstructor Create、destructor Destory、procedure Freeの呼び出しをエラーにすることができます(通常は警告)。
0 件のコメント:
コメントを投稿