Delphi Singleton Pattern [closed]

Question

I know this is discussed many times everywhere i the community but I just can't find a nice and simple implementation of a Singleton Pattern in Delphi. I have an example in 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; }
  }
}

I know there is no solution as elegant as this in Delphi and I saw a lot of discussion about no being able to correctly hide the constructor in Delphi (make it private) so we would need to override the NewInstance and FreeInstance methods. Something along those lines I believe is the implementation I found on ibeblog.com - "Delphi: Singleton Patterns":

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;

What would be your suggestion regarding the Singleton Pattern? Can it be simple and elegant and thread safe?

Thank you.

Answer 1

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

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

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

It would look something 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.

Answer 2

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

There is a technique called "Lock-free initialization" that 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 full memory barrier around the operation. It is possible one might be able to get away with InterlockedCompareExchangePointerAcquire or InterlockedCompareExchangeRelease to get away with an optimization by only having a memory fence before or 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 didn't add InterlockedCompareExchangePointer until sometime around 2003. In 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 XE6, i find InterlockedcompareExchangePointer implemented for 32-bit in Windows.Winapi implemented 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 newer versions of Delphi you would, ideally, use 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 into public domain. No attribution required.

Answer 3

The trouble with Delphi is that you always inherit the Create constructor from TObject. But we can 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 you can see we can have a private constructor and we can hide the inherited TObject.Create constructor! In the implementation of TTrueSingleton.Create you can raise an error (run-time block) and the deprecated keyword has the added benefit of providing compile-time error handling!

Here's the implementation 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 you doing this:

var X: TTrueSingleton := TTrueSingleton.Create;

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

---

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

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

For this to work an other class var needs to be added: class var FLock: Integer. The Singleton class function should look like 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;

Answer 4

There is a way to hide the inherited “Create” constructor of TObject. Although it is not possible to change the access level, it can be hidden with another public parameterless method with the same name: “Create”. This simplifies the implementation of the Singleton class tremendously. See the simplicity of the 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 post: http://www.yanniel.info/2010/10/singleton-pattern-delphi.html