Upcasting interfaces with CPP convention in GNAT

[Kura <kuraitou@gmail.com>]

Hi all,

I'm trying to figure out how to correctly perform an upcast in GNAT using
interface types that have the CPP convention. I have two types corresponding to
C++ classes: IBase and IDerived each with corresponding access types suffixed
with _Ptr. The library that I'm wrapping returns a pointer to some concrete
implementation of IDerived, but the moment I convert it to an IBase_Ptr to pass
it to functions within the library, the program segfaults while performing some
kind of tag check. I've found information on this topic to be very sparse, and
the GNAT manual has no discussion about allowed conversions or examples showing
how to do this. This seems like it should be an allowed conversion and the
program works as expected if I either replace the usage of Base_Ptr with
Derived_Ptr within the function wrapper specification (not feasible because
there are many types deriving from Base_Ptr and adding overloads would affect
its vtable) or use Unchecked_Conversion between the two pointer types (unsure
if this is safe). I'm also aware I could lay out the vtables manually and do
away with tagged types, but I would like to avoid that if possible.

Here is a minimal example that segfaults, all compiled with the same toolchain
on windows/mingw64:

--==== repro.adb ==============================================================
with Wrap; use Wrap;
procedure Repro is
    P : IDerived_Ptr := GetDerivedInstance;
    Q : IBase_Ptr := IBase_Ptr (P);
begin
    null;
end Repro;

--==== wrap.ads ===============================================================
package Wrap is
    type IBase is interface;
    pragma Convention (C_Plus_Plus, IBase);
    type IBase_Ptr is access all IBase'Class;

    type IDerived is interface and IBase;
    pragma Convention (C_Plus_Plus, IDerived);
    type IDerived_Ptr is access all IDerived'Class;

    function GetDerivedInstance return IDerived_Ptr
        with Import => True, Convention => C_Plus_Plus,
        External_Name => "GetDerivedInstance";
end Wrap;

--==== lib.cpp ================================================================
class IBase {};
class IDerived : public IBase {};
class Impl : public IDerived {
public:
    Impl() = default;
};

extern "C"
IDerived* GetDerivedInstance() {
    return new Impl();
}
--==== end example ============================================================

Error and stack trace:

Thread 1 received signal SIGSEGV, Segmentation fault.
ada.tags.offset_to_top (this=(system.address) 0x6591710) at a-tags.adb:806
806     a-tags.adb: No such file or directory.
(gdb) bt
#0  ada.tags.offset_to_top (this=(system.address) 0x6591710) at a-tags.adb:806
#1  ada.tags.base_address (this=(system.address) 0x6591710) at a-tags.adb:286
#2  ada.tags.displace (this=(system.address) 0x6591710, t=0x7ff7fe8301c8
        <wrap__ibaseT+8> (wrap.ibase)) at a-tags.adb:354
#3  0x00007ff7fe82649c in repro () at C:\repro\src\repro.adb:5

Any ideas?