It is now possible to import C++ exceptions and to handle it.
The following program will display: Got Cpp exception
It can be built using the following project file:
project except is
for Languages use ("Ada", "C++");
for Main use ("main.adb");
end except;
package Cppexcept is
Cpp_Int_Exception : exception;
pragma Import (Cpp, Cpp_Int_Exception, "_ZTIi");
end Cppexcept;
with Ada.Text_IO; use Ada.Text_IO;
with Ada.Exceptions; use Ada.Exceptions;
with Cppexcept; use Cppexcept;
procedure Main is
procedure Raise_Excep_Int;
pragma Import (C, Raise_Excep_Int);
-- Raise a Cpp exception
begin
Raise_Excep_Int;
exception
when Cpp_Int_Exception =>
Put_Line ("Got Cpp exception");
when X: others =>
Put_Line ("Err, got unexpected exception: "
& Exception_Information (X));
end Main;
extern "C" void raise_excep_int (void)
{
throw 2;
}
Tested on x86_64-pc-linux-gnu, committed on trunk
2013-10-14 Tristan Gingold <ging...@adacore.com>
* sem_prag.adb (Process_Import_Or_Interface): Allow importing
of exception using convention Cpp.
* exp_prag.adb (Expand_Pragma_Import_Or_Interface): Expand cpp
imported exceptions.
* raise-gcc.c (is_handled_by): Filter C++ exception occurrences.
* gnat_rm.texi: Document how to import C++ exceptions.
Index: exp_prag.adb
===================================================================
--- exp_prag.adb (revision 203544)
+++ exp_prag.adb (working copy)
@@ -575,6 +575,64 @@
if No (Init_Call) and then Present (Expression (Parent (Def_Id))) then
Set_Expression (Parent (Def_Id), Empty);
end if;
+ elsif Ekind (Def_Id) = E_Exception
+ and then Convention (Def_Id) = Convention_CPP
+ then
+
+ -- Import a C++ convention
+
+ declare
+ Loc : constant Source_Ptr := Sloc (N);
+ Exdata : List_Id;
+ Lang_Char : Node_Id;
+ Foreign_Data : Node_Id;
+ Rtti_Name : constant Node_Id := Arg3 (N);
+ Dum : constant Entity_Id := Make_Temporary (Loc, 'D');
+
+ begin
+ Exdata := Component_Associations (Expression (Parent (Def_Id)));
+
+ Lang_Char := Next (First (Exdata));
+
+ -- Change the one-character language designator to 'C'
+
+ Rewrite (Expression (Lang_Char),
+ Make_Character_Literal (Loc,
+ Chars => Name_uC,
+ Char_Literal_Value =>
+ UI_From_Int (Character'Pos ('C'))));
+ Analyze (Expression (Lang_Char));
+
+ -- Change the value of Foreign_Data
+
+ Foreign_Data := Next (Next (Next (Next (Lang_Char))));
+
+ Insert_Actions (Def_Id, New_List (
+ Make_Object_Declaration (Loc,
+ Defining_Identifier => Dum,
+ Object_Definition =>
+ New_Occurrence_Of (Standard_Character, Loc)),
+
+ Make_Pragma (Loc,
+ Chars => Name_Import,
+ Pragma_Argument_Associations => New_List (
+ Make_Pragma_Argument_Association (Loc,
+ Expression => Make_Identifier (Loc, Name_Ada)),
+
+ Make_Pragma_Argument_Association (Loc,
+ Expression => Make_Identifier (Loc, Chars (Dum))),
+
+ Make_Pragma_Argument_Association (Loc,
+ Chars => Name_Link_Name,
+ Expression => Relocate_Node (Rtti_Name))))));
+
+ Rewrite (Expression (Foreign_Data),
+ Unchecked_Convert_To (Standard_A_Char,
+ Make_Attribute_Reference (Loc,
+ Prefix => Make_Identifier (Loc, Chars (Dum)),
+ Attribute_Name => Name_Address)));
+ Analyze (Expression (Foreign_Data));
+ end;
end if;
end Expand_Pragma_Import_Or_Interface;
Index: gnat_rm.texi
===================================================================
--- gnat_rm.texi (revision 203543)
+++ gnat_rm.texi (working copy)
@@ -11963,6 +11963,7 @@
@emph{Exception_Name:} nnnnn
@emph{Message:} mmmmm
@emph{PID:} ppp
+@emph{Load address:} 0xhhhh
@emph{Call stack traceback locations:}
0xhhhh 0xhhhh 0xhhhh ... 0xhhh
@end smallexample
@@ -11984,10 +11985,12 @@
not making use of this field.
@item
-The Call stack traceback locations line and the following values
-are present only if at least one traceback location was recorded.
-The values are given in C style format, with lower case letters
-for a-f, and only as many digits present as are necessary.
+The Load address line, the Call stack traceback locations line and the
+following values are present only if at least one traceback location was
+recorded. The Load address indicates the address at which the main executable
+was loaded; this line may not be present if operating system hasn't relocated
+the main executable. The values are given in C style format, with lower case
+letters for a-f, and only as many digits present as are necessary.
@end itemize
@noindent
@@ -18874,6 +18877,19 @@
contains @samp{Foreign_Exception}. Finalization and awaiting dependent
tasks works properly when such foreign exceptions are propagated.
+It is also possible to import a C++ exception using the following syntax:
+
+@smallexample @c ada
+LOCAL_NAME : exception;
+pragma Import (Cpp,
+ [Entity =>] LOCAL_NAME,
+ [External_Name =>] static_string_EXPRESSION);
+@end smallexample
+
+@noident
+The @code{External_Name} is the name of the C++ RTTI symbol. You can then
+cover a specific C++ exception in an exception handler.
+
@node Interfacing to COBOL
@section Interfacing to COBOL
Index: raise-gcc.c
===================================================================
--- raise-gcc.c (revision 203538)
+++ raise-gcc.c (working copy)
@@ -87,6 +87,36 @@
#define CXX_EXCEPTION_CLASS 0x474e5543432b2b00ULL
#define GNAT_EXCEPTION_CLASS 0x474e552d41646100ULL
+/* Structure of a C++ exception, represented as a C structure... See
+ unwind-cxx.h for the full definition. */
+
+struct __cxa_exception
+{
+ void *exceptionType;
+ void (*exceptionDestructor)(void *);
+
+ void (*unexpectedHandler)();
+ void (*terminateHandler)();
+
+ struct __cxa_exception *nextException;
+
+ int handlerCount;
+
+#ifdef __ARM_EABI_UNWINDER__
+ struct __cxa_exception* nextPropagatingException;
+
+ int propagationCount;
+#else
+ int handlerSwitchValue;
+ const unsigned char *actionRecord;
+ const unsigned char *languageSpecificData;
+ _Unwind_Ptr catchTemp;
+ void *adjustedPtr;
+#endif
+
+ _Unwind_Exception unwindHeader;
+};
+
/* --------------------------------------------------------------
-- The DB stuff below is there for debugging purposes only. --
-------------------------------------------------------------- */
@@ -882,6 +912,22 @@
|| choice == (_Unwind_Ptr) &Foreign_Exception)
return handler;
+ /* C++ exception occurrences. */
+ if (propagated_exception->common.exception_class == CXX_EXCEPTION_CLASS
+ && Language_For (choice) == 'C')
+ {
+ void *choice_typeinfo = Foreign_Data_For (choice);
+ void *except_typeinfo =
+ (((struct __cxa_exception *)
+ ((_Unwind_Exception *)propagated_exception + 1)) - 1)->exceptionType;
+
+ /* Typeinfo are directly compared, which might not be correct if they
+ aren't merged. ??? We should call the == operator if this module is
+ compiled in C++. */
+ if (choice_typeinfo == except_typeinfo)
+ return handler;
+ }
+
return nothing;
}
Index: sem_prag.adb
===================================================================
--- sem_prag.adb (revision 203548)
+++ sem_prag.adb (working copy)
@@ -7126,6 +7126,34 @@
Check_CPP_Type_Has_No_Defaults (Def_Id);
end if;
+ -- Import a CPP exception
+
+ elsif C = Convention_CPP
+ and then Ekind (Def_Id) = E_Exception
+ then
+ if No (Arg3) then
+ Error_Pragma_Arg
+ ("'External_'Name arguments is required for 'Cpp exception",
+ Arg3);
+ else
+ -- As only a string is allowed, Check_Arg_Is_External_Name
+ -- isn't called.
+ Check_Arg_Is_Static_Expression (Arg3, Standard_String);
+ end if;
+
+ if Present (Arg4) then
+ Error_Pragma_Arg
+ ("Link_Name argument not allowed for imported Cpp exception",
+ Arg4);
+ end if;
+
+ -- Do not call Set_Interface_Name as the name of the exception
+ -- shouldn't be modified (and in particular it shouldn't be
+ -- the External_Name). For exceptions, the External_Name is the
+ -- name of the RTTI structure.
+
+ -- ??? Emit an error if pragma Import/Export_Exception is present
+
elsif Nkind (Parent (Def_Id)) = N_Incomplete_Type_Declaration then
Check_No_Link_Name;
Check_Arg_Count (3);
