まず前回の"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 件のコメント:
コメントを投稿