Base Delphi interface does not work polymorphically

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;