德尔福Singleton模式

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

有人提到我应该从这里发布我的答案.

有一种称为"无锁初始化"的技术可以满足您的需求:

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 InterlockedCompareExchangePointer直到2003年左右才添加.实际上它只是一个包装器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中,我发现InterlockedcompareExchangePointer在Windows中实现了32位.Winapi以相同的方式实现(安全检查除外):

{$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对象被创建的概率是如此之小,根本不值得所需的几行代码.

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

为此,需要添加其他类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

为了线程安全，您应该在“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），您可以引发异常