Thursday, March 06, 2008

TDM#7: Design Patterns; Singleton

"In their book Design Patterns, Gamma et al (a.k.a. the gang of four) lay the foundation for a new way of approaching software design. [...] In this article we will first look at the language elements that are unique to Object Pascal when compared to C++ and how this makes many of the problems the design patterns try to solve, non-existent, or at least much easier to solve. Then we will look at one example of a very simple design pattern, the Singleton pattern, and how this can best be implemented in Delphi."

H.Vassbotn, The Delphi Magazine, January 1999

This is one of my higher level TDM articles. It revolves around the discussion of the Singleton pattern and implementing it in a reusable fashion in Delphi. Singleton is one of the design patterns with a more dubious value - it is not well suited for multithreaded code and often it preemptively decides that there should only be a single instance of a specific class. Nevertheless, it can have its uses and the article does show some hacks to make the default constructor and destructor unavailable, for instance.

"Even if the goal of designing a Singleton class might seem very simple, there are a number of points we must consider:

· When and by whom should the single instance be created?
· When and by whom should the single instance be destroyed?
· How should external clients get access to the single instance?
· How can we avoid that the value of the instance reference is corrupted?
· How can we avoid illegal creation of additional instances?
· How can we avoid illegal destruction of the single instance?
· How can we keep the design of the Singleton class, but still allow extension by inheritance?"

At the time, class variables were not present in the language, something I bemoan in the article. However, my idea of a useful class variable implementation differs from what we eventually got (and what most sane men would expect ;) ).

"Class fields is such a unusual concepts for most Pascal programmers, so many find it hard to grasp how they should work, if they were part of the language. In OP we do have hard-coded, read only class fields, such as ClassName, InstanceSize, RTTI pointers etc. These are accessed through class functions, but the actual information is stored as part of the extended VMT (virtual method table). This is how class fields should be implemented as well. A class field follows the VMT, so each new derived class has a separate copy of the class field slot."

So I wanted proper per-class (per-VMT) class variables, not the global-variables-in-disguise class vars we have now (each child class shares the class var it inherits with all other classes in the same part of the hierarchy). This has since been discussed in this log here and here.

Another amusing part of the article is my need to uphold the merits of the Delphi Object Pascal Language.

"Object Pascal as a better language

Many people (not to mention the popular computer press) tend to believe that Object Pascal (OP from now on) has only a subset of the language features of C++. While it is true that OP lacks features like multiple inheritance, operator overloading (except for the array subscript operator [..]) and templates, it still has an array of language features not found in C++. Over the years OP has borrowed many features from C++, for good or for worse. I sincerely hope they will not copy all of them – C++ is such a complex language with many pitfalls for both the novice and experienced programmer.

If we look at the language elements unique to OP, we find an amazing array of useful features: units, sets, sub-ranges, native DLL support, class types, class reference variables, virtual class methods, virtual constructors, extensive runtime type-information (RTTI), message methods, dynamic methods, the override keyword, properties, the try..finally clause, initialization and finalization sections, variants, threadvars, native COM support, interfaces, packages, dynamic arrays, interface delegation, automatic reference counting mechanism, and method pointers. I could go on. This is not intended as an exercise in C++ bashing, but rather an attempt to heighten our awareness of the goodies of OP we are enjoying daily."

Well, today we do have proper operator overloading and a template-like facility is (or will become for Win32) available in the form of generics. Still, I do stand by the statement that Object Pascal is a rich, capable and easy-to-use language.

Here is the general, reusable part of the Singleton code:

unit HVSingleton;

interface

uses
SysUtils;

type
ESingleton = class(Exception);

TInvalidateDestroy = class(TObject)
protected
class procedure SingletonError;
public
destructor Destroy; override;
end;

TSingletonOpaqueInfo = record end;
TSingletonHandle = ^TSingletonOpaqueInfo;
TSingleton = class;
TSingletonClass = class of TSingleton;
TSingleton = class(TInvalidateDestroy)
private
class procedure Startup;
class procedure Shutdown;
protected
// Allow descendents register themselves
class function RegisterSingletonClass(aSingletonClass: TSingletonClass): TSingletonHandle;
// Allow descendents to set a new class for the instance:
class procedure OverrideSingletonClass(BaseSingletonClass, NewSingletonClass: TSingletonClass);
// Interface for descendents to get their instance pointer
class function InstanceOf(Handle: TSingletonHandle): TSingleton;
// Actual constructor and destructor that will be used:
constructor SingletonCreate; virtual;
destructor SingletonDestroy; virtual;
public
// Not for use - for obstruction only:
class procedure Create;
class procedure Free(Dummy: integer);
{$IFNDEF VER120} {$WARNINGS OFF} {$ENDIF}
// This generates a warning in D3. D4 has the reintroduce keyword to solve this
class procedure Destroy(Dummy: integer); {$IFDEF VER120} reintroduce; {$ENDIF}
end;
{$IFNDEF VER120} {$WARNINGS ON} {$ENDIF}

implementation

uses
Classes;

{ TInvalidateDestroy }

class procedure TInvalidateDestroy.SingletonError;
// Raise an exception in case of illegal use
begin
raise ESingleton.CreateFmt('Illegal use of %s singleton instance!', [ClassName]);
end;

destructor TInvalidateDestroy.Destroy;
// Protected against use of default destructor
begin
SingletonError;
end;

{ TSingleton }

var
SingletonInstances : TList; { of TSingletons }
SingletonClasses : TList; { of TSingletonClasses }

class procedure TSingleton.Startup;
begin
SingletonInstances := TList.Create;
SingletonClasses := TList.Create;
end;

class procedure TSingleton.Shutdown;
// Time to close down the show
var
SingletonInstance: TSingleton;
i : integer;
begin
// Free any singleton instances
for i := SingletonInstances.Count-1 downto 0 do
begin
SingletonInstance := TSingleton(SingletonInstances.List^[i]);
if Assigned(SingletonInstance) then
SingletonInstance.SingletonDestroy;
end;
// Free the lists
SingletonInstances.Free; SingletonInstances := nil;
SingletonClasses .Free; SingletonClasses := nil;
end;

class function TSingleton.RegisterSingletonClass(aSingletonClass: TSingletonClass): TSingletonHandle;
// Register a new Singleton class and allocate space for the instance pointer
var
Index: integer;
begin
Assert(Assigned(aSingletonClass));
Assert(SingletonClasses.IndexOf(Pointer(aSingletonClass)) < 0);
SingletonClasses.Add(Pointer(aSingletonClass));
// Return the index +1 of the instace pointer as a handle
Index := SingletonInstances.Add(nil);
Result := TSingletonHandle(Index+1);
Assert(SingletonClasses.Count = SingletonInstances.Count);
end;

class procedure TSingleton.OverrideSingletonClass(BaseSingletonClass, NewSingletonClass: TSingletonClass);
// Allow change of instance class
var
ThisClass: TSingletonClass;
i : integer;
begin
Assert(Assigned(BaseSingletonClass));
Assert(Assigned(NewSingletonClass));
Assert(BaseSingletonClass <> TSingleton);
Assert(NewSingletonClass.InheritsFrom(BaseSingletonClass));
for i := 0 to SingletonClasses.Count-1 do
begin
ThisClass := TSingletonClass(SingletonClasses.List^[i]);
if ThisClass.InheritsFrom(BaseSingletonClass) and
(SingletonInstances.List^[i] = nil) then
begin
SingletonClasses.List^[i] := Pointer(NewSingletonClass);
Exit;
end;
end;
// If we get, here the base class was not found or
// an instance had already been created
SingletonError;
end;

class function TSingleton.InstanceOf(Handle: TSingletonHandle): TSingleton;
// Single Instance function - create when first needed
var
Index: Integer;
begin
// Convert the handle back to an index - subtract 1
Index := Integer(Handle) - 1;
Assert((Index >= 0) and (Index <= SingletonInstances.Count-1));
Assert(Assigned(SingletonClasses.List^[Index]));
if not Assigned(SingletonInstances.List^[Index]) then
SingletonInstances.List^[Index] := TSingletonClass(SingletonClasses.List^[Index]).SingletonCreate;
Result := SingletonInstances.List^[Index];
end;

constructor TSingleton.SingletonCreate;
// Protected constructor
begin
inherited Create;
end;

destructor TSingleton.SingletonDestroy;
// Protected destructor
begin
// We cannot call inherited Destroy; here!
// It would raise an ESingleton exception
end;

// Protected against use of default constructor
class procedure TSingleton.Create;
begin
SingletonError;
end;

// Protected against use of Free
class procedure TSingleton.Free(Dummy: integer);
begin
SingletonError;
end;

// Protected against use of default destructor
class procedure TSingleton.Destroy(Dummy: integer);
begin
SingletonError;
end;

initialization
TSingleton.Startup;
finalization
TSingleton.Shutdown;
end.

Note that the code was written for Delphi 3 and 4 - it will give warnings on later versions (this was before the handy $IF directive and CompilerVersion constant). 


And here is a specific singleton class, that inherits the singleton functionality from the TSingleton class above.

unit HVTimeKeeper2;

interface

uses
HVSingleton;

type
TTimeKeeper = class(TSingleton)
private
function GetTime: TDateTime;
function GetDate: TDateTime;
function GetNow: TDateTime;
public
class function Instance: TTimeKeeper;
property Time: TDateTime read GetTime;
property Date: TDateTime read GetDate;
property Now: TDateTime read GetNow;
end;

function TimeKeeper: TTimeKeeper;

implementation

uses
SysUtils;

{ TTimeKeeper }

var
TimeKeeperHandle: TSingletonHandle;

class function TTimeKeeper.Instance: TTimeKeeper;
// Single Instance function - create when first needed
begin
Result := TTimeKeeper(InstanceOf(TimeKeeperHandle));
end;

// Property access methods
function TTimeKeeper.GetDate: TDateTime;
begin
Result := SysUtils.Date;
end;

function TTimeKeeper.GetNow: TDateTime;
begin
Result := SysUtils.Now;
end;

function TTimeKeeper.GetTime: TDateTime;
begin
Result := SysUtils.Time;
end;

// Simplified functional interface

function TimeKeeper: TTimeKeeper;
begin
Result := TTimeKeeper.Instance;
end;

initialization
TimeKeeperHandle := TTimeKeeper.RegisterSingletonClass(TTimeKeeper);
end.

I think the original plan was to write more articles about design patterns; general discussion, sample Delphi implementations, recognizing existing use of patterns in the VCL and so on. But they never materialized - not in print, anyway; I did stumble over a draft of patterns in the VCL. Maybe I'll revive some of that material on the blog later.


As usual you can download and read the full article (PDF) and code samples.

2 comments:

Anonymous said...

A unit itself is a singleton-like entity. Which property was used in your code (SingletonInstances and SingletonClasses variables).
Therefore there is no need in class-based singleton unless you are an OOP-maniac.;)

Hallvards New Blog said...

> A unit itself is a singleton-like entity.

Yes, that is true, but it does have a number of disadvantages, like namespace pollution, no properties, no inheritance and so on.

Another alternative that makes sense now that we have proper class vars, class properties etc is to let the singleton be an abstract class with only class-level members.



Copyright © 2004-2007 by Hallvard Vassbotn