[fpc-pascal] inherited interfaces not seen by queryinterface / supports

[David Emerson]

Hi all,

I am a bit perplexed / disappointed to see that the Supports / 
QueryInterface functions for interfaces are not behaving the way I would 
expect them to behave, when using an interface that inherits from 
another interface.

note, _obj_type_ might be TObject, TInterfacedObject, or TComponent.

{$mode objfpc}

type
   i_1 = interface
     ['{6C8CF001-733C-4A2D-B41F-3B3FF1D266B4}']
     procedure do_one;
     end;

   i_2 = interface (i_1)
     ['{E0F0FA05-96C3-4979-A58C-5FB5F1E37214}']
     procedure do_two;
     end;

   t_2 = class (_obj_type_, i_2)
     // i_2 inherits from i_1, compiler requires i_1 implementation
     procedure do_one;
     procedure do_two;
     end;

var
   two : t_2;

It seems that Supports (two, i_1) returns false -- even though Supports 
(two, i_2) returns true, and i_2 inherits from i_1. QueryInterface 
similarly fails (for COM interfaces)

It appears to me that the only way to get a proper i_1 result from these 
functions is to define

   t_2 = class (_obj_type_, i_2, i_1)

This is redundant, and a burden when there is a hierarchy of inherited 
interfaces defined in different places.

Is there some other way, some mode or switch or something, that would 
make a class definition automatically include interface-supports for 
inherited interfaces?

(Also, in the source below there are a couple Access Violation crashes 
noted, any ideas why?)

Thanks!
~David.

Free Pascal Compiler version 3.0.0 [2015/12/05] for x86_64 (linux - debian)

Here's my full program:

program inherit_intf;

{$mode objfpc}{$H+}
{$macro on}

{$define corba}
//{$define tcomp}
//{$define tintobj}

{$ifdef corba}
   {$interfaces corba}
   {$define _intf_str_ := 'CORBA'}
{$else COM interface}
   {$interfaces com}
   {$define _intf_str_ := 'COM'}
   {$ifndef tcomp}
     {$define tintobj}
   {$endif}
{$endif}

{$ifdef tcomp}
   {$define _obj_type_ := TComponent}
   {$define _obj_str_ := 'TComponent'}
   {$define _create_param_ := nil}
{$else}
   {$define _create_param_ := }
   {$ifdef tintobj}
     {$define _obj_type_ := TInterfacedObject}
     {$define _obj_str_ := 'TInterfacedObject'}
   {$else}
     {$define _obj_type_ := TObject}
     {$define _obj_str_ := 'TObject'}
   {$endif not tintobj}
{$endif tcomp}


uses
   classes,
   sysutils;

type
   i_1 = interface
     ['{6C8CF001-733C-4A2D-B41F-3B3FF1D266B4}']
     procedure do_one;
     end;

   i_2 = interface (i_1)
     ['{E0F0FA05-96C3-4979-A58C-5FB5F1E37214}']
     procedure do_two;
     end;

   t_2 = class (_obj_type_, i_2)
     procedure do_one;
     procedure do_two;
     end;

   t_3 = class (t_2, i_1)
     end;

procedure t_2.do_one;
   begin
     writeln ('one');
   end;

procedure t_2.do_two;
   begin
     writeln ('two');
   end;

var
   two : t_2;
   three : t_3;
   res : i_1;

begin
   writeln (_intf_str_, ' / ', _obj_str_);
   two := t_2.Create (_create_param_);
   three := t_3.Create (_create_param_);
   writeln ('t_2 supports i_1? ', supports (two, i_1, res)); // 
unexpectedly FALSE
   writeln ('t_3 supports i_1? ', supports (three, i_1, res)); // TRUE
   {$ifndef corba}
     writeln ('t_2 QueryIntf i_1? ', S_OK = two.QueryInterface (i_1, 
res)); // unexpectedly FALSE
     writeln ('t_3 QueryIntf i_1? ', S_OK = three.QueryInterface (i_1, 
res)); // TRUE for TComponent. CRASH - SIGSEGV for COM + TInterfacedObject
   {$endif}
   two := three;
   writeln ('t_3 (t_2 var) supports i_1? ', supports (two, i_1, res)); 
// TRUE for TComponent. CRASH - SIGSEGV with COM + TInterfacedObject
end.