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