[Ada] Fix Reraise_Occurrence of Foreign_Exception
authorOlivier Hainque <hainque@adacore.com>
Tue, 22 May 2018 13:27:01 +0000 (13:27 +0000)
committerPierre-Marie de Rodat <pmderodat@gcc.gnu.org>
Tue, 22 May 2018 13:27:01 +0000 (13:27 +0000)
commitf6904af09df7f0318e2da64e68944cca1c8e454e
tree932f66d68c2b3bd4620f99e0e31440d769ab197d
parent02db8169939bb489abb6c7025395a3fc671b79b6
[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  <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
gcc/ada/ChangeLog
gcc/ada/libgnat/a-except.adb
gcc/ada/libgnat/a-exexpr.adb
gcc/ada/libgnat/a-exstat.adb