Re: [Ada] Fix handling of exceptions raised for signals

[Eric Botcazou <ebotcazou at adacore dot com>]

> Since the fix for PR target/27880:
>
> 2008-11-12  Steve Ellcey  <sje@cup.hp.com>
>
>         PR target/27880
>         * configure.ac (GCC_CHECK_UNWIND_GETIPINFO): Use this macro
>         to set HAVE_GETIPINFO.
>         * aclocal.m4: Include ../config/unwind_ipinfo.m4.
>         * configure: Regenerate.
>         * config.in: Regenerate.
>
> exceptions raised for signals may not always be caught in Ada.  The
> required adjustment is straightforward: detecting the presence of GetIPInfo
> during the configuration of libada (like libstdc++-v3, libjava, ..) and
> passing a define to gcc-interface/Makefile.in.

A couple of further tweaks, tested on i586-suse-linux, applied on the mainline 
and the 4.4 branch.


2009-10-27  Eric Botcazou  <ebotcazou@adacore.com>

	* raise-gcc (db_region_for): Use _Unwind_GetIPInfo instead of
	_Unwind_GetIP if HAVE_GETIPINFO is defined.
	(db_action_for): Likewise.


2009-10-27  Eric Botcazou  <ebotcazou@adacore.com>

        * gnat.dg/null_pointer_deref1.adb: Accept Constraint_Error.
        * gnat.dg/null_pointer_deref2.adb: Likewise.


-- 
Eric Botcazou

Index: ada/raise-gcc.c
===================================================================
--- ada/raise-gcc.c	(revision 153551)
+++ ada/raise-gcc.c	(working copy)
@@ -56,6 +56,14 @@ typedef char bool;
 #include "adaint.h"
 #include "raise.h"
 
+#ifdef __APPLE__
+/* On MacOS X, versions older than 10.5 don't export _Unwind_GetIPInfo.  */
+#undef HAVE_GETIPINFO
+#if __ENVIRONMENT_MAC_OS_X_VERSION_MIN_REQUIRED__ >= 1050
+#define HAVE_GETIPINFO 1
+#endif
+#endif
+
 /* The names of a couple of "standard" routines for unwinding/propagation
    actually vary depending on the underlying GCC scheme for exception handling
    (SJLJ or DWARF). We need a consistently named interface to import from
@@ -501,7 +509,14 @@ typedef struct
 static void
 db_region_for (region_descriptor *region, _Unwind_Context *uw_context)
 {
-  _Unwind_Ptr ip = _Unwind_GetIP (uw_context) - 1;
+  int ip_before_insn = 0;
+#ifdef HAVE_GETIPINFO
+  _Unwind_Ptr ip = _Unwind_GetIPInfo (uw_context, &ip_before_insn);
+#else
+  _Unwind_Ptr ip = _Unwind_GetIP (uw_context);
+#endif
+  if (!ip_before_insn)
+    ip--;
 
   if (! (db_accepted_codes () & DB_REGIONS))
     return;
@@ -631,7 +646,14 @@ typedef struct
 static void
 db_action_for (action_descriptor *action, _Unwind_Context *uw_context)
 {
-  _Unwind_Ptr ip = _Unwind_GetIP (uw_context) - 1;
+  int ip_before_insn = 0;
+#ifdef HAVE_GETIPINFO
+  _Unwind_Ptr ip = _Unwind_GetIPInfo (uw_context, &ip_before_insn);
+#else
+  _Unwind_Ptr ip = _Unwind_GetIP (uw_context);
+#endif
+  if (!ip_before_insn)
+    ip--;
 
   db (DB_ACTIONS, "For ip @ 0x%08x => ", ip);
 
@@ -670,14 +692,6 @@ db_action_for (action_descriptor *action
    There are two variants of this routine, depending on the underlying
    mechanism (DWARF/SJLJ), which account for differences in the tables.  */
 
-#ifdef __APPLE__
-/* On MacOS X, versions older than 10.5 don't export _Unwind_GetIPInfo.  */
-#undef HAVE_GETIPINFO
-#if __ENVIRONMENT_MAC_OS_X_VERSION_MIN_REQUIRED__ >= 1050
-#define HAVE_GETIPINFO 1
-#endif
-#endif
-
 #ifdef __USING_SJLJ_EXCEPTIONS__
 
 #define __builtin_eh_return_data_regno(x) x
Index: testsuite/gnat.dg/null_pointer_deref1.adb
===================================================================
--- testsuite/gnat.dg/null_pointer_deref1.adb	(revision 153551)
+++ testsuite/gnat.dg/null_pointer_deref1.adb	(working copy)
@@ -17,5 +17,5 @@ procedure Null_Pointer_Deref1 is
 begin
    Data.all := 1;
 exception
-   when Storage_Error => null;
+   when Constraint_Error | Storage_Error => null;
 end;
Index: testsuite/gnat.dg/null_pointer_deref2.adb
===================================================================
--- testsuite/gnat.dg/null_pointer_deref2.adb	(revision 153551)
+++ testsuite/gnat.dg/null_pointer_deref2.adb	(working copy)
@@ -20,7 +20,7 @@ procedure Null_Pointer_Deref2 is
    begin
       Data.all := 1;
    exception
-      when Storage_Error => null;
+      when Constraint_Error | Storage_Error => null;
    end T;
 
 begin