Base Delphi interface does not work polymorphically - delphi

Question

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 ISomeSpecificType1 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}

Answer 1

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;

Answer 2

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.

Answer 3

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.