1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153
| unit SLT.Common.DesignPattern;
interface
uses System.SysUtils, System.SyncObjs;
type
{ Forward class declarations }
TSLTSingleton<T: class, constructor> = class;
TSLTSingletonThreadSafe<T: class, constructor> = class;
/// <summary>Erreur de base liée au Patron de Conception (Design Pattern)</summary>
ESLTDesignPatternError = class(Exception);
/// <summary>Erreur de base liée au Patron de Conception "Singleton"</summary>
ESLTSingletonError = class(ESLTDesignPatternError)
public
type
TErrorType = (setCheckInstanceAssertion);
public
constructor Create(ErrorType: TErrorType; ASingletonClass: TClass);
end;
/// <summary>Aide pour la création d'une classe respectant le Patron de Conception "Singleton"</summary>
TSLTSingleton<T: class, constructor> = class(TObject)
private
class var
FInstance: T;
protected
class function GetInstance(): T; static;
class procedure CheckInstance(Obj: T);
public
// Constructeurs de Classe
class destructor Destroy();
/// <summary>Masquage du constructeur non virtuel Create par cette méthode de classe</summary>
class function Create(): T;
// Propriétés de Classe
class property Instance: T read GetInstance;
end;
/// <summary>Classe aidant la création d'une classe respecant le Patron de Conception "Singleton" avec prise en compte des Threads</summary>
TSLTSingletonThreadSafe<T: class, constructor> = class(TSLTSingleton<T>)
private
class var
FInstance: T;
FInstanceLock: System.SyncObjs.TCriticalSection;
protected
class function GetThreadSafeInstance(): T; static;
public
// Constructeurs de Classe
class constructor Create();
class destructor Destroy();
// Propriétés de Classe
class property Instance: T read GetThreadSafeInstance;
end;
implementation
const
SINGLETON_ASSERT_CHECK_INSTANCE_FMT = 'Must Call property "Instance" of "%s" and not named constructor "Create"'; // Do not localize
SINGLETON_ERRORS: array[ESLTSingletonError.TErrorType] of string = (SINGLETON_ASSERT_CHECK_INSTANCE_FMT);
{ ESLTSingletonError }
//------------------------------------------------------------------------------
constructor ESLTSingletonError.Create(ErrorType: TErrorType; ASingletonClass: TClass);
begin
CreateFmt(SINGLETON_ERRORS[ErrorType], [ASingletonClass.ClassName()]);
end;
{ TSLTSingleton<T> }
//------------------------------------------------------------------------------
class procedure TSLTSingleton<T>.CheckInstance(Obj: T);
begin
if Assigned(FInstance) and Assigned(Obj) and (Obj <> FInstance) then
raise ESLTSingletonError.Create(setCheckInstanceAssertion, Obj.ClassType()); // Pseudo-Assert Exception !
end;
//------------------------------------------------------------------------------
class function TSLTSingleton<T>.Create(): T;
begin
Result := Instance;
end;
//------------------------------------------------------------------------------
class destructor TSLTSingleton<T>.Destroy();
begin
FreeAndNil(FInstance);
end;
//------------------------------------------------------------------------------
class function TSLTSingleton<T>.GetInstance(): T;
begin
if not Assigned(FInstance) then
FInstance := T.Create();
Result := FInstance;
end;
{ TSLTSingletonThreadSafe<T> }
//------------------------------------------------------------------------------
class constructor TSLTSingletonThreadSafe<T>.Create();
begin
FInstanceLock := TCriticalSection.Create();
end;
//------------------------------------------------------------------------------
class destructor TSLTSingletonThreadSafe<T>.Destroy();
begin
FInstance := nil; // On est pas responsable de cette libération
FreeAndNil(FInstanceLock);
end;
//------------------------------------------------------------------------------
class function TSLTSingletonThreadSafe<T>.GetThreadSafeInstance(): T;
begin
// L'utilisation d'une Section critique (TCriticalSection) au lieu d'un TMultiReadExclusiveWriteSynchronizer
// les plus :
// - Plus léger (n'ajoute pas event+thread)
// - Plus facile a gérer car on peut facilement simuler une promotion d'un Verrou en Lecture vers un Verrou en Ecriture,
// J'ai des souvenir que cette pratique peut engendrer un DeadLock !
// Après avoir fait quelques tests, je n'arrive pas à la reproduire mais je préfère éviter cela : "ID: 17761, TMultiReadExclusiveWriteSynchronizer deadlock fix-SysUtils.pas" - http://cc.embarcadero.com/Item/17761)
// - Supporte l'imbrication sans trop de complexité
// - Permet de conserver la "Lazy Initialization" typique du Singleton !
// les moins :
// - nuit quelque peu à la performance des Threads si on ne triche légèrement en lecture
// Si le pointeur existe, il n'y aucune raison de "sécuriser l'accès" qui ne sera qu'en lecture par la suite
// Plusieurs threads peuvent lire cette instance (un seul peut l'écrire)
if not Assigned(FInstance) then
begin
// la "Lazy Initialization" nécessite une protection
FInstanceLock.Acquire();
try
// Si cela se trouve, le Acquire a attendu qu'un autre thread crée le Singleton !
if not Assigned(FInstance) then
FInstance := GetInstance(); // Utilisation du Singleton non thread safe
finally
FInstanceLock.Release();
end;
end;
Result := FInstance;
end;
end. |
Partager