Singleton in Delphi

[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.