From: Olivier Hainque Date: Tue, 22 May 2018 13:27:01 +0000 (+0000) Subject: [Ada] Fix Reraise_Occurrence of Foreign_Exception X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=f6904af09df7f0318e2da64e68944cca1c8e454e;p=gcc.git [Ada] Fix Reraise_Occurrence of Foreign_Exception 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 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 --- diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index effa9642a90..a5b1dc6a144 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,17 @@ +2018-05-22 Olivier Hainque + + * 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). + 2018-05-22 Hristian Kirtchev * exp_aggr.adb (Initialize_Ctrl_Record_Component): Insert the generated diff --git a/gcc/ada/libgnat/a-except.adb b/gcc/ada/libgnat/a-except.adb index 0f45ace85df..c2f2f066979 100644 --- a/gcc/ada/libgnat/a-except.adb +++ b/gcc/ada/libgnat/a-except.adb @@ -228,7 +228,7 @@ package body Ada.Exceptions is function Allocate_Occurrence return EOA; -- Allocate an exception occurrence (as well as the machine occurrence) - procedure Propagate_Exception (Excep : EOA); + procedure Propagate_Exception (Excep : Exception_Occurrence); pragma No_Return (Propagate_Exception); -- This procedure propagates the exception represented by Excep @@ -940,7 +940,7 @@ package body Ada.Exceptions is procedure Complete_And_Propagate_Occurrence (X : EOA) is begin Complete_Occurrence (X); - Exception_Propagation.Propagate_Exception (X); + Exception_Propagation.Propagate_Exception (X.all); end Complete_And_Propagate_Occurrence; --------------------- @@ -1091,7 +1091,7 @@ package body Ada.Exceptions is is begin Exception_Propagation.Propagate_Exception - (Create_Occurrence_From_Signal_Handler (E, M)); + (Create_Occurrence_From_Signal_Handler (E, M).all); end Raise_From_Signal_Handler; ------------------------- @@ -1587,12 +1587,25 @@ package body Ada.Exceptions is --------------------------------- procedure Reraise_Occurrence_No_Defer (X : Exception_Occurrence) is - Excep : constant EOA := Exception_Propagation.Allocate_Occurrence; - Saved_MO : constant System.Address := Excep.Machine_Occurrence; begin - Save_Occurrence (Excep.all, X); - Excep.Machine_Occurrence := Saved_MO; - Complete_And_Propagate_Occurrence (Excep); + -- If we have a Machine_Occurrence at hand already, e.g. when we are + -- reraising a foreign exception, just repropagate. Otherwise, e.g. + -- when reraising a GNAT exception or an occurrence read back from a + -- stream, set up a new occurrence with its own Machine block first. + + if X.Machine_Occurrence /= System.Null_Address then + Exception_Propagation.Propagate_Exception (X); + else + declare + Excep : constant EOA + := Exception_Propagation.Allocate_Occurrence; + Saved_MO : constant System.Address := Excep.Machine_Occurrence; + begin + Save_Occurrence (Excep.all, X); + Excep.Machine_Occurrence := Saved_MO; + Complete_And_Propagate_Occurrence (Excep); + end; + end if; end Reraise_Occurrence_No_Defer; --------------------- diff --git a/gcc/ada/libgnat/a-exexpr.adb b/gcc/ada/libgnat/a-exexpr.adb index 465add96161..2fe003ef011 100644 --- a/gcc/ada/libgnat/a-exexpr.adb +++ b/gcc/ada/libgnat/a-exexpr.adb @@ -349,7 +349,7 @@ package body Exception_Propagation is -- Propagate_Exception -- ------------------------- - procedure Propagate_Exception (Excep : EOA) is + procedure Propagate_Exception (Excep : Exception_Occurrence) is begin Propagate_GCC_Exception (To_GCC_Exception (Excep.Machine_Occurrence)); end Propagate_Exception; diff --git a/gcc/ada/libgnat/a-exstat.adb b/gcc/ada/libgnat/a-exstat.adb index 8943939ff4f..166cbb19f7f 100644 --- a/gcc/ada/libgnat/a-exstat.adb +++ b/gcc/ada/libgnat/a-exstat.adb @@ -256,6 +256,11 @@ package body Stream_Attributes is end loop; end if; + -- The occurrence we're crafting is not currently being + -- propagated. + + X.Machine_Occurrence := System.Null_Address; + -- If an exception was converted to a string, it must have -- already been raised, so flag it accordingly and we are done.