Generische Interface-Liste

[s.h.a.r.k]

So, nun habe ich das nächste Problem mit den Interfaces, in die ich mich eigentlich echt verliebt habe... Wenn man das beherrscht wirkt mein alter Code sowas von fest verdrahtet... Naja, back to topic now!

Folgende Deklarationen habe ich (sehr stark vereinfachte Form) -- Ziel des ganzen soll es sein TInterfaceList durch eine generische, einfachere Liste zu ersetzen.

Delphi-Quellcode:

// Generisches Interface als Schnittstelle für die InterfaceList
// stark gekürzt!
IGenericInterfaceList<T: IInterface> = interface
  ['{72C2E8C9-9854-474D-895C-850A3B5B3D9F}']
  function Get(Index: Integer): T;
end;

// Generische Interface-Liste, implementiert generisches InterfaceList-Interface
TGenericInterfaceList<T: IInterface> = class(TInterfacedObject, IGenericInterfaceList<T>)
public
  FInterfaces : TInterfaceList;
  function Get(Index: Integer): T;
end;

// Einfach die eine Methode implementiert
function TGenericInterfaceList<T>.Get(Index: Integer): T;
begin
  Result := FInterfaces[Index];
end;


// --------------------------------------------
//  Irgendwo anders...
// --------------------------------------------

// Einfach ein simples Interface...
IBlub = interface(IInterface)
  ['{94C4FB45-05EB-4078-A9DE-8A09132F1006}']
end;

// Benutzung des ganzen...
procedure UseItA();
var
  A : TGenericInterfaceList<IBlub>;
begin
  A := TGenericInterfaceList<IBlub>.Create();
end;

procedure UseItB();
var
  B : IGenericInterfaceList<IBlub>;
begin
  B := TGenericInterfaceList<IBlub>.Create();
end;

Solange die beiden Methoden UseItA oder UseItB aus dem Programmcode entfernt werden, ist alles okay und das Programm compiliert. Sobald ich aber die beiden Methoden einfüge, compiliert mein Programm nicht mehr, die IDE wirft mich innerhalb der Unit ans Ende und gibt mir diesen Fehler aus:

Code:

[DCC Fehler] Unit1.pas(61): E2010 Inkompatible Typen: 'IBlub' und 'IInterface'

Hatte gedacht, dass alle Interface von IInterface "abgeleitet" sind?! Ist dem nicht so? Anders gefragt: wie kann ich dann sicherstellen, dass TGenericInterfaceList nur Interfaces aufnimmt?!

[Stevie]

Das ist das Problem:

Delphi-Quellcode:

function TGenericInterfaceList<T>.Get(Index: Integer): T;
begin
  Result := FInterfaces[Index];
end;

[s.h.a.r.k]

DANKE!!! :stupid: Da wäre ich meiner Lebtage nie drauf gekommen... Drängt sich mir die Frage auf, wie oft du dieses Problem schon hattest?! :mrgreen:

[Stevie]

Das konkrete Problem noch nie, aber nachdem ich den von dir geposteten Code kompiliert habe und bei beiden Prozeduren der Fehler kam, blieb ja nur noch die einzige Methode in der Klasse. Und dort fiel mir dann auf, dass ein IInterface in der Tat nicht zuweisungskompatibel zu einem IBlub ist :)

[s.h.a.r.k]

Hm... Okay, das habe ich wahrlich übersehen. An dieser Stelle nochmals vielen Dank! Hat mir echt viel Zeit erspart!

Anbei habe ich mal diese generische InterfaceList. Vielleicht hilft diese ja mal jemanden. Von der Lizenz her: macht damit was ihr wollt :)

PS: Das Alpha im Dateinamen deutet darauf hin, dass es sich noch um eine Unit handelt, für die es keinen Test gibt. Somit ist der Code mit Vorsicht zu behandeln. Bei mir klappt bisher alles damit.

[jaenicke]

Das Problem, dass die konkrete Fehlerstelle nicht gefunden wird, ist aber typisch für Generics. Das hat wohl jeder, der sich damit intensiver beschäftigt, irgendwann.

Kleiner Tipp:
Produziere Syntaxfehler, kompiliere und gehe dabei immer weiter nach unten in der Unit. In der Regel kannst du so die Fehlerstelle sehr genau lokalisieren. Direkt über der Stelle eingebaut wird noch der Syntaxfehler gefunden, direkt darunter ans Ende der Unit gesprungen. ;-)

[s.h.a.r.k]

Zitat:

Zitat von jaenicke (Beitrag 1149937)

Das Problem, dass die konkrete Fehlerstelle nicht gefunden wird, ist aber typisch für Generics. Das hat wohl jeder, der sich damit intensiver beschäftigt, irgendwann.

Kleiner Tipp:
Produziere Syntaxfehler, kompiliere und gehe dabei immer weiter nach unten in der Unit. In der Regel kannst du so die Fehlerstelle sehr genau lokalisieren. Direkt über der Stelle eingebaut wird noch der Syntaxfehler gefunden, direkt darunter ans Ende der Unit gesprungen. ;-)

*autsch* :wall: Also... Äh... Herzlichen Dank für den Tipp, aber selten habe ich einen dreckigeren Workaround gesehen :mrgreen: Aber gut zu wissen... Mit Generics hattte ich teilweise wahrlich so meine Probleme...

[jaenicke]

Dreckig oder nicht, Hauptsache er spart Zeit und ist im Endergebnis nicht negativ enthalten. :mrgreen:

[s.h.a.r.k]

Zitat:

Zitat von Stevie (Beitrag 1149932)

Das konkrete Problem noch nie, aber nachdem ich den von dir geposteten Code kompiliert habe und bei beiden Prozeduren der Fehler kam, blieb ja nur noch die einzige Methode in der Klasse. Und dort fiel mir dann auf, dass ein IInterface in der Tat nicht zuweisungskompatibel zu einem IBlub ist :)

An dieser Stelle muss ich leider noch nachfragen, wie ich denn den Cast hier vornehmen sollte? Das Problem ist, dass wenn ich den folgenden Code verwende, irgendwas ungültiges zurückgegeben wird, jedenfalls keine passende Interface-Referenz.

Delphi-Quellcode:

function TGenericInterfaceList<T>.Get(Index: Integer): T;
begin
  Result := T(FInterfaces[Index]);
end;

// Verwendung...
type
  IBlub = interface
    ['{4353CB3B-8829-4667-9E72-69702D43CCAE}']
    procedure Execute();
  end;

var
  BL : TGenericInterfaceList<IBlub>;
begin
  BL := TGenericInterfaceList<IBlub>.Create();
  BL.Add(TBlub.Create());

  // Funktioniert...
  (BL[0] as IBblub).Execute();
  
  // Funktioniert nicht...
  BL[0].Execute();

Hier die Fehlermeldung, die beim zweiten Aufruf von Execute erscheint:

Code:

Im Projekt Project1.exe ist eine Exception der Klasse $C0000005 mit der Meldung 'access violation at 0x00000001: read of address 0x00000001' aufgetreten.

Was ich schon probiert habe:

Delphi-Quellcode:

function TGenericInterfaceList<T>.Get(Index: Integer): T;
begin
  // E2015 Operator ist auf diesen Operandentyp nicht anwendbar
  Result := FInterfaces[Index] as T;

  // E2250 Es gibt keine überladene Version von 'Supports', die man mit diesen Argumenten aufrufen kann
  Supports(FInterfaces[Index], T, Result);
end;

Ich will definitiv auf diesen Cast (BL[0] as IBlub) verzichten, daher auch die Generics... Aber wie?

[stahli]

Ohne, dass ich hier wirklich mitreden könnte, finde ich verdächtig, dass Du der List ein Objekt und nicht ein Interface zuweist:

Delphi-Quellcode:

BL.Add(TBlub.Create());

Reagiert der Compiler vielleicht darauf nicht ausreichend?

[einbeliebigername]

Hallo,

Zitat:

Zitat von s.h.a.r.k (Beitrag 1149913)

Delphi-Quellcode:

// Generische Interface-Liste, implementiert generisches InterfaceList-Interface
TGenericInterfaceList<T: IInterface> = class(TInterfacedObject, IGenericInterfaceList<T>)
public
  FInterfaces : TInterfaceList;
  function Get(Index: Integer): T;
end;

Mit Interfaces in Verbindung mit generischen Listen habe ich zwar noch nichts gemacht aber sollte es nicht so gehen?

Delphi-Quellcode:

// Generische Interface-Liste, implementiert generisches InterfaceList-Interface
TGenericInterfaceList<T: IInterface> = class(TInterfacedObject, IGenericInterfaceList<T>)
public
  FInterfaces : TList<T>;
  function Get(Index: Integer): T;
end;

Und dann ohne Cast.

einbeliebigername.

[mjustin]

Zitat:

Ziel des ganzen soll es sein TInterfaceList durch eine generische, einfachere Liste zu ersetzen.

Ginge das nicht auch mit Generics.Collections.TList<IMeinInterface> ?

[Stevie]

@Stahli: Da das Add von der generischen Liste ist, wird der Wert, der dort reingegeben wird, vom Typ T sein ;)

Lösung:

Delphi-Quellcode:

function TGenericInterfaceList<T>.Get(Index: Integer): T;
begin
  Result := T(FInterfaces[Index]);
end;

Warum kein cast oder Supports? Na, weil das Interface, was du beim Add hineingibst, schon vom Typ T ist, was aber auch ein IInterface ist (Typeconstraint). Deshalb stehen in FInterfaces immer interface Referenzen vom Typ T. Und deshalb kannst du es einfach wieder umcasten.

@XE2 Benutzer:
Hier wurden (mit Update 3 glaube ich) die Typecasts bei Generics etwas restriktiver. Deshalb muss man dort bei manchen solcher Typecasts einen kleinen Umweg über PPointer gehen. Das aber, meine ich mich zu erinnern, nur wenn man von T auf einen konkreten Typ möchte, welcher zwar durch die Programmlogik korrekt ist aber nicht über einen Typeconstraint gegeben ist.

Zitat:

Zitat von mjustin (Beitrag 1150311)

Zitat:

Ziel des ganzen soll es sein TInterfaceList durch eine generische, einfachere Liste zu ersetzen.

Ginge das nicht auch mit Generics.Collections.TList<IMeinInterface> ?

Generics.Collections Klassen haben keine Interfaces.

[stahli]

Zitat:

Zitat von Stevie (Beitrag 1150312)

@Stahli: Da das Add von der generischen Liste ist, wird der Wert, der dort reingegeben wird, vom Typ T sein ;)

Ja epent! :stupid:

Ich hätte mir vorstellen können, dass man der Liste ein Interface (IBlub) zuweisen muss, statt einem Objekt (TBlub).

Delphi-Quellcode:

// also statt:
  BL := TGenericInterfaceList<IBlub>.Create();
  BL.Add(TBlub.Create());

// besser:
  BL := TGenericInterfaceList<IBlub>.Create();
  BL.Add(TBlub.Create() as IBlub);

... oder so. Ich hätte erwartet, dass der Compiler ein Objekt direkt ablehnt.

Aber ich steige hier erst mal besser wieder aus und rede in 1-2 Jahren wieder zu dem Thema mit. :duck:

[Stevie]

Zitat:

Zitat von stahli (Beitrag 1150325)

Zitat:

Zitat von Stevie (Beitrag 1150312)

@Stahli: Da das Add von der generischen Liste ist, wird der Wert, der dort reingegeben wird, vom Typ T sein ;)

Ja epent! :stupid:

Nur, weil da TBlub.Create steht, wird noch lang kein TBlub in Add hineingegeben, sondern ein IBlub, denn das ist in diesem Fall T. Wenn eine Klasse A ein Interface B implementiert, sind Instanzen von Klasse A davon direkt zuweisungskompatibel zu Variablen vom Interface B.

[s.h.a.r.k]

Zitat:

Zitat von Stevie (Beitrag 1150312)

Lösung:

Delphi-Quellcode:

function TGenericInterfaceList<T>.Get(Index: Integer): T;
begin
  Result := T(FInterfaces[Index]);
end;

Genau diese Lösung habe ich ja im Moment und diese funktioniert nicht!

Zitat:

Zitat von Stevie (Beitrag 1150312)

@XE2 Benutzer:
Hier wurden (mit Update 3 glaube ich) die Typecasts bei Generics etwas restriktiver. Deshalb muss man dort bei manchen solcher Typecasts einen kleinen Umweg über PPointer gehen. Das aber, meine ich mich zu erinnern, nur wenn man von T auf einen konkreten Typ möchte, welcher zwar durch die Programmlogik korrekt ist aber nicht über einen Typeconstraint gegeben ist.

Hast du hierzu mehr Informationen? Was genau in Bezug auf PPointer? Ich habe XE2, Update 3 installiert (und ja, ich weiß, dass es Update 4 gibt) und obige Lösung funktioniert leider nicht :evil: Ich habe echt keine Ahnung warum nicht... Sowas nervt ungemein...

Zitat:

Zitat von Stevie (Beitrag 1150312)

Generics.Collections Klassen haben keine Interfaces.

Darüber hatte ich mich ja gewundert und daher habe ich diese Liste entworfen...

[Stevie]

Hätt schwören können, da stand gestern was anderes, egal.

Hab nicht dran gedacht, dass beim Add in die TInterfaceList auch nen QueryInterface gemacht wird, also wird T dann wieder auf IInterface "gecastet". Das musst du dann beim Get wieder umdrehen:

Delphi-Quellcode:

function TGenericInterfaceList<T>.Get(Index: Integer): T;
begin
  FInterfaces[Index].QueryInterface(GetTypeData(TypeInfo(T)).Guid, Result);
end;

Bis XE2 Update 2 ging folgendes:

Delphi-Quellcode:

type
  TFoo<T> = class
    FValue: T;
    function GetAsObject: TObject;
  end;

function TFoo<T>.GetAsObject: TObject;
begin
  Result := TObject(FValue);
end;

"Mach doch nen constraint drauf" mag jemand sagen. Stimmt, solang ich nur Objekte reinpacken will. Eventuell will ich aber Interfaces und Objekte damit verwalten und dann macht sowas eventuell Sinn.

Jedenfalls muss man ab Update 3 dann sowas schreiben:

Delphi-Quellcode:

function TFoo<T>.GetAsObject: TObject;
begin
  Result := TObject(PPointer(@FValue)^);
end;

Wenn du generische Listen mit entsprechenden Interfaces haben möchtest, schau dir eventuell Delphi Coll oder Spring an.

[s.h.a.r.k]

Zitat:

Zitat von Stevie (Beitrag 1150485)

Hätt schwören können, da stand gestern was anderes, egal.

Hab nicht dran gedacht, dass beim Add in die TInterfaceList auch nen QueryInterface gemacht wird, also wird T dann wieder auf IInterface "gecastet". Das musst du dann beim Get wieder umdrehen:

Delphi-Quellcode:

function TGenericInterfaceList<T>.Get(Index: Integer): T;
begin
  FInterfaces[Index].QueryInterface(GetTypeData(TypeInfo(T)).Guid, Result);
end;

Wuhu... Das funktioniert einwandfrei!!! Danke dir vielmals! :thumb: Jetzt weiß ich auch, wie man an die GUID eines Interfaces kommt. Tausend Dank!

[stahli]

Zitat:

Zitat von stahli (Beitrag 1150325)

Aber ich steige hier erst mal besser wieder aus und rede in 1-2 Jahren wieder zu dem Thema mit. :duck:

Jetzt sind es glatt 8 Jahre später und ich hatte jetzt mal das gleiche Problem (und bin bei der Lösungssuche auf den Thread hier gestoßen). ;-)

Mit meinem Projekt bin ich noch nicht ganz zurecht gekommen und habe mal ein kleines Testprojekt aufgebaut, um hier nochmal konkret nachzufragen.
Damit funktioniert es jedoch korrekt... :-)

Also stelle ich es mal hier ein, falls es jemand nachvollziehen möchte bzw. gebrauchen kann:
(Real sind die Klassen natürlich in verschiedene Klassen aufgeteilt, wird eine Factory benutzt usw.)

Delphi-Quellcode:

program GenInterfacesTest;

{$APPTYPE CONSOLE}
{$R *.res}

uses
  Generics.Collections;

type

  // Base

  IItem = interface
    ['{836A887A-1687-4BC3-8534-18BA517D322D}']
    procedure Go;
  end;

  IItemList<T: IItem> = interface(IItem)
    ['{D231E719-50DE-410A-BF54-CC65487B860A}']
    procedure Add(const aItem: T);
    function GetFirstItem: T;
    function _get_Item(Index: Integer): T;
    procedure _set_Item(Index: Integer; aItem: T);
    property Items[Index: Integer]: T read _get_Item write _set_Item; default;
  end;

  TItem = class(TInterfacedObject, IItem)
    procedure Go;
  end;

  TItemList<T: IItem> = class(TItem, IItemList<T>)
    fItems: TList<IItem>;
    procedure Add(const aItem: T);
    function GetFirstItem: T;
    function _get_Item(Index: Integer): T;
    procedure _set_Item(Index: Integer; aItem: T);
    property Items[Index: Integer]: T read _get_Item write _set_Item; default;
    constructor Create; virtual;
    destructor Destroy; override;
  end;

  // Logic

  IZoo = interface;
  TZoo = class;

  IHund = interface;
  THund = class;

  IHundList = interface;
  THundList = class;

  IKatze = interface;
  TKatze = class;

  IKatzeList = interface;
  TKatzeList = class;

  IZoo = interface(IItem)
    ['{428FD0E8-8600-430A-9CE6-AA361509FB54}']
    function _get_HundList: IHundList;
    procedure _set_HundList(const aValue: IHundList);
    property HundList: IHundList read _get_HundList write _set_HundList;
    function _get_KatzeList: IKatzeList;
    procedure _set_KatzeList(const aValue: IKatzeList);
    property KatzeList: IKatzeList read _get_KatzeList write _set_KatzeList;
  end;

  TZoo = class(TItem, IZoo)
    fHundList: IHundList;
    fKatzeList: IKatzeList;
    function _get_HundList: IHundList;
    procedure _set_HundList(const aValue: IHundList);
    property HundList: IHundList read _get_HundList write _set_HundList;
    function _get_KatzeList: IKatzeList;
    procedure _set_KatzeList(const aValue: IKatzeList);
    property KatzeList: IKatzeList read _get_KatzeList write _set_KatzeList;
    constructor Create; virtual;
    destructor Destroy; override;
  end;

  IHund = interface(IItem)
    ['{956269E2-F70B-4499-B18B-0492CF47CA5B}']
    procedure Wuff;
  end;

  IHundList = interface(IItemList<IHund>)
    ['{331D5BD0-8568-47B5-886D-417BCDAC23B9}']
  end;

  THund = class(TItem, IHund)
    procedure Wuff;
  end;

  THundList = class(TItemList<IHund>, IHundList)
  end;

  IKatze = interface(IItem)
    ['{1D834E0A-1A69-4D7C-9817-F60EE75C4ACB}']
    procedure Miau;
  end;

  IKatzeList = interface(IItemList<IKatze>)
    ['{EC5E64F4-88D5-4E25-9E4C-50F79F0F9395}']
  end;

  TKatze = class(TItem, IKatze)
    procedure Miau;
  end;

  TKatzeList = class(TItemList<IKatze>, IKatzeList)
  end;

var
  Zoo: IZoo;
  Hund: IHund;
  Katze: IKatze;

  { TItem }

procedure TItem.Go;
begin
  //
end;

{ TItemList<T> }

procedure TItemList<T>.Add(const aItem: T);
begin
  fItems.Add(aItem);
end;

constructor TItemList<T>.Create;
begin
  fItems := TList<IItem>.Create;
end;

destructor TItemList<T>.Destroy;
begin
  fItems.Free;
  inherited;
end;

function TItemList<T>.GetFirstItem: T;
begin
  Result := T(fItems[0]);
end;

function TItemList<T>._get_Item(Index: Integer): T;
begin
  Result := T(fItems[Index]);
end;

procedure TItemList<T>._set_Item(Index: Integer; aItem: T);
begin
  fItems[Index] := aItem;
end;

{ TZoo }

constructor TZoo.Create;
begin
  HundList := THundList.Create;
  KatzeList := TKatzeList.Create;
end;

destructor TZoo.Destroy;
begin
  HundList := nil;
  KatzeList := nil;
  inherited;
end;

function TZoo._get_HundList: IHundList;
begin
  Result := fHundList;
end;

function TZoo._get_KatzeList: IKatzeList;
begin
  Result := fKatzeList;
end;

procedure TZoo._set_HundList(const aValue: IHundList);
begin
  fHundList := aValue;
end;

procedure TZoo._set_KatzeList(const aValue: IKatzeList);
begin
  fKatzeList := aValue;
end;

{ THund }

procedure THund.Wuff;
begin
  //
end;

{ TKatze }

procedure TKatze.Miau;
begin
  //
end;

begin

  Zoo := TZoo.Create;

  Hund := THund.Create;
  Zoo.HundList.Add(Hund);

  Katze := TKatze.Create;
  Zoo.KatzeList.Add(Katze);

  Hund := Zoo.HundList.GetFirstItem;
  Katze := Zoo.KatzeList.GetFirstItem;

  Zoo.HundList[0] := Hund;
  Hund := Zoo.HundList[0];

  Zoo.KatzeList[0] := Katze;
  Katze := Zoo.KatzeList[0];

end.

[himitsu]

Eigentlich kann es nicht so richtig funktionieren.
Jedenfalls hätte man so im Minimum mehrfach die selbe GUID im System, was ein bissl dem System der Interfaces wiederspricht.

[stahli]

Wieso?
Jedes Interface hat doch seine eigne Guid. Deswegen ja gerade die ganzen Ableitungen.

Mein komplexes Projekt kompiliert jetzt auch nach ein paar Anpassungen.
Ich hoffe, dass ich das jetzt nicht nochmal verwerfen muss. :|

[TiGü]

So so, jedes Interface hat seine eigene GUID?

Delphi-Quellcode:

    if Supports(Zoo.KatzeList, IItemList<IHund>, HundeListe) then
    begin
      Writeln('Waumiau');
      HundeListe.Add(Hund);
    end;

    if Supports(Zoo.HundList, IItemList<IKatze>, KatzenListe) then
    begin
      Writeln('Miauwau');
      KatzenListe.Add(Katze);
    end;

Und warum sind die Listen von einem Eintrag abgeleitet?
Kommt dir das nicht schon beim Schreiben komisch vor?
Würdest du auch ein TAutohaus von TAuto ableiten?
Oder ein TAutozug von TAuto?

Über diese merkwürdige Getter- und Setterschreibweise will ich mich gar nicht auslassen.
Dafür haben meine Augen schon zuviel gesehen.

Vollständiges Copy & Paste Beispiel:

Delphi-Quellcode:

program Project1;

{$APPTYPE CONSOLE}

{$R *.res}


uses
  System.SysUtils,
  System.Generics.Collections;

type

  // Base

  IItem = interface
    ['{836A887A-1687-4BC3-8534-18BA517D322D}']
    procedure Go;
  end;

  IItemList<T: IItem> = interface(IItem)
    ['{D231E719-50DE-410A-BF54-CC65487B860A}']
    procedure Add(const aItem: T);
    function GetFirstItem: T;
    function _get_Item(Index: Integer): T;
    procedure _set_Item(Index: Integer; aItem: T);
    property Items[Index: Integer]: T read _get_Item write _set_Item; default;
  end;

  TItem = class(TInterfacedObject, IItem)
    procedure Go;
  end;

  TItemList<T: IItem> = class(TItem, IItemList<T>)
    fItems: TList<IItem>;
    procedure Add(const aItem: T);
    function GetFirstItem: T;
    function _get_Item(Index: Integer): T;
    procedure _set_Item(Index: Integer; aItem: T);
    property Items[Index: Integer]: T read _get_Item write _set_Item; default;
    constructor Create; virtual;
    destructor Destroy; override;
  end;

  // Logic

  IZoo = interface;
  TZoo = class;

  IHund = interface;
  THund = class;

  IHundList = interface;
  THundList = class;

  IKatze = interface;
  TKatze = class;

  IKatzeList = interface;
  TKatzeList = class;

  IZoo = interface(IItem)
    ['{428FD0E8-8600-430A-9CE6-AA361509FB54}']
    function _get_HundList: IHundList;
    procedure _set_HundList(const aValue: IHundList);
    property HundList: IHundList read _get_HundList write _set_HundList;
    function _get_KatzeList: IKatzeList;
    procedure _set_KatzeList(const aValue: IKatzeList);
    property KatzeList: IKatzeList read _get_KatzeList write _set_KatzeList;
  end;

  TZoo = class(TItem, IZoo)
    fHundList: IHundList;
    fKatzeList: IKatzeList;
    function _get_HundList: IHundList;
    procedure _set_HundList(const aValue: IHundList);
    property HundList: IHundList read _get_HundList write _set_HundList;
    function _get_KatzeList: IKatzeList;
    procedure _set_KatzeList(const aValue: IKatzeList);
    property KatzeList: IKatzeList read _get_KatzeList write _set_KatzeList;
    constructor Create; virtual;
    destructor Destroy; override;
  end;

  IHund = interface(IItem)
    ['{956269E2-F70B-4499-B18B-0492CF47CA5B}']
    procedure Wuff;
  end;

  IHundList = interface(IItemList<IHund>)
    ['{331D5BD0-8568-47B5-886D-417BCDAC23B9}']
  end;

  THund = class(TItem, IHund)
    procedure Wuff;
  end;

  THundList = class(TItemList<IHund>, IHundList)
  end;

  IKatze = interface(IItem)
    ['{1D834E0A-1A69-4D7C-9817-F60EE75C4ACB}']
    procedure Miau;
  end;

  IKatzeList = interface(IItemList<IKatze>)
    ['{EC5E64F4-88D5-4E25-9E4C-50F79F0F9395}']
  end;

  TKatze = class(TItem, IKatze)
    procedure Miau;
  end;

  TKatzeList = class(TItemList<IKatze>, IKatzeList)
  end;

  { TItem }

procedure TItem.Go;
begin
  //
end;

{ TItemList<T> }

procedure TItemList<T>.Add(const aItem: T);
begin
  fItems.Add(aItem);
end;

constructor TItemList<T>.Create;
begin
  fItems := TList<IItem>.Create;
end;

destructor TItemList<T>.Destroy;
begin
  fItems.Free;
  inherited;
end;

function TItemList<T>.GetFirstItem: T;
begin
  Result := T(fItems[0]);
end;

function TItemList<T>._get_Item(Index: Integer): T;
begin
  Result := T(fItems[Index]);
end;

procedure TItemList<T>._set_Item(Index: Integer; aItem: T);
begin
  fItems[Index] := aItem;
end;

{ TZoo }

constructor TZoo.Create;
begin
  HundList := THundList.Create;
  KatzeList := TKatzeList.Create;
end;

destructor TZoo.Destroy;
begin
  HundList := nil;
  KatzeList := nil;
  inherited;
end;

function TZoo._get_HundList: IHundList;
begin
  Result := fHundList;
end;

function TZoo._get_KatzeList: IKatzeList;
begin
  Result := fKatzeList;
end;

procedure TZoo._set_HundList(const aValue: IHundList);
begin
  fHundList := aValue;
end;

procedure TZoo._set_KatzeList(const aValue: IKatzeList);
begin
  fKatzeList := aValue;
end;

{ THund }

procedure THund.Wuff;
begin
  //
end;

{ TKatze }

procedure TKatze.Miau;
begin
  //
end;

var
  Zoo: IZoo;
  Hund: IHund;
  Katze: IKatze;
  HundeListe: IItemList<IHund>;
  KatzenListe: IItemList<IKatze>;

begin
  try
    Zoo := TZoo.Create;

    Hund := THund.Create;
    Zoo.HundList.Add(Hund);

    Katze := TKatze.Create;
    Zoo.KatzeList.Add(Katze);

    if Supports(Zoo.KatzeList, IItemList<IHund>, HundeListe) then
    begin
      Writeln('Waumiau');
      HundeListe.Add(Hund);
    end;

    if Supports(Zoo.HundList, IItemList<IKatze>, KatzenListe) then
    begin
      Writeln('Miauwau');
      KatzenListe.Add(Katze);
    end;

    Hund := Zoo.HundList.GetFirstItem;
    Katze := Zoo.KatzeList.GetFirstItem;

    Zoo.HundList[0] := Hund;
    Hund := Zoo.HundList[0];

    Zoo.KatzeList[0] := Katze;
    Katze := Zoo.KatzeList[0];
  except
    on E: Exception do
      Writeln(E.ClassName, ': ', E.Message);
  end;
  Readln;
end.

[stahli]

Danke. Ich fange mal hinten an:

3) Die Getter und Setter benenne ich so, damit sofort auffällt, dass diese nicht per Code aufgerufen werden sollten. (Im Gegensatz zu "GetKontostand").

2) Die Ableitung der ListenInterfaces stammt aus einem anderen Projekt. In einer Liste werden Interfaces verwaltet, die von einem bestimmten Typ sind. Manche können wiederum andere Interfaces verwalten.
Hätte ich hier nicht so machen müssen. Ich hatte das aber in meinem jetzigen Projekt einfach mal übernommen (und so auch in der Demo) und sehe das nicht unbedingt als problematisch an - maximal als unnötig.

1) Supports habe ich nicht ausprobiert. :oops:
Das wäre natürlich schon sinnvoll gewesen. Jetzt habe ich kein Delphi verfügbar.
Allerdings ist mir heute früh eingefallen, das Basis-Listeninterface ohne Guid zu deklarieren. Das ist ja eigentlich nur "das Muster" für die Hunde- und Katzenlisten. Davon braucht es keine Instanz zu geben und das Interface wird so auch nicht genutzt.

Wie ist denn sonst die richtige Lösung dafür?

Ich kann zwar mit Ableitungen umgehen und auch mit Interfaces und Generics aber mit allem zusammen wird es schon etwas unübersichtlich.

In meinem früheren Projekt (vor ein paar Jahren) hatte ich die Listeninterfaces noch per C&P definiert und die Item-Interfaces entsprechend ersetzt (IHund -> IKatze -> IMaus).

Jetzt wollte ich das halt auch generisch lösen...

[stahli]

Was mir jetzt noch aufgefallen ist: Ich würde natürlich mit den deklarierten Interfaces arbeiten...

Delphi-Quellcode:

var
  tmpHundList: IHundList;
  tmpKatzeList: IKatzeList;

    if Supports(Zoo.HundList, IHundList, tmpHundList) then
     begin
       tmpHundList.Add(Hund); // sollte passen 
       tmpHundList.Add(Katze); // sollte nicht kompilieren 
     end;

    if Supports(Zoo.HundList, IKatzeList, tmpKatzeList) then
     begin
       Beep; // sollte nie aufgerufen werden
     end;

Ist das denn falsch?
Ich werde mir das heute Abend mal anschauen. Ohne Delphi komme ich da jetzt nicht nach.

Dann noch die Guid bei dem Basis-Listeninterface weg lassen, dann sollte das doch funktionieren...!?

[Stevie]

Man macht auf generische Interfaces einfach kein Supports, mit dem man den generischen Typenparameter ändert, Ende der Geschichte.
Dennoch ist für verschiedene Interne Verwendungszwecke eine GUID ggf notwendig.

[stahli]

Vielen Dank.

Also so passt alles. Hier nochmal für die Nachwelt komplett:

Delphi-Quellcode:

program GenInterfacesTest;

{$APPTYPE CONSOLE}
{$R *.res}

uses
  Generics.Collections, WinApi.Windows, SysUtils;

type

  // Base

  IItem = interface
    ['{836A887A-1687-4BC3-8534-18BA517D322D}']
    procedure Go;
  end;

  IItemList<T: IItem> = interface(IItem)
    ['{D231E719-50DE-410A-BF54-CC65487B860A}']
    procedure Add(const aItem: T);
    function GetFirstItem: T;
    function _get_Item(Index: Integer): T;
    procedure _set_Item(Index: Integer; aItem: T);
    property Items[Index: Integer]: T read _get_Item write _set_Item; default;
  end;

  TItem = class(TInterfacedObject, IItem)
    procedure Go;
  end;

  TItemList<T: IItem> = class(TItem, IItemList<T>)
    fItems: TList<IItem>;
    procedure Add(const aItem: T);
    function GetFirstItem: T;
    function _get_Item(Index: Integer): T;
    procedure _set_Item(Index: Integer; aItem: T);
    property Items[Index: Integer]: T read _get_Item write _set_Item; default;
    constructor Create; virtual;
    destructor Destroy; override;
  end;

  // Logic

  IZoo = interface;
  TZoo = class;

  IHund = interface;
  THund = class;

  IHundList = interface;
  THundList = class;

  IKatze = interface;
  TKatze = class;

  IKatzeList = interface;
  TKatzeList = class;

  IZoo = interface(IItem)
    ['{428FD0E8-8600-430A-9CE6-AA361509FB54}']
    function _get_HundList: IHundList;
    procedure _set_HundList(const aValue: IHundList);
    property HundList: IHundList read _get_HundList write _set_HundList;
    function _get_KatzeList: IKatzeList;
    procedure _set_KatzeList(const aValue: IKatzeList);
    property KatzeList: IKatzeList read _get_KatzeList write _set_KatzeList;
  end;

  TZoo = class(TItem, IZoo)
    fHundList: IHundList;
    fKatzeList: IKatzeList;
    function _get_HundList: IHundList;
    procedure _set_HundList(const aValue: IHundList);
    property HundList: IHundList read _get_HundList write _set_HundList;
    function _get_KatzeList: IKatzeList;
    procedure _set_KatzeList(const aValue: IKatzeList);
    property KatzeList: IKatzeList read _get_KatzeList write _set_KatzeList;
    constructor Create; virtual;
    destructor Destroy; override;
  end;

  IHund = interface(IItem)
    ['{956269E2-F70B-4499-B18B-0492CF47CA5B}']
    procedure Wuff;
  end;

  IHundList = interface(IItemList<IHund>)
    ['{331D5BD0-8568-47B5-886D-417BCDAC23B9}']
  end;

  THund = class(TItem, IHund)
    procedure Wuff;
  end;

  THundList = class(TItemList<IHund>, IHundList)
  end;

  IKatze = interface(IItem)
    ['{1D834E0A-1A69-4D7C-9817-F60EE75C4ACB}']
    procedure Miau;
  end;

  IKatzeList = interface(IItemList<IKatze>)
    ['{EC5E64F4-88D5-4E25-9E4C-50F79F0F9395}']
  end;

  TKatze = class(TItem, IKatze)
    procedure Miau;
  end;

  TKatzeList = class(TItemList<IKatze>, IKatzeList)
  end;

var
  Zoo: IZoo;
  Hund: IHund;
  Katze: IKatze;

  { TItem }

procedure TItem.Go;
begin
  //
end;

{ TItemList<T> }

procedure TItemList<T>.Add(const aItem: T);
begin
  fItems.Add(aItem);
end;

constructor TItemList<T>.Create;
begin
  fItems := TList<IItem>.Create;
end;

destructor TItemList<T>.Destroy;
begin
  fItems.Free;
  inherited;
end;

function TItemList<T>.GetFirstItem: T;
begin
  Result := T(fItems[0]);
end;

function TItemList<T>._get_Item(Index: Integer): T;
begin
  Result := T(fItems[Index]);
end;

procedure TItemList<T>._set_Item(Index: Integer; aItem: T);
begin
  fItems[Index] := aItem;
end;

{ TZoo }

constructor TZoo.Create;
begin
  HundList := THundList.Create;
  KatzeList := TKatzeList.Create;
end;

destructor TZoo.Destroy;
begin
  HundList := nil;
  KatzeList := nil;
  inherited;
end;

function TZoo._get_HundList: IHundList;
begin
  Result := fHundList;
end;

function TZoo._get_KatzeList: IKatzeList;
begin
  Result := fKatzeList;
end;

procedure TZoo._set_HundList(const aValue: IHundList);
begin
  fHundList := aValue;
end;

procedure TZoo._set_KatzeList(const aValue: IKatzeList);
begin
  fKatzeList := aValue;
end;

{ THund }

procedure THund.Wuff;
begin
  //
end;

{ TKatze }

procedure TKatze.Miau;
begin
  //
end;

var
  tmpHundList: IHundList;
  tmpKatzeList: IKatzeList;

begin

  Zoo := TZoo.Create;

  Hund := THund.Create;
  Zoo.HundList.Add(Hund);

  Katze := TKatze.Create;
  Zoo.KatzeList.Add(Katze);

  Hund := Zoo.HundList.GetFirstItem;
  Katze := Zoo.KatzeList.GetFirstItem;

  Zoo.HundList[0] := Hund;
  Hund := Zoo.HundList[0];

  Zoo.KatzeList[0] := Katze;
  Katze := Zoo.KatzeList[0];

  if Supports(Zoo.HundList, IHundList, tmpHundList) then
  begin
    tmpHundList.Add(Hund); // sollte passen
    // tmpHundList.Add(Katze); // korrekter Weise nicht kompilierbar
  end;

  if Supports(Zoo.HundList, IKatzeList, tmpKatzeList) then
  begin
    Beep; // wird korrekter Weise nie aufgerufen
  end;

end.