Base Delphi interface does not work polymorphically

I have created a couple of interfaces to describe a collection and its items: IetCollection and IetCollectionItem. And of course I have two classes implementing these two interfaces: TetCollection and TetCollectionItem (both inheriting from TInterfacedObject.)

Then I have a series of interfaces where the top level interfaces inherits from IetCollectionItem and the rest from it (lets call them ISomeBasicType and ISomeSpecifi开发者_如何学JAVAcType1 and ISomeSpecificType2.)

The class TSomeBasicType inherits from class TetCollectionItem and also implemented ISomeBasicType. The other classes in the hierarchy inherit from TSomeBasicType and implement their respective interfaces (i.e. ISomeSpecificType1 and ISomeSpecificType2.)

When I populate a collection I use a factory method to get a reference to ISomeBasicType. Everything works just fine up to that point.

But when I try to traverse the collection and ask if a collection item supports either ISomeSpecificType1 or ISomeSpecificType2 the answer I get is no.

I have been trying to solve this problem and I have achieved nothing, so any help will be greatly appreciated.

Here is some code:

// This is the basic type
IetCollectionItem = interface
end;

// Implementation of the basic type
TetCollectionItem = class(TInterfacedObject, IetCollectionItem)
end; 

ISomeBasicType = interface(IetCollectionItem)
end; 

ISomeSpecificType1 = interface(ISomeBasicType)
end; 

// Implements ISomeBasicType, should inherit implementation of IetCollectionItem
// from TetCollectionItem
TSomeBasicType = class(TetCollectionItem, ISomeBasicType)
end; 

// Implements ISomeSpecificType1, should inherit implementation of ISomeBasicType
// from TSomeBasicType and implementation of IetCollectionItem from
// TetCollectionItem
TSomeSpecificType1 = class(TSomeBasicType, ISomeSpecificType1)
end; 

This is the code I user to populate the collection:

var
  aBaseType: ISomeBasicType;
  aSpecificType: ISomeSpecificType1;
begin
  aBaseType:= TheFactory(anID, aType);  // Returns a reference to ISomeBasicType

  if Supports(aBaseType, ISomeSpecificType1, aSpecificType) then
  begin
    // Do something to the specific type
    aTypeCollection.Add(aSpecificType);
  end
  else
    aTypeCollection.Add(aBaseType);

And here is the code which fails: I loop through the collection and I check to see if any of the items in it support one of the child interfaces.

var
  iCount: Integer;
  aBaseType: ISomeBasicType;
  aSpecificType: ISomeSpecificType1;
begin
  for iCount:= 0 to Pred(aTypeCollection.Count) do
  begin
    aBaseType:= aTypeCollection[iCount];

    // This is where Supports fails
    if Supports(aBaseType, ISomeSpecificType1, aSpecificType) then
    begin
    end;
  end;
end;

And here is the code for TheFactory:

function TheFactory(const anID: Integer; const aType: TetTypes): ISomeBasicType;
begin
  Result:= nil;

  case aType of
    ptType1 : Result:= TSomeSpecificType1.Create(anID, aType);
    ptType2 : Result:= TSomeSpecificType2.Create(anID, aType);
  end;

  Assert(Assigned(Result), rcUnknonwPhenomenonType);
end;  {TheFactory}

---

Although your code makes me quite dizzy, just from your question title I have a feeling I know where your problem is. Delphi's interface polymorphism unfortunately doesn't behave like Delphi's class polymorphism (I somewhere read that this back in the days had to do with some COM interface compatibility). The point is, that if you are querying a class instance for a specific interface Delphi only finds those interfaces that are directly listed in the class declaration, although another interface in a class declaration might have been inherited from the one you are querying for. See this simple example to understand what I mean. And sorry, if my answer completly missed your problem.

type
  TForm61 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

  IBase = interface
  ['{AE81FB3C-9159-45B0-A863-70FD1365C113}']
  end;

  IChild = interface(IBase)
  ['{515771E7-44F6-4819-9B3A-F2A2AFF74543}']
  end;

  TBase = class(TInterfacedObject, IBase)

  end;

  TChild = class(TInterfacedObject, IChild)

  end;

  TChildThatSupportsIbase = class(TChild, IBase)

  end;

var
  Form61: TForm61;

implementation

{$R *.dfm}

procedure TForm61.Button1Click(Sender: TObject);
var
  Child: IChild;
  ChildThatSupportsIbase: IChild;
begin
  Child := TChild.Create;
  ChildThatSupportsIbase:= TChildThatSupportsIbase.Create;
  if Supports(Child, IBase) then
    ShowMessage('TChild supports IBase')
  else
    ShowMessage('TChild doesn''t supports IBase');
  if Supports(ChildThatSupportsIbase, IBase) then
    ShowMessage('TChildThatSupportsIbase supports IBase')
  else
    ShowMessage('TChildThatSupportsIbase doesn''t supports IBase');
end;

---

Sample code edited to use your class hierarchy. Both Supports calls return True. I only added GUID's to your interfaces.

---

If my crystal ball is in working order, you forgot to give your interfaces GUID's.

---

Here's a proof that what I think you're asking works. If this is not what you're asking, take the hint and replace the code block with a short but complete console application that clearly displays the problem:

program Project29;

{$APPTYPE CONSOLE}

uses
  SysUtils;

type

  // This is the basic type
  IetCollectionItem = interface
  end;

  // Implementation of the basic type
  TetCollectionItem = class(TInterfacedObject, IetCollectionItem)
  end;

  ISomeBasicType = interface(IetCollectionItem)
  ['{F082CD83-5030-42EE-A1A8-FF91769F986F}']
  end;

  ISomeSpecificType1 = interface(ISomeBasicType)
  ['{8789FD5A-FC94-4F19-B28B-8ABA67D66DAE}']
  end;

  // Implements ISomeBasicType, should inherit implementation of IetCollectionItem
  // from TetCollectionItem
  TSomeBasicType = class(TetCollectionItem, ISomeBasicType)
  end;

  // Implements ISomeSpecificType1, should inherit implementation of ISomeBasicType
  // from TSomeBasicType and implementation of IetCollectionItem from
  // TetCollectionItem
  TSomeSpecificType1 = class(TSomeBasicType, ISomeSpecificType1)
  end;

var iBase: IetCollectionItem;

begin
  iBase := TSomeSpecificType1.Create;

  if Supports(iBase, iSomeBasicType) then
    WriteLn('iBase supports iSomeBasicType')
  else
    WriteLn('iBase does not support iSomeBasicType');

  if Supports(iBase, ISomeSpecificType1) then
    WriteLn('iBase supports ISomeSpecificType1')
  else
    WriteLn('iBase does not support ISomeSpecificType1');

  WriteLn('Press ENTER'); Readln;
end.

---

First you place something which clearly does NOT support ISomeSpecificType1 in the list:

 if Supports(aBaseType, ISomeSpecificType1, aSpecificType) then
  begin
    // Do something to the specific type
    aTypeCollection.Add(aSpecificType);
  end
  else
    aTypeCollection.Add(aBaseType); //<------- this

Then you wonder why it does not support ISomeSpecificType1.

What's the problem exactly? Why do you think all or even ANY of the items from the collection should support ISomeSpecificType1?

It could have been that every single item you have added did not support it.