In a sequence like (d) (c) (b) (a) c++ raises <-- Ada calls c++, <-- c++ call Ada <-- Ada calls exception others handler and handles c++ gets foreign c++ exception exception and re-raises the original exception raised on the C++ world at (d) couldn't be caught as a regular c++ exception at (b) when the re-raise performed at (c) is done with an explicit call to Ada.Exceptions.Reraise_Occurrence. Indeed, the latter just re-crafted a new Ada-ish occurence and the nature and contents of the original exception object were lost. This patch fixes this by refining Reraise_Occurrence to be more careful with exceptions in the course of a propagation, just resuming propagation of the original object. From the set of soures below, compilation and execution with: g++ -c bd.cc && gnatmake -f -g a.adb -largs bd.o --LINK=g++ && ./a is expected to output: foreign exception caught, reraising ... b() caught x = 5 ---- // bd.cc extern "C" { extern void c(); void b (); void d (); } void b () { try { c(); } catch (int x) { printf ("b() caught x = %d\n", x); } } void d () { throw (5); } -- a.adb with C; procedure A is procedure B; pragma Import (Cpp, B); begin B; end; -- c.ads procedure C; pragma Export (C, C, "c"); -- c.adb with Ada.Exceptions; use Ada.Exceptions; with System.Standard_Library; with Ada.Unchecked_Conversion; with Ada.Text_IO; use Ada.Text_IO; procedure C is package SSL renames System.Standard_Library; use type SSL.Exception_Data_Ptr; function To_Exception_Data_Ptr is new Ada.Unchecked_Conversion (Exception_Id, SSL.Exception_Data_Ptr); procedure D; pragma Import (Cpp, D); Foreign_Exception : aliased SSL.Exception_Data; pragma Import (Ada, Foreign_Exception, "system__exceptions__foreign_exception"); begin D; exception when E : others => if To_Exception_Data_Ptr (Exception_Identity (E)) = Foreign_Exception'Unchecked_access then Put_Line ("foreign exception caught, reraising ..."); Reraise_Occurrence (E); end if; end; 2018-05-22 Olivier Hainque <hainque@adacore.com> gcc/ada/ * libgnat/a-except.adb (Exception_Propagation.Propagate_Exception): Expect an Exception_Occurence object, not an Access. (Complete_And_Propagate_Occurrence): Adjust accordingly. (Raise_From_Signal_Handler): Likewise. (Reraise_Occurrence_No_Defer): If we have a Machine_Occurrence available in the provided occurrence object, just re-propagate the latter as a bare "raise;" would do. * libgnat/a-exexpr.adb (Propagate_Exception): Adjust to spec change. * libgnat/a-exstat.adb (String_To_EO): Initialize X.Machine_Occurrence to null, to mark that the occurrence we're crafting from the stream contents is not being propagated (yet). From-SVN: r260533
Name |
Last commit
|
Last update |
---|---|---|
INSTALL | Loading commit data... | |
config | Loading commit data... | |
contrib | Loading commit data... | |
fixincludes | Loading commit data... | |
gcc | Loading commit data... | |
gnattools | Loading commit data... | |
gotools | Loading commit data... | |
include | Loading commit data... | |
intl | Loading commit data... | |
libada | Loading commit data... | |
libatomic | Loading commit data... | |
libbacktrace | Loading commit data... | |
libcc1 | Loading commit data... | |
libcpp | Loading commit data... | |
libdecnumber | Loading commit data... | |
libffi | Loading commit data... | |
libgcc | Loading commit data... | |
libgfortran | Loading commit data... | |
libgo | Loading commit data... | |
libgomp | Loading commit data... | |
libhsail-rt | Loading commit data... | |
libiberty | Loading commit data... | |
libitm | Loading commit data... | |
libmpx | Loading commit data... | |
libobjc | Loading commit data... | |
liboffloadmic | Loading commit data... | |
libquadmath | Loading commit data... | |
libsanitizer | Loading commit data... | |
libssp | Loading commit data... | |
libstdc++-v3 | Loading commit data... | |
libvtv | Loading commit data... | |
lto-plugin | Loading commit data... | |
maintainer-scripts | Loading commit data... | |
zlib | Loading commit data... | |
.dir-locals.el | Loading commit data... | |
.gitattributes | Loading commit data... | |
.gitignore | Loading commit data... | |
ABOUT-NLS | Loading commit data... | |
COPYING | Loading commit data... | |
COPYING.LIB | Loading commit data... | |
COPYING.RUNTIME | Loading commit data... | |
COPYING3 | Loading commit data... | |
COPYING3.LIB | Loading commit data... | |
ChangeLog | Loading commit data... | |
ChangeLog.jit | Loading commit data... | |
ChangeLog.tree-ssa | Loading commit data... | |
MAINTAINERS | Loading commit data... | |
Makefile.def | Loading commit data... | |
Makefile.in | Loading commit data... | |
Makefile.tpl | Loading commit data... | |
README | Loading commit data... | |
compile | Loading commit data... | |
config-ml.in | Loading commit data... | |
config.guess | Loading commit data... | |
config.rpath | Loading commit data... | |
config.sub | Loading commit data... | |
configure | Loading commit data... | |
configure.ac | Loading commit data... | |
depcomp | Loading commit data... | |
install-sh | Loading commit data... | |
libtool-ldflags | Loading commit data... | |
libtool.m4 | Loading commit data... | |
ltgcc.m4 | Loading commit data... | |
ltmain.sh | Loading commit data... | |
ltoptions.m4 | Loading commit data... | |
ltsugar.m4 | Loading commit data... | |
ltversion.m4 | Loading commit data... | |
lt~obsolete.m4 | Loading commit data... | |
missing | Loading commit data... | |
mkdep | Loading commit data... | |
mkinstalldirs | Loading commit data... | |
move-if-change | Loading commit data... | |
symlink-tree | Loading commit data... | |
ylwrap | Loading commit data... |