[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.


_______________________________________________
fpc-pascal maillist  -  fpc-pascal@lists.freepascal.org
http://lists.freepascal.org/cgi-bin/mailman/listinfo/fpc-pascal