Singletons

For a long time now I've been looking for a nice singleton implementation that meets my needs. I want a singleton that:

1. Can't be created more than once.
2. Can't be freed until the program terminates.
3. Can be used as a common base class for all the program's singletons.

There are plenty of implementations around that meet requirements 1 and 2, but most of those can't be overridden (usually because they retain a reference to the singleton object in a private global variable or a class var field).

Then I found some code by Yoav Abrahami in his article on Delphi3000.com that can be used as a base class.

The code was written for a old version of Delphi and used a TStringList to record instances of each singleton class created and only permits one instance of each class. I've adapted Yoav's code to use features of Delphi 2010 to avoid the need for TStringList and use of private global variables. I've also taken advantage of Delphi 2010's new class constructor and destructor to avoid having initialization and finalization code.

Here's the TSingleton class declaration:

type
  TSingleton = class(TObject)
  strict private
    // Frees object instance.
    procedure Dispose;
  strict protected
    // Initialises object. Descendants should override instead of
    // constructor. Does nothing in this base class.
    procedure Initialize; virtual;
    // Tidies up object. Descendants should override this method
    // instead of destructor. Does nothing in this base class.
    procedure Finalize; virtual;
  public
    // Destructor tears down object only if singleton manager permits.
    destructor Destroy; override;
    // Constructor creates new instance only if one does not already exist.
    class function NewInstance: TObject; override;
    // Frees instance data only if singleton manager permits.
    procedure FreeInstance; override;
  end;

And the implementation:

destructor TSingleton.Destroy;
begin
  // Do not override to tidy up unless you first check
  // TSingletonManager.Destroying and only tidy up if it returns true.
  // Override Finalize instead.
  if TSingletonManager.Destroying then
  begin
    Finalize;
    inherited;
  end;
end;

procedure TSingleton.Dispose;
begin
  inherited FreeInstance;
end;

procedure TSingleton.Finalize;
begin
  // Override this to tidy up the object instead of overriding the destructor
end;

procedure TSingleton.FreeInstance;
begin
  // Check if object can be destroyed
  if TSingletonManager.Destroying then
    inherited;
end;

procedure TSingleton.Initialize;
begin
  // Override to initialise code that would normally be placed in constructor
end;

class function TSingleton.NewInstance: TObject;
var
  S: TSingleton;  // reference to a new singleton
begin
  if not TSingletonManager.SingletonExists(Self.ClassName) then
  begin
    S := TSingleton(inherited NewInstance);
    try
      S.Initialize;
      TSingletonManager.RegisterSingleton(S);
    except
      S.Dispose;
      raise;
    end;
  end;
  Result := TSingletonManager.Lookup(Self.ClassName);
end;

The code might be familiar if you've used similar singletons before. If not, here's a brief overview.

TSingleton's constructor calls the virtual NewInstance to allocate space for the object. Here NewInstance has been overridden to only allocate space for the singleton if it doesn't already exist.

We check TSingletonManager, explained below, to find out if an instance already exists. If not, a new instance is created (using inherited NewInstance), is recorded by the singleton manager and then finally returned in the last line via the Lookup method. Should an exception occur NewInstance frees the object instance via the Dispose method. If the singleton already exists its object reference is looked up and returned without a new instance being created.

The up shot of all this is that only one instance for each singleton type is ever created.

Calling a TSingleton descendant's Destroy method only has any effect if the singleton manager has flagged that the singleton can be destroyed (see below). FreeInstance (which is call from destructors) is responsible for freeing an object's instance data. Here FreeInstance is overridden to only free the instance if the singleton manager permits.

Finally there are the virtual, do nothing, Initialize and Finalize methods. These are designed to be overridden by descendant classes to perform object setup and tear down. This is to avoid having to override the constructor or destructor with all the complications that may bring.

As you can see TSingleton depends on the TSingletonManager to keep track of singleton instances and to tell them when they can be destroyed. Here is the declaration of TSingletonManager:

type
  TSingletonManager = class(TObject)
  strict private
    // Indicates if manager is destroying singletons
    class var fDestroying: Boolean;
    // Map of class names to singleton instances
    class var fMap: TDictionary<string,TSingleton>;
  protected
    // Frees all registered singletons.
    class procedure FreeAll;
    // Creates empty singleton class map if it doesn't exist
    class procedure CreateMap;
  public
    // Class constructor. Sets up required class vars.
    class constructor Create;
    // Class destructor. Frees all singletons.
    class destructor Destroy;
    // Register new singleton. Do nothing if already registered.
    class procedure RegisterSingleton(const S: TSingleton);
    // Checks if a singlton of given class name already registered.
    class function SingletonExists(const ClsName: string): Boolean;
    // Look up singelton class name in map. EListError if not found.
    class function Lookup(const ClsName: string): TSingleton;
    // Indicates if the this class is destroying singletons. Singleton
    // instances use this property to allow themselves to be destroyed
    class property Destroying: Boolean read fDestroying write fDestroying;
  end;

There are two class variables:

1. fDestroying is the value of the Destroying property which is set true only when the program is closing down. We have seen that TSingleton tests this property to see if an instance can be destroyed.
2. fMap is a dictionary that maps singleton class names to their instances.

New to Delphi 2010, the class constructor and destructor are automatically called when the program initializes and closes down. They avoid having to use initialization and finalization sections and have some linking advantages:

class constructor TSingletonManager.Create;
begin
  CreateMap;
end;

class destructor TSingletonManager.Destroy;
begin
  FreeAll;
end;

The class constructor and destructor simply call the CreateMap and FreeAll class methods that are listed below. This was done purely to aid testing and the code of these methods could be included directly in the class constructor and destructor.

class procedure TSingletonManager.CreateMap;
begin
  if not Assigned(fMap) then
    fMap := TDictionary<string,TSingleton>.Create;
end;

class procedure TSingletonManager.FreeAll;
var
  SPair: TPair<string, TSingleton>; // classname, singleton instance pair
begin
  // indicate to singletons they can destroy
  Destroying := True;
  // free the singletons in the map, then the map itself
  for SPair in fMap do
    SPair.Value.Free;
  FreeAndNil(fMap);
  Destroying := False;
  // we set fMap = nil and Destroying = False to make it safe to
  // re-create map when testing. Don't bother with this if not testing
end;

CreateMap simply creates the dictionary object and stores it in the fMap class var.

FreeAll first sets the Destroying property true then frees all the recorded singleton instances and finally frees the dictionary. Remember that TSingleton checks Destroying and only frees itself when the property is true.

The rest of TSingletonManager is concerned with maintaining the list of singleton instances. The methods are quite simple:

class function TSingletonManager.Lookup(const ClsName: string): TSingleton;
begin
  Result := fMap[ClsName];
end;

class procedure TSingletonManager.RegisterSingleton(const S: TSingleton);
begin
  if not SingletonExists(S.ClassName) then
    fMap.Add(S.ClassName, S);
end;

class function TSingletonManager.SingletonExists(
  const ClsName: string): Boolean;
begin
  Result := fMap.ContainsKey(ClsName);
end;

Lookup simply looks up a class name in the dictionary and returns the singleton instance for that class. It raises an EListError exception if there is no matching instance.

RegisterSingleton is the method that registers a singleton with the manager. It maps the singleton's class name to the instance. If the singleton is already registered it does nothing.

SingletonExists simply returns True if a singleton with a given class name exists.

So, that's it. It's the singleton implementation that suits my needs best. There's a sample project in my Delphi Doodlings repo that contains TSingleton and TSingletonManager along with some unit tests.

Source code highlighting by DelphiDabbler PasHi.