05 April 2010

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

Can't be created more than once.

Can't be freed until the program terminates.

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:

typeTSingleton=class(TObject)strictprivate// Frees object instance.procedureDispose;strictprotected// Initialises object. Descendants should override instead of// constructor. Does nothing in this base class.procedureInitialize;virtual;// Tidies up object. Descendants should override this method// instead of destructor. Does nothing in this base class.procedureFinalize;virtual;public// Destructor tears down object only if singleton manager permits.destructorDestroy;override;// Constructor creates new instance only if one does not already exist.classfunctionNewInstance:TObject;override;// Frees instance data only if singleton manager permits.procedureFreeInstance;override;end;

And the implementation:

destructorTSingleton.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.ifTSingletonManager.DestroyingthenbeginFinalize;inherited;end;end;procedureTSingleton.Dispose;begininheritedFreeInstance;end;procedureTSingleton.Finalize;begin// Override this to tidy up the object instead of overriding the destructorend;procedureTSingleton.FreeInstance;begin// Check if object can be destroyedifTSingletonManager.Destroyingtheninherited;end;procedureTSingleton.Initialize;begin// Override to initialise code that would normally be placed in constructorend;classfunctionTSingleton.NewInstance:TObject;varS:TSingleton;// reference to a new singletonbeginifnotTSingletonManager.SingletonExists(Self.ClassName)thenbeginS:=TSingleton(inheritedNewInstance);tryS.Initialize;TSingletonManager.RegisterSingleton(S);exceptS.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 inheritedNewInstance), 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:

typeTSingletonManager=class(TObject)strictprivate// Indicates if manager is destroying singletonsclassvarfDestroying:Boolean;// Map of class names to singleton instancesclassvarfMap:TDictionary<string,TSingleton>;protected// Frees all registered singletons.classprocedureFreeAll;// Creates empty singleton class map if it doesn't existclassprocedureCreateMap;public// Class constructor. Sets up required class vars.classconstructorCreate;// Class destructor. Frees all singletons.classdestructorDestroy;// Register new singleton. Do nothing if already registered.classprocedureRegisterSingleton(constS:TSingleton);// Checks if a singlton of given class name already registered.classfunctionSingletonExists(constClsName:string):Boolean;// Look up singelton class name in map. EListError if not found.classfunctionLookup(constClsName:string):TSingleton;// Indicates if the this class is destroying singletons. Singleton// instances use this property to allow themselves to be destroyedclasspropertyDestroying:BooleanreadfDestroyingwritefDestroying;end;

There are two class variables:

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.

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:

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.

classprocedureTSingletonManager.CreateMap;beginifnotAssigned(fMap)thenfMap:=TDictionary<string,TSingleton>.Create;end;classprocedureTSingletonManager.FreeAll;varSPair:TPair<string,TSingleton>;// classname, singleton instance pairbegin// indicate to singletons they can destroyDestroying:=True;// free the singletons in the map, then the map itselfforSPairinfMapdoSPair.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 testingend;

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: