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;

关于Singleton模式，您有什么建议？它可以简单，优雅，线程安全吗？

谢谢。

Answer 1

我认为如果我想要一个没有任何构造方法的类似对象的的东西，我可能会使用一个接口与一个单元的实现部分中包含的实现对象。

我通过全局函数公开接口（在接口部分声明）。该实例将在最终部分进行整理。

为了获得线程安全性我会使用一个关键部分（或等效的）或者可能仔细实现的双重检查锁定，但是认识到天真的实现只能起作用，因为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

有人提到我应该从here发表我的答案。

有一种名为"Lock-free initialization"的技术能够满足您的需求：

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来逃避优化，只需在之前或之后设置内存栅栏即可。问题是：

我不够聪明，不知道获取或发布语义是否有效
你正在构建一个对象，内存屏障性能受到的打击最少（这是线程安全）

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警告，并提供错误消息。如果你足够顽固地忽略它，那么在运行时你就不会得到一个对象而是一个被引发的异常。

稍后修改以引入线程安全性。首先，我必须承认，对于我自己的代码，我并不关心这种线程安全性。两个线程在如此短的时间内访问我的单例创建器例程导致创建两个TTrueSingleton对象的概率非常小，根本不值得几行代码。

但如果没有线程安全，这个答案就不会完整，所以这是我对这个问题的看法。我将使用一个简单的自旋锁（忙等待），因为当不需要锁定时它是有效的;此外，它只锁定 1

为此，需要添加其他类var：class var FLock: Integer。 Singleton类函数应如下所示：

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

确保某些内容无法实例化的最有效方法是将其设为纯抽象类。也就是说，如果你足够关注编译提示和警告。

然后在实现部分中定义一个函数，该函数返回对该抽象类的引用。就像Cosmin在他的一个答案中做的那样。

实现部分实现了该功能（你甚至可以在这里使用延迟实例化，因为Cosmin也显示/ ed）。

但关键是要在单元的实现部分声明并实现一个具体的类，这样只有单元才能实例化它。

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/

线程安全

大卫在他的评论中完全正确，我之前对于不需要任何保护的功能我是错的。实例化确实确实需要保护，或者你可能最终得到两个（可能更多）单例实例，其中几个实例在释放方面处于不确定状态（这将在最终部分中完成，就像许多实例一样）懒惰的机制）。所以这是修正版。

要在此设置中获得线程安全性，您需要保护单例的实例化，并且需要保护具体类中通过其抽象祖先公开可用的所有方法。其他方法不需要保护，因为它们只能通过公开的方法调用，因此受到这些方法中的保护。

您可以通过在实现中声明的简单临界区来保护它，在初始化中实例化并在终结部分中自由。当然CS也必须保护单身人士的释放，因此应该在之后被释放。

与同事讨论这个问题，我们提出了一种方法（错误）/（ab）使用实例指针本身作为一种锁机制。它会起作用，但我发现此时与世界分享是丑陋的......

使用哪些同步原语来保护可公开调用的方法完全取决于“用户”（编码器），并且可以根据单身人士的目的进行调整。

Answer 5

有一种方法可以隐藏TObject的继承“Create”构造函数。虽然无法更改访问级别，但可以使用另一个具有相同名称的公共无参数方法隐藏它：“创建”。这极大地简化了Singleton类的实现。请参阅代码的简单性：

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 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）来创建异常，你可以引发异常

德尔福Singleton模式

6 个答案:

InterlockedCompareExchangePointer