[ACCEPTED]-Delphi Singleton Pattern-design-patterns

I think if I wanted an object-like thing that 13 didn't have any means of being constructed 12 I'd probably use an interface with the implementing 11 object contained in the implementation section 10 of a unit.

I'd expose the interface by a 9 global function (declared in the interface 8 section). The instance would be tidied up 7 in a finalization section.

To get thread-safety 6 I'd use either a critical section (or equivalent) or 5 possibly carefully implemented double-checked 4 locking but recognising that naive implementations 3 only work due to the strong nature of the 2 x86 memory model.

It would look something 1 like this:

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.

It was mentioned that i should post my answer 14 from over here.

There is a technique called "Lock-free initialization" that 13 does what you want:

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;

The use of InterlockedCompareExchangePointer erects a 12 full memory barrier around the operation. It 11 is possible one might be able to get away 10 with InterlockedCompareExchangePointerAcquire or InterlockedCompareExchangeRelease to get away with an optimization 9 by only having a memory fence before or 8 after. The problem with that is:

• i'm not smart enough to know if Acquire or Release semantics will work
• you're constructing an object, the memory barrier performance hit is the least of your worries (it's the thread safety)

InterlockedCompareExchangePointer

Windows 7 didn't add InterlockedCompareExchangePointer until sometime around 2003. In 6 reality it is simply a wrapper around 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;

In 5 XE6, i find InterlockedcompareExchangePointer implemented for 32-bit in Windows.Winapi implemented 4 the same way (except for the safety checking):

{$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}

In 3 newer versions of Delphi you would, ideally, use 2 the TInterlocked helper class from System.SyncObjs:

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;

Note: Any code released 1 into public domain. No attribution required.

The trouble with Delphi is that you always 29 inherit the Create constructor from TObject. But we can 28 deal with that pretty nicely! Here's a way:

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

  class function Single: TTrueSingleton;
end;

As 27 you can see we can have a private constructor 26 and we can hide the inherited TObject.Create constructor! In 25 the implementation of TTrueSingleton.Create you can raise an 24 error (run-time block) and the deprecated keyword 23 has the added benefit of providing compile-time 22 error handling!

Here's the implementation 21 part:

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;

If at compile time the compiler sees 20 you doing this:

var X: TTrueSingleton := TTrueSingleton.Create;

it will give you the deprecated warning 19 complete with the provided error message. If 18 you're stubborn enough to ignore it, at 17 run time, you'll not get an object but a 16 raised exception.

Later edit to introduce thread-safety. First 15 of all I must confess, for my own code I 14 don't care about this kind of thread-safety. The 13 probability for two threads accessing my 12 singleton creator routine within such a 11 short time frame it causes two TTrueSingleton objects 10 to be created is so small it's simply not 9 worth the few lines of code required.

But 8 this answer wouldn't be complete without 7 thread safety, so here's my take on the 6 issue. I'll use a simple spin-lock (busy waiting) because 5 it's efficient when no locking needs to 4 be done; Besides, it only locks ones

For this 3 to work an other class var needs to be added: class var FLock: Integer. The 2 Singleton class function should look like 1 this:

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;

There is a way to hide the inherited “Create” constructor 8 of TObject. Although it is not possible 7 to change the access level, it can be hidden 6 with another public parameterless method 5 with the same name: “Create”. This simplifies 4 the implementation of the Singleton class 3 tremendously. See the simplicity of the 2 code:

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.

I added the details to my original 1 post: http://www.yanniel.info/2010/10/singleton-pattern-delphi.html

The most effective way to make sure something 46 cannot be instantiated is by making it a 45 pure abstract class. That is, if you care 44 enough to heed compiler hints and warnings.

Then 43 define a function in the implementation 42 section that returns a reference to that 41 abstract class. Like Cosmin does in one 40 of his answers.

The implementation section 39 implements that function (you can even make 38 use of lazy instantiation here, as Cosmin 37 also shows/ed).

But the crux is to have a 36 concrete class declared and implemented 35 in the implementation section of the unit so only the 34 unit can instantiated it.

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;

That said, please 33 bear in mind that there are plenty of problems 32 using singletons: http://jalf.dk/blog/2010/03/singletons-solving-problems-you-didnt-know-you-never-had-since-1995/

Thread safety

David is absolutely right 31 in his comment that I was wrong before about 30 the function not needing any protection. The 29 instantiation does indeed need protecting or 28 you could end up with two (possibly more) instances 27 of the singleton and several of them in 26 limbo with regard to freeing (which would 25 be done in the finalization section as with 24 many lazy instantion mechanisms). So here 23 is the amended version.

To get thread safety 22 in this setup, you need to protect the instantiation 21 of the singleton and you need to protect 20 all methods in the concrete class that are 19 publicly available through its abstract 18 ancestor. Other methods do not need to be 17 protected as they are only be callable through 16 the publicly available ones and so are protected 15 by the protection in those methods.

You can 14 protect this by a simple critical section, declared 13 in the implementation, instantiated in the 12 initialization and free in the finalization 11 section. Of course the CS would have to 10 protect the freeing of the singleton as 9 well and should therefore be freed afterwards.

Discussing 8 this with a colleague, we came up with a 7 way to (mis)/(ab)use the instance pointer 6 itself as a sort of lock mechanism. It would 5 work, but I find it to ugly to share with 4 the world at this point in time...

What synchronisation 3 primitives are used to protect the publicly 2 callable methods is entirely up to the "user" (coder) and 1 may tailored to the purpose the singleton.

For threadsafety you should use a lock around 4 the create in "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;

Threadsafe:

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

And 3 you could raise an exception in case someone 2 tries to create it via the normal .Create 1 (make a private constructor CreateSingleton)