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;
Tested on x86_64-pc-linux-gnu, committed on trunk
2018-05-22 Olivier Hainque <hain...@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).--- gcc/ada/libgnat/a-except.adb
+++ 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;
---------------------
--- gcc/ada/libgnat/a-exexpr.adb
+++ 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;
--- gcc/ada/libgnat/a-exstat.adb
+++ 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.
