Singleton in Delphi

[Stevie]

Ein kleines Nebenprodukt was beim Experimentieren in Delphi 2010 entstanden ist.
Ich weiß, Singletons sind böse... 8-)

Trotzdem hier mal eine ab Delphi 2010 funktionierene (evtl auch Delphi 2009 oder eher) Unit, die aus einer normalen Klasse ein Singleton macht, wovon weder ein zweites mal eine Instanz erzeugt noch die bestehende Instanz freigegeben werden kann. Hab es bisher im kleinen Stil getestet und dachte, evtl interessiert sich hier der eine oder andere für son krankes Zeug :lol:

Die Benutzung ist denkbar einfach, nachfolgend kurz, was so alles funktioniert:

Delphi-Quellcode:

uses
  Singleton;

type
  TFoo = class
  private
    FText: string;
  public
    property Text: string read FText write FText;
  end;

type
  TFooSingleton = Singleton<TFoo>;

var
  FooSingleton: Singleton<TFoo>;
  Foo: TFoo;
begin
  Foo := FooSingleton;
  TFooSingleton.Instance.Text := 'Hello Foo';
  ShowMessage(Foo.Text);
end;

Die Instanz der Klasse wird beim Starten des Programms (ich vermute in Initialization Reihenfolge der Units, genau hab ich es noch nicht getestet) erstellt und beim Beenden (Finalization der Unit Singleton.pas) wieder freigegeben. Der VMT Hack wird vorher schon (Vermutung: finalization der Unit wo der jeweilige Singleton benutzt wird) entfernt.

[Meflin]

Entschuldige die Nachfrage, aber: Was kann nun deine Implementation, was eine normale Singleton-Implementation, die mit locker 1/5 der LOCs auskommt, nicht kann? Konnte ich beim Überfliegen jetzt nicht so direkt feststellen.

[fkerber]

Hi,

auch von mir eine Nachfrage:
Warum sind Singletons deiner Meinung nach böse?


Liebe Grüße,
Frederic

[sx2008]

Zitat:

Zitat von fkerber (Beitrag 1050867)

Warum sind Singletons deiner Meinung nach böse?

Stark verkürzt gesagt:
Singletons sind nichts anderes als globale Variablen.
Globale Variablen verhindern das isolierte Testen von Klassen und bringen unerwüschte Seiteneffekte.

Dieses Youtube Video ist leider nur auf Englisch verfügbar:
The Clean Code Talks - "Global State and Singletons"
aber es zeigt ausführlich, weshalb man Singletons unbedingt vermeiden sollte.

[Stevie]

Zitat:

Zitat von Meflin (Beitrag 1050866)

Entschuldige die Nachfrage, aber: Was kann nun deine Implementation, was eine normale Singleton-Implementation, die mit locker 1/5 der LOCs auskommt, nicht kann? Konnte ich beim Überfliegen jetzt nicht so direkt feststellen.

Wenn du mit einer "normalen Singleton" Implementierung meinst, die gewünschte Klasse zu überschreiben und NewInstance und FreeInstance neu zu implementieren, dann geb ich dir recht. Da brauchst du weniger Code für, musst aber für jede neue Klasse, die du als Singleton benutzen willst, machen.

Der Vorteil den es bei meiner Implementierung gibt, ist, dass ich die Singleton Eigenschaft von der eigentlichen Klasse trenne. Deshalb ist die Aussage, Singletons seien böse auch eher scherzhaft gemeint, da ich weiß, dass einige diese Meinung vertreten. Das bezieht sich aber eher auf Nebeneffekte, die mit einem Singleton einher kommen können (hohe Kopplung, schwere Testbarkeit). (Dazu ein Zitat von Ralf Westphal)

[Bummi]

Einen IMHO bulletproves Singleton läßt sich über:

Delphi-Quellcode:

type
  TSingleton = class sealed
  private
     constructor Create;
  public
    Prozedure Tuwas;
    destructor Destroy; override;
    class function GetInstance : TSingleton;
  end;

implementation

var
  Singleton : TSingleton ;


class function TEventDistributor.GetInstance : TSingleton ;
begin
  if Singleton = nil then
    Singleton := TSingleton .Create;
  result := Singleton ;
end;





und eine Aufruf über:
TEventDistributor.GetInstance.Tuwas

erstellen....

[himitsu]

Warum nicht die Variable auch noch mit in die Klasse?

Delphi-Quellcode:

type
  TSingleton = class sealed
  private
    class var Singleton : TSingleton;
    constructor Create;
  public
    procedure Tuwas;
    destructor Destroy; override;
    class function GetInstance : TSingleton;
  end;

Und den Destructor würde ich noch absichern, damit keiner die Instanz von extern freigeben kann.

Delphi-Quellcode:

TSingleton = class sealed
private
  class var Singleton : TSingleton;
  class var AllowFree : Boolean;
  constructor Create;
public
  procedure Tuwas;
  destructor Destroy; override;
  procedure FreeInstance; override;
  class function GetInstance : TSingleton;
end;

class function TSingleton.GetInstance: TSingleton;
var 
  S: TSingleton;
begin
  if not Assigned(Singleton) then
  begin
    S := TSingleton.Create;
    if Assigned(InterlockedCompareExchangePointer(Pointer(Singleton), Pointer(S), nil)) then
      S.Free;
  end;
  Result := Singleton;
end;

procedure TSingleton.FreeInstance;
begin
  if AllowFree then
    inherited FreeInstance;
end;

finalization
  TSingleton.AllowFree := True;
  TSingleton.Singleton.Free;

[Bummi]

jep, Du hast mit beidem recht ....

[Stevie]

Beides schön... aber damit ist "in Stein gemeißelt", dass dies ein Singleton ist. Ich muss überall TSingleton.GetInstance machen und habe deshalb das Problem der hohen Abhängigkeit. Brauche ich eine andere Klasse, die ein Singleton sein soll, muss ich sie von der TSingleton Klasse ableiten (Nachtrag: geht eh nicht, da sealed) oder die gleiche Funktionalität dort einbauen.

Mein Konzept hatte zum Ziel jede beliebige Klasse (theoretisch) in ein Singleton zu verwandelt, indem man das Instanzieren und Freigeben von außen vermeidet. Jemand kann eine ganz normale Klasse schreiben und jemand anders benutzt sie bei sich im Code als Singleton. Entscheidet er sich, ich brauch doch mal 2 oder mehr Instanzen davon nehm ich das Singleton<...> weg und bin glücklich. Außerdem kann ich die Klasse für Unittests einfach ausmocken und muss mich nicht mit den überall fest verschraubten Abhängigkeiten rumärgern.

Eventuell ist mein Ansatz nicht mehr das, was ursprünglich als Singleton verstanden wird, sondern eher ein "OnlyOneInstance"-Wrapper.

[himitsu]

Man kann auch den Constructor überschreiben, so daß dort entweder ein Objekt erzeugt oder das bestehende Singleton zurückgegeben wird.

[himitsu]

OK, dann hier mal meine Gedanken zu einem SingletonPattern

die Basisklasse für Delphi 2009 und davor:

Delphi-Quellcode:

type
  TSingleton = class(TObject)
  private
    fIsInitialized: Boolean;
    fAllowFree:     Boolean;
    fIsSingelton:   Boolean;
    class var fSingleton: TSingleton;
    class procedure DoFree;
  protected
    property isInitialized: Boolean read fIsInitialized;  // to see whether the constructor must be executed (in contructors)
    property AllowFree:     Boolean read fAllowFree;      // to detect whether the object is released (in destructors)
    property isSingelton:   Boolean read fIsSingelton;    // note: not yet available in constructor
  public
    class function NewInstance: TObject; override;
    procedure AfterConstruction; override;
    procedure BeforeDestruction; override;
    procedure FreeInstance; override;
  end;

class procedure TSingleton.DoFree;
begin
  if Assigned(fSingleton) then
    fSingleton.fAllowFree := True;
  fSingleton.Free;
end;

class function TSingleton.NewInstance: TObject;
begin
  if Assigned(fSingleton) then
    Result := fSingleton
  else
    Result := inherited;
end;

procedure TSingleton.AfterConstruction;
begin
  inherited;
  fIsSingelton := not Assigned(InterlockedCompareExchangePointer(Pointer(fSingleton), Pointer(Self), nil));
  fIsInitialized := True;
  if not fIsSingelton then fAllowFree := True;
end;

procedure TSingleton.BeforeDestruction;
begin
  if fAllowFree then
    inherited;
end;

procedure TSingleton.FreeInstance;
begin
  if fAllowFree then
    inherited;
end;

class destructor TSingleton.DestroyClass;
begin
  if Assigned(fSingleton) then
    fSingleton.fAllowFree := True;
  fSingleton.Free;
end;

initialization

finalization
  TSingleton.DoFree;

end.

die Basisklasse ab Delphi 2010 (die ältere Version geht aber auch noch):

Delphi-Quellcode:

type
  TSingleton = class(TObject)
  private
    fIsInitialized: Boolean;
    fAllowFree:     Boolean;
    fIsSingelton:   Boolean;
    class var fSingleton: TSingleton;
  protected
    property isInitialized: Boolean read fIsInitialized;  // to see whether the constructor must be executed (in contructors)
    property AllowFree:     Boolean read fAllowFree;      // to detect whether the object is released (in destructors)
    property isSingelton:   Boolean read fIsSingelton;    // note: not yet available in constructor
  public
    class function NewInstance: TObject; override;
    procedure AfterConstruction; override;
    procedure BeforeDestruction; override;
    procedure FreeInstance; override;
    class destructor DestroyClass;
  end;

class function TSingleton.NewInstance: TObject;
begin
  if Assigned(fSingleton) then
    Result := fSingleton
  else
    Result := inherited;
end;

procedure TSingleton.AfterConstruction;
begin
  inherited;
  fIsSingelton := not Assigned(InterlockedCompareExchangePointer(Pointer(fSingleton), Pointer(Self), nil));
  fIsInitialized := True;
  if not fIsSingelton then fAllowFree := True;
end;

procedure TSingleton.BeforeDestruction;
begin
  if fAllowFree then
    inherited;
end;

procedure TSingleton.FreeInstance;
begin
  if fAllowFree then
    inherited;
end;

class destructor TSingleton.DestroyClass;
begin
  if Assigned(fSingleton) then
    fSingleton.fAllowFree := True;
  fSingleton.Free;
end;

und eine Beispielklasse:

Delphi-Quellcode:

type
  TMyClass = class(TSingleton)
    Value: String;
    constructor Create;
    destructor Destroy; override;
  end;

constructor TMyClass.Create;
begin
  if not isInitialized then
  begin
    inherited;
    ////////////////////

    ShowMessage('Ich wurde erstellt');

    ////////////////////
  end;
end;

destructor TMyClass.Destroy;
begin
  if AllowFree then
  begin
    ////////////////////

    //ShowMessage('ich werde jetzt freigegeben');
    // wird nicht mehr angezeigt, nachdem die VCL beendet wurde
    MessageBox(0, 'ich werde jetzt freigegeben', '', 0);

    ////////////////////
    inherited;
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
var
  S: TMyClass;
begin
  S := TMyClass.Create;
  S.Value := 'test';
  S.Free;

  S := TMyClass.Create;
  ShowMessage('mein Wert ist: ' + S.Value);
end;

[Stevie]

Wie schon erwähnt, immernoch das gleiche Problem, du musst eine Klasse, die du als Singleton benutzen willst, von TSingleton ableiten -> Abhängigkeit.
Du kannst keine beliebige (wie schon erwähnt, in Theorie, habs noch nicht mit mehr als TFoo und TBar getestet) Klassen in Singletons umwandeln, ich schon.

[himitsu]

Joar, das Singleton muß hier quasi an der Spitze stehen.
Leider bieten die Generics es nicht an, daß man damit die Basisklasse setzen kann.

Delphi-Quellcode:

TSingleton<Base: class> = class(Base)
  ...
end;

Du kannst es aber manuell selber machen, indem du TObjekt bei TSingleton abänderst.
Man könnte ja zumindestens eine Codevorlage daraus basteln.

[Stevie]

Zitat:

Zitat von himitsu (Beitrag 1050950)

Joar, das Singleton muß hier quasi an der Spitze stehen.
Leider bieten die Generics es nicht an, daß man damit die Basisklasse setzen kann.

Delphi-Quellcode:

TSingleton<Base: class> = class(Base)
  ...
end;

Du kannst es aber manuell selber machen, indem du TObjekt bei TSingleton abänderst.
Man könnte ja zumindestens eine Codevorlage daraus basteln.

Das ist doch genau das, was ich gemacht habe :gruebel:

[himitsu]

Zitat:

Zitat von Stevie (Beitrag 1050953)

Das ist doch genau das, was ich gemacht habe :gruebel:

Nein,

du hast quasi dieses

Delphi-Quellcode:

TSingleton<T> = class
  ...
  class property Instance: T read FInstance;
  ...
end;

gemacht, aber nicht jenes

Delphi-Quellcode:

TSingleton<T> = class<T>
  ...
end;

.


Also du hast eine Klasse in einer anderen Klasse/Record verpackt.
(wobei man dort eben auch noch aufpassen muß, daß man dieses gekapselte Objekt nicht extern freigibt)

Bei mir und wenn dieser Generic so ginge, würde das Objekt von dem Singleton abgeleitet und hätte dann in sich selber diese Funktionalität aufgenommen.

Oder man leitet den Singleton von der gewünschten Klasse ab und baut dieses Verhalten dann nachträglich ein (hierfür muß man aber zusätzlich noch alle Konstruktoren überschreiben/verdecken und mit Konstrukoren besetzen, welche der dem vorhandenen TSingleton.Create entsprechen).

[Stevie]

Zitat:

Zitat von himitsu (Beitrag 1050954)

Also du hast eine Klasse in einer anderen Klasse/Record verpackt.
(wobei man dort eben auch noch aufpassen muß, daß man dieses gekapselte Objekt nicht extern freigibt)

Und genau das hab ich ja verhindert. Ich habe quasi soweit mit Delphi möglich

Delphi-Quellcode:

TSingleton<T> = class<T>
  ...
end;

gebaut, denn genau das, was den Singleton ausmacht ist, nämlich, dass nur einmal eine Instanz erzeugt wird und verhindert wird, diese freizugeben, ist gegeben.

[himitsu]

Irgendwie wird in meinem D2010 dein Class-Constructor nicht aufgerufen.
Folglich bleibt die Instanz immer nil und beim Zugriff darauf knallt es dann immer.

[Stevie]

Zitat:

Zitat von himitsu (Beitrag 1050996)

Irgendwie wird in meinem D2010 dein Class-Constructor nicht aufgerufen.
Folglich bleibt die Instanz immer nil und beim Zugriff darauf knallt es dann immer.

Zeig ma bitte, wie du den Singleton erstellt hast.

[himitsu]

Erst hatte ich was Eigenes versucht, aber auch mit deinem Beispielcode aus'm Post #1 (mit TStringList statt TFoo) geht's nicht.

[Stevie]

Zitat:

Zitat von himitsu (Beitrag 1051011)

Erst hatte ich was Eigenes versucht, aber auch mit deinem Beispielcode aus'm Post #1 (mit TStringList statt TFoo) geht's nicht.

Konsolenanwendung? Hab gerade gemerkt, dass dort was schief läuft, schau ich mir nachher mal zu Hause an. In ner VCL Forms Anwendung läufts bei mir.

[himitsu]

War 'ne GUI-Anwendung, aber ohne Formulare.

[Stevie]

War ja klar, dass es mal wieder nen Bug in Delphi ist (der übrigens scheinbar in XE nicht gefixt ist!) :roll:

Also nicht in die dpr sondern in ne eigene Unit und schon läufts ;)

P.S.: Witzig, dass der Fehler scheinbar ausgerechnet mit nem TSingleton<T> aufgefallen ist. :shock:

[himitsu]

Ist das'n Bug in Verbindung mit den Generics?
Auf den DT wurde ja groß behauptet gesagt, daß man in XE alle Generics-Bugs behoben hat (aber die 3 neuen Bugmeldungen hatte man wohl noch nicht entdeckt).

[Stevie]

Zitat:

Zitat von himitsu (Beitrag 1051036)

Ist das'n Bug in Verbindung mit den Generics?

Vermutlich, Alex Ciobanu hat dazu mal was geblogt.

P.S.: Da seh ich auch gerade, dass das Feature mit class contructor/destructor nen Delphi 2010 Feature ist. :D

[himitsu]

Zitat:

Zitat von Stevie (Beitrag 1051042)

P.S.: Da seh ich auch gerade, dass das Feature mit class contructor/destructor nen Delphi 2010 Feature ist. :D

Das hätt ich dir auch so sagen können.
(rate mal, warum ich 2 Versionen gepostet hatte :angel: )

[himitsu]

Zitat:

If TDistinctType<String> is used in multiple units, each unit’s version has it own FMarker, which means it needs to be initialized for each unit.

Das würde doch auch bedeuten, daß jede Unit ihr eigenes Singleton hätte.

Ich glaub hier sollte man dieses nochmals prüfen/ändern.