Delphiシングルトンパターン

Question

私はこれがコミュニティの至る所で何度も議論されていることを知っていますが、Delphiでシングルトンパターンの素晴らしくて単純な実装を見つけることができません。 C＃に例があります：

public sealed class Singleton {
  // Private Constructor
  Singleton( ) { }

  // Private object instantiated with private constructor
  static readonly Singleton instance = new Singleton( );

  // Public static property to get the object
  public static Singleton UniqueInstance {
    get { return instance;}
}

Delphiにはこれほど洗練されたソリューションがないことを私は知っており、Delphiでコンストラクタを正しく非表示（プライベートにする）できないことについて多くの議論を見たので、NewInstanceメソッドとFreeInstranceメソッドをオーバーライドする必要があります。私が信じているそれらの線に沿った何かは、私が見つけた実装です http://ibeblog.com/?p=65 ：

type
TTestClass = class
private
  class var FInstance: TTestClass;
public                              
  class function GetInstance: TTestClass;
  class destructor DestroyClass;
end;

{ TTestClass }
class destructor TTestClass.DestroyClass;
begin
  if Assigned(FInstance) then
  FInstance.Free;
end;

class function TTestClass.GetInstance: TTestClass;
begin
  if not Assigned(FInstance) then
  FInstance := TTestClass.Create;
  Result := FInstance;
end;

シングルトンパターンに関するあなたの提案は何ですか？シンプルでエレガント、そしてスレッドセーフでしょうか？

ありがとうございました。

Answer 1

thingのように、構築する手段がないオブジェクトが必要な場合は、ユニットの実装セクションに含まれている実装オブジェクトとのインターフェイスを使用すると思います。

グローバル関数（インターフェイスセクションで宣言）によってインターフェイスを公開します。インスタンスは、ファイナライズセクションで整理されます。

スレッドセーフを取得するには、クリティカルセクション（または同等のもの）または慎重に実装されたダブルチェックロックを使用しますが、ナイーブな実装はx86メモリモデルの強力な性質のためにのみ機能することを認識しています。

次のようになります。

unit uSingleton;

interface

uses
  SyncObjs;

type
  ISingleton = interface
    procedure DoStuff;
  end;

function Singleton: ISingleton;

implementation

type
  TSingleton = class(TInterfacedObject, ISingleton)
  private
    procedure DoStuff;
  end;

{ TSingleton }

procedure TSingleton.DoStuff;
begin
end;

var
  Lock: TCriticalSection;
  _Singleton: ISingleton;

function Singleton: ISingleton;
begin
  Lock.Acquire;
  Try
    if not Assigned(_Singleton) then
      _Singleton := TSingleton.Create;
    Result := _Singleton;
  Finally
    Lock.Release;
  End;
end;

initialization
  Lock := TCriticalSection.Create;

finalization
  Lock.Free;

end.

Answer 2

私は上から私の答えを投稿する必要があると言われました ここ 。

"ロックフリー初期化" と呼ばれるテクニックがあります。これはあなたが望むことをします：

interface

function getInstance: TObject;

implementation

var
   AObject: TObject;

function getInstance: TObject;
var
   newObject: TObject;
begin
   if (AObject = nil) then
   begin
      //The object doesn't exist yet. Create one.
      newObject := TObject.Create;

      //It's possible another thread also created one.
      //Only one of us will be able to set the AObject singleton variable
      if InterlockedCompareExchangePointer(AObject, newObject, nil) <> nil then
      begin
         //The other beat us. Destroy our newly created object and use theirs.
         newObject.Free;
      end;
   end;

   Result := AObject;
end;

InterlockedCompareExchangePointerを使用すると、操作の周囲に完全なメモリバリアが構築されます。 InterlockedCompareExchangePointerAcquireまたはInterlockedCompareExchangeReleaseを使用して、前または後にメモリフェンスを設定するだけで、最適化を回避できる可能性があります。それに関する問題は次のとおりです。

• AcquireまたはReleaseセマンティクスがそうなるかどうかを知るのに十分賢くない作業
• オブジェクトを構築している場合、メモリバリアのパフォーマンスへの影響は、最も心配する必要はありません（スレッドセーフです）。

InterlockedCompareExchangePointer

Windowsは2003年頃まで InterlockedCompareExchangePointer を追加しませんでした。実際には、それは単にラッパーです InterlockedCompareExchange

function InterlockedCompareExchangePointer(var Destination: Pointer; Exchange: Pointer; Comparand: Pointer): Pointer stdcall;
const
    SPointerAlignmentError = 'Parameter to InterlockedCompareExchangePointer is not 32-bit aligned';
begin
{IFDEF Debug}
    //On 64-bit systems, the pointer must be aligned to 64-bit boundaries.
    //On 32-bit systems, the pointer must be aligned to 32-bit boundaries.
    if ((NativeInt(Destination) mod 4) <> 0)
            or ((NativeInt(Exchange) mod 4) <> 0)
            or ((NativeInt(Comparand) mod 4) <> 0) then
    begin
        OutputDebugString(SPointerAlignmentError);
        if IsDebuggerPresent then
            Windows.DebugBreak;
    end;
{ENDIF}
    Result := Pointer(IntPtr(InterlockedCompareExchange(Integer(IntPtr(Destination)), IntPtr(Exchange), IntPtr(Comparand))));
end;

XE6では、Windows.Winapiで32ビット用に実装されたInterlockedcompareExchangePointerが同じ方法で実装されていることがわかります（安全性チェックを除く）。

{$IFDEF WIN32}
function InterlockedCompareExchangePointer(var Destination: Pointer; Exchange: Pointer; Comparand: Pointer): Pointer; inline;
begin
  Result := Pointer(IntPtr(InterlockedCompareExchange(Integer(IntPtr(Destination)), IntPtr(Exchange), IntPtr(Comparand))));
end;
{$ENDIF}

Delphiの新しいバージョンでは、理想的には、System.SyncObjsのTInterlockedヘルパークラスを使用します。

if TInterlocked.CompareExchange({var}AObject, newObject, nil) <> nil then
begin
   //The other beat us. Destroy our newly created object and use theirs.
   newObject.Free;
end;

注：パブリックドメインにリリースされたコード。帰属は必要ありません。

Answer 3

Delphiの問題は、常にCreateコンストラクタをTObjectから継承することです。しかし、私たちはそれをかなりうまく処理することができます！方法は次のとおりです。

TTrueSingleton = class
private
  class var FSingle: TTrueSingleton;
  constructor MakeSingleton;
public
  constructor Create;reintroduce;deprecated 'Don''t use this!';

  class function Single: TTrueSingleton;
end;

ご覧のとおり、プライベートコンストラクターを作成し、継承されたTObject.Createコンストラクターを非表示にすることができます。 TTrueSingleton.Createの実装では、エラー（ランタイムブロック）を発生させることができ、deprecatedキーワードには、コンパイル時のエラー処理を提供するという追加の利点があります。

実装部分は次のとおりです。

constructor TTrueSingleton.Create;
begin
  raise Exception.Create('Don''t call me directly!');
end;

constructor TTrueSingleton.MakeSingleton;
begin
end;

class function TTrueSingleton.Single: TTrueSingleton;
begin
  if not Assigned(FSingle) then FSingle := TTrueSingleton.MakeSingleton;
  Result := FSingle;
end;

コンパイル時にコンパイラがこれを実行していることを確認した場合：

var X: TTrueSingleton := TTrueSingleton.Create;

提供されたエラーメッセージとともにdeprecated警告が表示されます。それを無視するほど頑固な場合、実行時に、オブジェクトは取得されませんが、発生した例外が発生します。

---

後の編集スレッドセーフを導入します。まず第一に、私は告白しなければなりません。私自身のコードでは、この種のスレッドセーフは気にしません。 2つのスレッドがこのような短い時間枠内にシングルトンクリエータールーチンにアクセスして2つのTTrueSingletonオブジェクトが作成される確率は非常に小さいため、必要な数行のコードの価値はありません。

しかし、この答えはスレッドセーフなしでは完全ではないので、これがこの問題に対する私の見解です。ロックを行う必要がない場合に効率的であるため、単純なspin-lock（ビジー待機）を使用します。その上、それはonesだけをロックします

これを機能させるには、他のクラス変数を追加する必要があります：class var FLock: Integer。シングルトンクラス関数は次のようになります。

class function TTrueSingleton.Single: TTrueSingleton;
var Tmp: TTrueSingleton;
begin
  MemoryBarrier; // Make sure all CPU caches are in sync
  if not Assigned(FSingle) then
  begin
    Assert(NativeUInt(@FLock) mod 4 = 0, 'FLock needs to be alligned to 32 bits.');

    // Busy-wait lock: Not a big problem for a singleton implementation
    repeat
    until InterlockedCompareExchange(FLock, 1, 0) = 0; // if FLock=0 then FLock:=1;
    try
      if not Assigned(FSingle) then
      begin 
        Tmp := TTrueSingleton.MakeSingleton;
        MemoryBarrier; // Second barrier, make sure all CPU caches are in sync.
        FSingle := Tmp; // Make sure the object is fully created when we assign it to FSingle.
      end;
    finally FLock := 0; // Release lock
    end;
  end;
  Result := FSingle;
end;

Answer 4

TObjectの継承された「Create」コンストラクターを非表示にする方法があります。アクセスレベルを変更することはできませんが、同じ名前の別のパブリックパラメータレスメソッド「Create」で非表示にすることができます。これにより、シングルトンクラスの実装が大幅に簡素化されます。コードの単純さを参照してください。

unit Singleton;

interface

type
  TSingleton = class
  private
    class var _instance: TSingleton;
  public
    //Global point of access to the unique instance
    class function Create: TSingleton;

    destructor Destroy; override;
  end;

implementation

{ TSingleton }

class function TSingleton.Create: TSingleton;
begin
  if (_instance = nil) then
    _instance:= inherited Create as Self;

  result:= _instance;
end;

destructor TSingleton.Destroy;
begin
  _instance:= nil;
  inherited;
end;

end.

元の投稿に詳細を追加しました： http://www.yanniel.info/2010/10/singleton-pattern-delphi.html

Answer 5

何かをインスタンス化できないようにする最も効果的な方法は、それを純粋な抽象クラスにすることです。つまり、コンパイラのヒントと警告に十分注意する必要がある場合です。

次に、その抽象クラスへの参照を返す関数を実装セクションで定義します。コスミンが彼の答えの1つで行うように。

実装セクションはその関数を実装します（Cosminも示しているように、ここでレイジーインスタンス化を利用することもできます）。

ただし、重要なのは、ユニットのimplementationセクションで具体的なクラスを宣言して実装し、ユニットだけがインスタンス化できるようにすることです。

interface

type
  TSingleton = class(TObject)
  public
    procedure SomeMethod; virtual; abstract;
  end;

  function Singleton: TSingleton;

implementation

var
  _InstanceLock: TCriticalSection;
  _SingletonInstance: TSingleTon;

type
  TConcreteSingleton = class(TSingleton)
  public
    procedure SomeMethod; override;
  end;

function Singleton: TSingleton;
begin
  _InstanceLock.Enter;
  try
    if not Assigned(_SingletonInstance) then
      _SingletonInstance := TConcreteSingleton.Create;

    Result := _SingletonInstance;
  finally
    _InstanceLock.Leave;
  end;
end;

procedure TConcreteSingleton.SomeMethod;
begin
  // FLock can be any synchronisation primitive you like and should of course be
  // instantiated in TConcreteSingleton's constructor and freed in its destructor.
  FLock.Enter;  
  try
  finally
    FLock.Leave;
  end;
end;

とはいえ、シングルトンの使用には多くの問題があることに注意してください： http://jalf.dk/blog/2010/03/singletons-solving-problems-you-didnt-know-you-never- had-since-1995 /

スレッドセーフ

デビッドは、保護を必要としない関数について以前は間違っていたという彼のコメントで絶対に正しいです。インスタンス化does確かに保護する必要があります。そうしないと、シングルトンの2つの（場合によってはそれ以上の）インスタンスが発生し、解放に関していくつかのインスタンスが不安定になる可能性があります（これは、多くの場合と同様に、ファイナライズセクションで行われます。怠惰なインスタンス化メカニズム）。だからここに修正されたバージョンがあります。

この設定でスレッドセーフを取得するには、シングルトンのインスタンス化を保護する必要があり、その抽象的な祖先を通じて公開されている具象クラスのすべてのメソッドを保護する必要があります。他のメソッドは、公開されているメソッドを介してのみ呼び出すことができ、それらのメソッドの保護によって保護されるため、保護する必要はありません。

これは、実装で宣言され、初期化でインスタンス化され、ファイナライズセクションで解放される単純なクリティカルセクションによって保護できます。もちろん、CSはシングルトンの解放も保護する必要があるため、後で解放する必要があります。

これについて同僚と話し合って、インスタンスポインタ自体を一種のロックメカニズムとして（誤）/（乱用）使用する方法を考え出しました。それはうまくいくでしょうが、現時点で世界と共有するのは醜いです...

公的に呼び出し可能なメソッドを保護するために使用される同期プリミティブは、完全に「ユーザー」（コーダー）次第であり、シングルトンの目的に合わせて調整できます。

Answer 6

スレッドセーフのために、「TTestClass.GetInstance」の作成の周りにロックを使用する必要があります。

procedure CreateSingleInstance(aDestination: PPointer; aClass: TClass);
begin
  System.TMonitor.Enter(Forms.Application);
  try
    if aDestination^ = nil then  //not created in the meantime?
      aDestination^ := aClass.Create;
  finally
    System.TMonitor.Exit(Forms.Application);
  end;
end;

スレッドセーフ：

if not Assigned(FInstance) then
  CreateSingleInstance(@FInstance, TTestClass);      

また、誰かが通常の.Createを介して例外を作成しようとした場合に例外を発生させることができます（プライベートコンストラクターCreateSingletonを作成します）