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.

Subbasement

Are you sure that the C# one is thread-safe? It seems different from Mr. Skeet's version? – Alica

Mr Skeet's fourth version is thread safe and looks almost the same, except for a static constructor to enhance 'lazyness' – Therefor

@Therefor If it was me, I would just do whatever the great man says!! – Alica

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.

Alica

+1 Was about to post pretty much that exact code – Bohrer

@Daniel Once you have the idea, there's really only one way to write it!! – Alica

Yep, the interfaced version. But I would not free the lock before freeing the _Singleton. I would enter the lock, free the singleton, the leave and free the lock. – Jaimeejaimes

You're entering the critical section every time you read the value of _Singleton. Is that expense required? – Masaryk

@Cosmin To avoid it you need double-checked locking which is difficult to get right and only works due to x86's memory model being strong. If you can live with the expense (perhaps by caching a copy of the interface) then it makes the code much simpler. – Alica

@Marjan finalization code runs single threaded, so doesn't matter what order you do things. – Alica

@David, why live with that expense when you can be without it? My synchronization avoids the double-lock traps and only locks if the singleton hasn't been initialized, so it can be done. – Masaryk

If you precreate the singleton in Initialization then you don't even need locking – Bohrer

@Daniel Precreation is clearly best if it can be done. However, OP's question clearly suggests lazy initialization. – Alica

@Cosmin That's fine, but if you don't need the complexity, and often you don't, then a simple lock is easy to validate in terms of correctness. I always favour locks if they don't harm performance because it is easy to be sure that they are correct. – Alica

@Cosmin Finally, your code only avoids double-checked locking traps if it runs on a platform with a strong memory model. Fine for x86, but in the future, who knows? – Alica

@David, paying a performance penalty today just in case Delphi starts compiling for non-x86, non-x64 platforms some day, in the (very) distant future, doesn't seem right. Now that Itanium is dead, I don't even know what platform that might be. It'll have to be invented first! And with so many unknowns, I don't think using a TCriticalSection will be enough any way. – Masaryk

@Cosmin Critical section is guaranteed to work. That's part of its contract. Have you read The "Double-Checked Locking is Broken" Declaration? Anyway, the big idea here is to use an interface. The locking/thread-safety implementation can be done many ways. I've illustrated one and proposed another. You have yet another. The main idea is the interface. – Alica

@David: while finalization code may run single threaded, that doesn't necessarily mean all threads have finished... – Jaimeejaimes

@Marjan Every program I know stops all worker threads before running finalization. – Alica

@David: Then you are lucky... :) Callbacks can make life a lot harder... – Jaimeejaimes

@Marjan That's no luck, that's design!! ;-) – Alica

@David: Not always when working with third party components, libraries, WIN API calls and call backs into separate threads. And working under performance constraints to do the minimum locking possible... – Jaimeejaimes

@David: not to mention design decisions from the past coming back to bite you in the behind... ;-) – Jaimeejaimes

@David: That looks a lot like this one: https://mcmap.net/q/581720/-creating-a-singleton-in-delphi-using-the-new-features-of-d2009-and-d2010 – Saul

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.

Pasturage

Nice clean solution. No unneccesary locking or memory barriers if object was created long time ago. Thanks. – Weitzman

Where is InterlockedCompareExchangePointer() declared? – Walrath

@Shannon In newer versions of Delphi it's declared in Windows.Winapi. In Delphi 5 had to write it myself; as a wrapper around InterlockedCompareExchange. Updated answer with version of InterlockedcompareExchange for 32-bit. – Pasturage

This is the coolest approach, IMO. – Overdo

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;

Masaryk

Where's the thread-safety? This is down-vote bait. – Alica

Cardinal(@FLock)?! Surely you mean NativeUInt! – Alica

@David no, why would I? First of all I'll cross the 64 bit bridge when I get there, and on the 64 bit platform I'm not sure I need a 64bit variable for the lock. – Masaryk

@Cosmin, you're casting the pointer, not the value... I'm with David, better if you use NativeUInt, because that's the pointer size. :) – Sophronia

@Sophronia - Wrong, InterlockedCompareExchange compares two 32-bit longs, see the documentation. NativeUInt will work for not but won't compile with 64-bit. – Stylo

@Sertac I'm not talking about FLock type, but about pointer type cast, and @Cosmin already edited the code to change as originally suggested by @David. – Sophronia

Interesting, the documentation link from @Sertac states: To operate on 64-bit values, use the InterlockedCompareExchange64 function., so it must have to be adapted to the win64 bit platform anyway. – Sophronia

@jachugate, don't be sorry, you were right, Sertac's wrong. That Assertion is about checking rather the address of FLock is aligned on 32 bits, has nothing to do with the type of FLock or the Interlocked function to be called. That's why I changed it to NativeUInt! And of course Sertac is right about the InterlockedCompareExchange64, that's what I meant when I said I'll cross the 64 bit bridge when I get there. – Masaryk

See also `InterlockedCompareExchangePointer, which is 64/32 bits as appropriate, and required 8-byte/4-byte alignment as appropriate. – Pasturage

@CosminPrund. This is a good solution. But with the interfaces being here, I think David's solution trumps it. I wish I had thought of it in 2000. – Departure

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

Camacho

Answer 5

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

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

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

But the crux is to have a concrete class declared and implemented in the implementation section of the unit so only the 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 bear in mind that there are plenty of problems 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 in his comment that I was wrong before about the function not needing any protection. The instantiation does indeed need protecting or you could end up with two (possibly more) instances of the singleton and several of them in limbo with regard to freeing (which would be done in the finalization section as with many lazy instantion mechanisms). So here is the amended version.

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

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

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

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

Jaimeejaimes

I'm not seeing any thread-safety. – Alica

@Marjan Venema, I deleted both my answers when I realized the OP isn't looking for examples of singleton implementations (mrr, need to read questions twice before answering); The OP apparently wants a way of handling the inability to hide TObject.Create. At least that's how I understand this: "I saw a lot of discussion about no being able to correctly hide the constructor". Besides the OP is actually providing an example of singleton implementation in the question! – Masaryk

@David: Because that would have to be in the concrete class's implementation of its methods, at least the ones that can be used from the outside through its abstract ancestor. It's no use putting any synchronisation primitives in the implementation of the function returning the instance, as that would only protect getting the reference, nothing else. – Jaimeejaimes

@marjan No, you need to protect getting the reference too. Otherwise you can end up with more than one of them. – Alica

@Marjan Venema, there's a big talk lately about the simple "if not Assigned(F) then F := Something` kind of code in threaded applications, because that can't be used without proper locking. That construct is usually used in the constructors of singletons. Myself I don't care, my singletons are created using the mentioned construct, but of course for those answers we'll need to provide proper locking. – Masaryk

Sorry, I had to downvote because the edit regarding thread safety is plain wrong. The whole point of the question's C# code is to ensure that only one singleton can be created. If the singleton is a const object, in C++ terms, then it needs no internal locking, but the reference getting code needs locking. – Alica

@David, yes, I can see what you mean. thinking.... – Jaimeejaimes

@MarjanVenema That's more or less the same idea David described on his answer. Your abstract class would be the David's interface (ISingleton), your concrete class would be the David's class (TSingleton). Using the David's solution, the singlenton will be destroyed automatically but you didn't show how to do so in your solution. – Matland

Answer 6

For threadsafety you should use a lock around 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 you could raise an exception in case someone tries to create it via the normal .Create (make a private constructor CreateSingleton)

Garbage