Abgeleitete Klasse eines Singleton Objekts

[t2000]

Hi zusammen,

ich weiß nicht, ob das überhaupt geht, bzw. ob es sich lohnt.

Folgendes Szenario:
Im Programm ( schon eher ein komplettes Framework) haben verschiedene Formulare Grids, die Daten aus den Datenbanken (REST Server) anzeigen.
Die Konfiguration der Spalten sind in der Datenbank abgelegt. Das komplette Design.

Die verschiedenen Programteile haben ein je Model (mal ganz einfach ausgedrückt). Wenn ich dort die Design Infos jedesmal laden würde, kostet das zu viel Geschwindigkeit/Ressourcen. Die Models werden manchmal nur für sehr kurze Zeit (z.B. eine Abfrage) erzeugt und wieder freigegeben.
Also habe ich das Design in ein Singleton Object ausgelagert, das die Daten erst beim ersten Zugriff liest und dann vorhält. Da jedes Programmteil verschiedene Designs benötigt, hält das Singleton Object alle Designs für diesen Bereich.
(Es gibt zu viele Bereiche bzw. Kundenkonfigurationen, als dass man ALLE Designs in EINEM Singlton Object definieren könnte)

Gut. Ich habe also in jedem Model ein Singleton für diesen Bereich.
Das funktioniert auch alles sehr gut.

Der Einfachheit beim Entwickeln (es arbeiten auch andere Personen daran), wollte ich eine Singleton Basisklasse schaffen, von der die anderen ableiten können.
Und das funktioniert nicht.

Hier die Frage von oben nochmal: ich weiß nicht, ob das überhaupt geht, bzw. ob es sich lohnt.

Hier der Code

Basisunit

Delphi-Quellcode:

type
  TsngColumnDescription = class
  private
    class var FInstance: TsngColumnDescription;
  private
    FsngColumnsOwner: TsngColumnsOwner;
  protected
    function GetSngColumnsOwner: TsngColumnsOwner; virtual; // abstract;
  public
    class function this: TsngColumnDescription; virtual;
    class destructor Destroy;
    property CD: TsngColumnsOwner read GetSngColumnsOwner;
  end;

implementation

{ TsngColumnDescription }

class destructor TsngColumnDescription.Destroy;
begin
  if Assigned( FInstance) then begin
    FInstance.FsngColumnsOwner.Free;
    FreeAndNil( FInstance);
  end;
end;

class function TsngColumnDescription.this: TsngColumnDescription;
begin
  if not Assigned( FInstance) then begin
    FInstance := TsngColumnDescription.Create;
    FInstance.FsngColumnsOwner := TsngColumnsOwner.Create;
  end;
  Result := FInstance;
end;

function TsngColumnDescription.GetSngColumnsOwner: TsngColumnsOwner;
begin
  Result := FsngColumnsOwner;
end;

Eine Ableitung in einer anderer Unit

Delphi-Quellcode:

type
  TColKaoPfand = class( TsngColumnDescription)
  protected
    function GetSngColumnsOwner: TkaoPfandColumnDescription; reintroduce;
  public
    class function this: TColKaoPfand; reintroduce;
    property CD: TkaoPfandColumnDescription read GetSngColumnsOwner;
  end;

implementation

class function TColKaoPfand.this: TColKaoPfand;
begin
  Result := TColKaoPfand( inherited this);
end;

function TColKaoPfand.GetSngColumnsOwner: TkaoPfandColumnDescription;
begin
  Result := TkaoPfandColumnDescription( inherited GetSngColumnsOwner);
end;

Ein Zugriff auf "TColKaoPfand.this.CD.xxx" mach eine ACCESS VIOLATION
Beim debuggen, werden diese Routinen durchlaufen

TColKaoPfand.this (begin ...)
-- TsngColumnDescription.this (begin..end)
TColKaoPfand.this (..end)
TColKaoPfand.GetSngColumnsOwner (begin..)
-- TsngColumnDescription.GetSngColumnsOwner (begin..end)
TColKaoPfand.GetSngColumnsOwner (..end)

sobald er nun aus der letzten procedure raus springt, kommt die Exception. Also F7/F8 auf der letzten Zeile TColKaoPfand.GetSngColumnsOwner "end;"

Wie gesagt, ohne Ableitung/Vererbung funktioniert das einwandfrei.

Sieht da jemand den Fehler oder ist das vielleicht alles Chaos?

Danke euch
VG Thomas

[t2000]

Leute, vergesst es oder nehmt es als Vorlage.

Warum findet man die Fehler immer erst, wenn man darüber diskutiert oder schreibt

Der FsngColumnsOwner (property CD) war gar nicht bzw. falsch initialisiert.

Das Object FsngColumnsOwner hat den falschen Typ beim Create

Viele Grüße
Thomas

[t2000]

Für die Interessierten, hier der Code, der anscheinend funktioniert:

Delphi-Quellcode:

//*******************
// Basisunit
//*******************
type
  TsngColumnsOwnerClass = class of TsngColumnsOwner;

  TsngColumnsOwner = class
  private
    FInitialized: Boolean;
  protected
    function CreateColumns: TsngColumns; virtual;
  public
    constructor Create; virtual;
    destructor Destroy; override;
    property Initialized: Boolean read FInitialized write FInitialized;
  end;

  TsngColumnDescription = class
  private
    class var FInstance: TsngColumnDescription;
  protected
    FsngColumnsOwner: TsngColumnsOwner;
    function GetSngColumnsOwner: TsngColumnsOwner; virtual;
  public
    constructor Create( AClass: TsngColumnsOwnerClass);
    class function this( AClass: TsngColumnsOwnerClass): TsngColumnDescription; virtual;
    class destructor Destroy;
    property CD: TsngColumnsOwner read GetSngColumnsOwner;
  end;


{ TsngColumnsOwner }

constructor TsngColumnsOwner.Create;
begin
  inherited Create;
  FInitialized := False;
end;

destructor TsngColumnsOwner.Destroy;
begin
  inherited Destroy;
end;

function TsngColumnsOwner.CreateColumns: TsngColumns;
begin
  Result := TsngColumns.Create(Self);
end;

{ TsngColumnDescription }

class destructor TsngColumnDescription.Destroy;
begin
  if Assigned( FInstance) then begin
    FInstance.FsngColumnsOwner.Free;
    FreeAndNil( FInstance);
  end;
end;

constructor TsngColumnDescription.Create( AClass: TsngColumnsOwnerClass);
begin
  Inherited Create;
  FsngColumnsOwner := AClass.Create;
end;

class function TsngColumnDescription.this( AClass: TsngColumnsOwnerClass): TsngColumnDescription;
begin
  if not Assigned( FInstance) then begin
    FInstance := TsngColumnDescription.Create( AClass);
  end;
  Result := FInstance;
end;

function TsngColumnDescription.GetSngColumnsOwner: TsngColumnsOwner;
begin
  Result := FsngColumnsOwner;
end;


//***************************
// Beispiel Unit Ableitung   
//***************************

type
  TColKaoPfand = class( TsngColumnDescription)
  protected
    function GetSngColumnsOwner: TkaoPfandColumnDescription; reintroduce;
  public
    class function this: TColKaoPfand; reintroduce;
    property CD: TkaoPfandColumnDescription read GetSngColumnsOwner;
  end;

class function TColKaoPfand.this: TColKaoPfand;
begin
  Result := TColKaoPfand( inherited this( TkaoPfandColumnDescription));
end;

function TColKaoPfand.GetSngColumnsOwner: TkaoPfandColumnDescription;
begin
  Result := TkaoPfandColumnDescription( inherited GetSngColumnsOwner);
end;

Das Object TkaoPfandColumnDescription: TSngColumnsOwner kann dann beliebig aussehen.

[t2000]

Nur noch eine kleine Anmerkung.
Wenn ich hier von Singleton rede, meine ich Singleton LIGHT.
Natürlich habe ich keinen Schutz vor Missbrauch drin.
Es ist nur für unser Projekt, bei dem eine globale Struktur gebraucht wird, die sich beim ersten Zugriff erst initialisiert.

[Uwe Raabe]

Das könnte man auch etwas eleganter mit Generics lösen.

Zunächst ein generischer Singleton (Light):

Delphi-Quellcode:

type
  TSingleton<T:class, constructor> = class
  strict private
  class var
    FInstance: T;
    class destructor DestroyClass;
  private
    class function GetInstance: T; static;
  public
    class property Instance: T read GetInstance;
  end;

class destructor TSingleton<T>.DestroyClass;
begin
  FInstance.Free;
end;

class function TSingleton<T>.GetInstance: T;
begin
  if FInstance = nil then
    FInstance := T.Create;
  result := FInstance;
end;

Dann die zwei Basisklassen, wobei die Description Klasse einen generischen Owner erhält (die TsngColumns habe ich weggelassen):

Delphi-Quellcode:

type
  TsngColumnsOwner = class
  private
    FInitialized: Boolean;
  public
    constructor Create; virtual;
    destructor Destroy; override;
    property Initialized: Boolean read FInitialized write FInitialized;
  end;

type
  TsngColumnDescription<TOwner: TsngColumnsOwner, constructor> = class
  protected
    FsngColumnsOwner: TOwner;
    function GetSngColumnsOwner: TOwner;
  public
    constructor Create; virtual;
    destructor Destroy; override;
    property CD: TOwner read GetSngColumnsOwner;
  end;

{ TsngColumnsOwner }

constructor TsngColumnsOwner.Create;
begin
  inherited Create;
  FInitialized := False;
end;

{ TsngColumnDescription }

destructor TsngColumnDescription<TOwner>.Destroy;
begin
  FsngColumnsOwner.Free;
  inherited;
end;

constructor TsngColumnDescription<TOwner>.Create;
begin
  inherited Create;
  FsngColumnsOwner := TOwner.Create;
end;

function TsngColumnDescription<TOwner>.GetSngColumnsOwner: TOwner;
begin
  Result := FsngColumnsOwner;
end;

Die Ableitungen sehen dann so aus (erspart die overrides):

Delphi-Quellcode:

type
  TkaoPfandColumnDescription = class(TsngColumnsOwner);
  TColKaoPfand = class( TsngColumnDescription<TkaoPfandColumnDescription>);

Und der Zugriff auf den TColKaoPfand-Singleton geht dann so:

Delphi-Quellcode:

begin
  var ColKaoPfand := TSingleton<TColKaoPfand>.Instance;
  if not ColKaoPfand.CD.Initialized then
    ShowMessage(ColKaoPfand.CD.ClassName);
end;

Der Unterschied ist, dass der Singleton nicht mehr an die Basisklasse gebunden ist, sondern eine generische Klasse ist. Diese funktioniert mit allen Klassen, die einen parameterlosen Constructor haben.

Die generische TsngColumnDescription benötigt die Angabe der Owner-Klasse nur bei der Deklaration und nicht mehr beim Create.

[freimatz]

Zitat von t2000:

Warum findet man die Fehler immer erst, wenn man darüber diskutiert oder schreibt

Siehe auch: https://de.wikipedia.org/wiki/Quiets...chen-Debugging

[Uwe Raabe]

Hatte ich noch vergessen zu erwähnen: Die Namensgebung ist etwas verwirrend.

Delphi-Quellcode:

type
  TColKaoPfand = class( TsngColumnDescription)
  protected
    function GetSngColumnsOwner: TkaoPfandColumnDescription; reintroduce;
  public
    class function this: TColKaoPfand; reintroduce;
    property CD: TkaoPfandColumnDescription read GetSngColumnsOwner;
  end;

Die Begriffe Description und Owner werden hier ziemlich durcheinander gewürfelt.

[haentschman]

https://de.wikipedia.org/wiki/Quiets...chen-Debugging
...was es nicht alles gibt. Vor Allem das es einen Namen dafür gibt...

[t2000]

Zitat von Uwe Raabe:

Hatte ich noch vergessen zu erwähnen: Die Namensgebung ist etwas verwirrend.

...

Die Begriffe Description und Owner werden hier ziemlich durcheinander gewürfelt.

Ja das stimmt vieleicht. Ich habe in der Erklärung (diesmal ausnahmsweise nicht nicht abstrahiert) einen Teil weggelassen. Bevor ich dann "Dinge" zur Nutzung (auch bei uns intern) freigebe, überprüfe ich immer nochmal die Benennung.
Danke für die Hinweise