[fpc-pascal] corba interfaces - is/as not working properly

[David Emerson]

Hi all,

I'm testing out CORBA interfaces before changing all my code to use them 
(I would prefer not to have managed types for interfaces).

However I am running into a glitch. Testing "if (my_object is 
i_some_interface)" is always returning true, even when the object does 
not implement the interface. Worse, following the false positive, 
(my_object as i_some_interface) seems to be returning a *different* 
interface. Proceeding to use that interface runs functions from the 
wrongly returned interface, rather than the requested function.


Code below followed by sample output.


program corba_bug;

{$mode objfpc}{$H+}

{$interfaces corba}

uses
   classes,
   sysutils;

type
   i_hello = interface
     procedure hello;
     end;

   i_goodbye = interface
     procedure goodbye;
     end;

   i_nonsense = interface
     procedure nonsense;
     end;

   t_fellow = class (TObject, i_hello, i_goodbye) // no nonsense
     procedure hello;
     procedure goodbye;
     end;

procedure t_fellow.hello;
   begin
     writeln ('hello');
   end;

procedure t_fellow.goodbye;
   begin
     writeln ('goodbye');
   end;

var
   fellow : t_fellow;
   obj : TObject;
   h : i_hello;
   g : i_goodbye;

begin
   fellow := t_fellow.Create;
   obj := fellow;

   writeln ('expect 4x hello:');
   fellow.hello;
   h := fellow;
   h.hello;
   (fellow as i_hello).hello;
   if (obj is i_hello) then begin
     h := obj as i_hello;
     h.hello;
     end;

   writeln;

   writeln ('expect 4x goodbye:');
   fellow.goodbye;
   g := fellow;
   g.goodbye;
   // BROKEN - the two below are giving 'hello' rather than 'goodbye'
   (fellow as i_goodbye).goodbye;
   if (obj is i_goodbye) then begin
     g := obj as i_goodbye;
     g.goodbye;
     end;

   writeln;

   if (fellow is i_nonsense) then begin
     // BROKEN - execution is entering here though it shouldn't
     writeln ('Problem: (fellow is i_nonsense) returned true');
     (fellow as i_nonsense).nonsense; // printing 'hello'
     end;

   fellow.free;
end.


Free Pascal Compiler version 3.0.0 [2015/12/05] for x86_64
Copyright (c) 1993-2015 by Florian Klaempfl and others
Target OS: Linux for x86-64



Sample output:

expect 4x hello:
hello
hello
hello
hello

expect 4x goodbye:
goodbye
goodbye
hello
hello

Problem: (fellow is i_nonsense) returned true
hello