Upcasting interfaces with CPP convention in GNAT

[Kura]

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?

[J-P. Rosen]

Le 02/11/2023 à 13:20, Kura a écrit :
> 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;

I don't know if this is the cause of your problem, but you should give
convention C_Plus_Plus to the pointer types too (IBase_Ptr and
IDerived_Ptr).

--
J-P. Rosen
Adalog
2 rue du Docteur Lombard, 92441 Issy-les-Moulineaux CEDEX
https://www.adalog.fr https://www.adacontrol.fr

[Kura]

On Thursday, November 2, 2023 at 10:11:55 AM UTC-4, J-P. Rosen wrote:
> Le 02/11/2023 à 13:20, Kura a écrit :
> > 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;
> I don't know if this is the cause of your problem, but you should give
> convention C_Plus_Plus to the pointer types too (IBase_Ptr and
> IDerived_Ptr).

That did not solve my problem, but thank you for the tip.

[Kura]

I was able to work around the issue by using abstract tagged null records
instead of interfaces - no other changes necessary. It seems that interfaces
can only be at the very top of a hierarchy even if you're only extending
another interface.