[Ada] Improve last exception info availability from C++ handlers

The Most_Recent_Exception service failed to provide accurate information on an
Ada exception caught by a C++ handler for foreign exceptions. The service
relies on updates of a "current exception buffer" from live exception objects
at various points of the propagation process and this update was not performed
early enough for the case of foreign exception handlers in non-Ada handlers.

The correction applied here consists in moving one of the updates earlier in
the raise process, just before unwinding starts, then refine the update API to
prevent a redundant copy during the unwinding search phase for the same
exception.

The example below, compiled with

gcc -c b.cc
gnatmake -g main.adb -largs b.o --LINK=g++

is expected to run and display

ada info:
Checking Most_Recent_Exception for CONSTRAINT_ERROR ... OK!

// b.cc

extern "C" {
 void foo ();
 extern void _ada_trigger ();
 extern void _ada_occurrence_info ();
}

void foo ()
{
 try {
   _ada_trigger ();
 } catch (const abi::__foreign_exception &e) {
   printf ("ada info:\n");
   _ada_occurrence_info();
 }
}

-- main.adb

with EH;
procedure Main is
begin
  EH.Foo;
end;

-- eh.adb

with Gnat.Most_Recent_Exception;
with Ada.Text_IO; use Ada.Text_IO;

package body EH is

  procedure Ada_Trigger is
  begin
     raise Constraint_Error;
  end;

  procedure Ada_Occurrence_Info is
  begin
     Check_MRE ("CONSTRAINT_ERROR");
  end;

  function Pre_Check_MRE (Ename : String) return Exception_Id is
     MROA : Exception_Occurrence_Access :=
       GNAT.Most_Recent_Exception.Occurrence_Access;
  begin
     Put ("Checking Most_Recent_Exception for " & Ename & " ... ");

     if MROA = null then
        Put_Line ("Most recent exception occurrence access is NULL");
        return Null_Id;
     else
        return Exception_Identity (MROA.all);
     end if;
  end;

  procedure Diagnose_MRE (MRID : Exception_Id; Ok : Boolean) is
  begin
     if Ok then
        Put_Line ("OK!");
     else
        Put_Line ("Err, Most_Recent_Exception was " & Exception_Name (MRID));
     end if;
  end;

  procedure Check_MRE (Eid : Exception_Id) is
     MRID : Exception_Id := Pre_Check_MRE (Ename => Exception_Name (Eid));
  begin
     Diagnose_MRE (MRID, Ok => Eid = MRID);
  end;

  procedure Check_MRE (Ename : String) is
     MRID : Exception_Id := Pre_Check_MRE (Ename => Ename);
  begin
     Diagnose_MRE (MRID, Ok => Ename = Exception_Name (MRID));
  end;

end;

-- eh.ads

with Ada.Exceptions; use Ada.Exceptions;
package EH is
  procedure Ada_Trigger with
    Export, Convention => C, External_Name => "_ada_trigger";

  procedure Ada_Occurrence_Info with
    Export, Convention => C, External_Name => "_ada_occurrence_info";

  procedure Foo with Import, Convention => C, External_Name => "foo";

  procedure Check_MRE (Eid : Exception_Id);
  procedure Check_MRE (Ename : String);

end;

2018-06-11  Olivier Hainque  <hainque@adacore.com>

gcc/ada/

	* libgnat/s-excmac*.ads: Factorize Unwind_Action definitions ...
	* libgnat/a-exexpr.adb: ... Here, then add comments describing the
	major datastructures associated with the current exception raised.
	(Setup_Current_Excep): Accept a "Phase" argument conveying the
	unwinding phase during which this subprogram is called.  For an Ada
	exception, don't update the current exception buffer from the raised
	exception object during SEARCH_PHASE, as this is redundant with the
	call now issued just before propagation starts.
	(Propagate_GCC_Exception): Move call to Setup_Current_Excep ahead of
	the unwinding start, conveying Phase 0.
	(Unhandled_Except_Handler): Pass UA_CLEANUP_PHASE as the Phase value on
	the call to Setup_Current_Excep.
	* raise-gcc.c (personality_body): Pass uw_phases as the Phase argument
	on calls to Setup_Current_Excep.

From-SVN: r261426

1 files changed, 14 insertions, 11 deletions

diff --git a/gcc/ada/raise-gcc.c b/gcc/ada/raise-gcc.c
index 7558414..5c2cc43 100644
--- a/gcc/ada/raise-gcc.c
+++ b/gcc/ada/raise-gcc.c
@@ -106,8 +106,9 @@ __gnat_Unwind_RaiseException (_Unwind_Exception *);
 _Unwind_Reason_Code
 __gnat_Unwind_ForcedUnwind (_Unwind_Exception *, _Unwind_Stop_Fn, void *);
 
-extern struct Exception_Occurrence *__gnat_setup_current_excep
- (_Unwind_Exception *);
+extern struct Exception_Occurrence *
+__gnat_setup_current_excep (_Unwind_Exception *, _Unwind_Action);
+
 extern void __gnat_unhandled_except_handler (_Unwind_Exception *);
 
 #ifdef CERT
@@ -1220,12 +1221,14 @@ personality_body (_Unwind_Action uw_phases,
       else
 	{
 #ifndef CERT
-	  struct Exception_Occurrence *excep;
-
 	  /* Trigger the appropriate notification routines before the second
-	     phase starts, which ensures the stack is still intact.
-             First, setup the Ada occurrence.  */
-          excep = __gnat_setup_current_excep (uw_exception);
+	     phase starts, when the stack is still intact.  First install what
+	     needs to be installed in the current exception buffer and fetch
+	     the Ada occurrence pointer to use.  */
+
+	  struct Exception_Occurrence *excep
+	    = __gnat_setup_current_excep (uw_exception, uw_phases);
+
 	  if (action.kind == unhandler)
 	    __gnat_notify_unhandled_exception (excep);
 	  else
@@ -1245,10 +1248,10 @@ personality_body (_Unwind_Action uw_phases,
     (uw_context, uw_exception, action.landing_pad, action.ttype_filter);
 
 #ifndef CERT
-  /* Write current exception, so that it can be retrieved from Ada.  It was
-     already done during phase 1 (just above), but in between, one or several
-     exceptions may have been raised (in cleanup handlers).  */
-  __gnat_setup_current_excep (uw_exception);
+  /* Write current exception so that it can be retrieved from Ada.  It was
+     already done during phase 1, but one or several exceptions may have been
+     raised in cleanup handlers in between.  */
+  __gnat_setup_current_excep (uw_exception, uw_phases);
 #endif
 
   return _URC_INSTALL_CONTEXT;