decl.c (gnat_to_gnu_entity): Turn Ada Pure on subprograms back into GCC CONST when...

        ada/
        * gcc-interface/decl.c (gnat_to_gnu_entity) <case E_Function>:
        Turn Ada Pure on subprograms back into GCC CONST when eh constructs
        are explicit to the middle-end.  Tidy.

        testsuite/
        * gnat.dg/test_raise_from_pure.adb: Adjust to match revised intent.
        * gnat.dg/wrap_raise_from_pure.ad[bs]: Remove.
        * gnat.dg/handle_raise_from_pure.adb: New test.

From-SVN: r141821

7 files changed, 45 insertions, 31 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 5c604ee..3df2baf 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,9 @@
+2008-11-13  Olivier Hainque  <hainque@adacore.com>
+
+	* gcc-interface/decl.c (gnat_to_gnu_entity) <case E_Function>:
+	Turn Ada Pure on subprograms back into GCC CONST when eh constructs
+	are explicit to the middle-end.  Tidy.
+
 2008-11-09  Eric Botcazou  <ebotcazou@adacore.com>
 
 	* gcc-interface/ada-tree.def (PLUS_NOMOD_EXPR): New tree code.
diff --git a/gcc/ada/gcc-interface/decl.c b/gcc/ada/gcc-interface/decl.c
index 188b896..22ca3a5 100644
--- a/gcc/ada/gcc-interface/decl.c
+++ b/gcc/ada/gcc-interface/decl.c
@@ -3739,7 +3739,19 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
 	bool public_flag = Is_Public (gnat_entity) || imported_p;
 	bool extern_flag
 	  = (Is_Public (gnat_entity) && !definition) || imported_p;
-	bool pure_flag = Is_Pure (gnat_entity);
+
+       /* The semantics of "pure" in Ada essentially matches that of "const"
+          in the back-end.  In particular, both properties are orthogonal to
+          the "nothrow" property if the EH circuitry is explicit in the
+          internal representation of the back-end.  If we are to completely
+          hide the EH circuitry from it, we need to declare that calls to pure
+          Ada subprograms that can throw have side effects since they can
+          trigger an "abnormal" transfer of control flow; thus they can be
+          neither "const" nor "pure" in the back-end sense.  */
+	bool const_flag
+	  = (Exception_Mechanism == Back_End_Exceptions
+	     && Is_Pure (gnat_entity));
+
 	bool volatile_flag = No_Return (gnat_entity);
 	bool returns_by_ref = false;
 	bool returns_unconstrained = false;
@@ -3972,12 +3984,12 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
 
 		/* If a parameter is a pointer, this function may modify
 		   memory through it and thus shouldn't be considered
-		   a pure function.  Also, the memory may be modified
+		   a const function.  Also, the memory may be modified
 		   between two calls, so they can't be CSE'ed.  The latter
 		   case also handles by-ref parameters.  */
 		if (POINTER_TYPE_P (gnu_param_type)
 		    || TYPE_FAT_POINTER_P (gnu_param_type))
-		  pure_flag = false;
+		  const_flag = false;
 	      }
 
 	    if (copy_in_copy_out)
@@ -4054,21 +4066,16 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
 				   returns_by_ref, returns_by_target_ptr);
 
 	/* A subprogram (something that doesn't return anything) shouldn't
-	   be considered Pure since there would be no reason for such a
+	   be considered const since there would be no reason for such a
 	   subprogram.  Note that procedures with Out (or In Out) parameters
 	   have already been converted into a function with a return type. */
 	if (TREE_CODE (gnu_return_type) == VOID_TYPE)
-	  pure_flag = false;
-
-	/* The semantics of "pure" in Ada used to essentially match that of
-	   "const" in the middle-end.  In particular, both properties were
-	   orthogonal to the "nothrow" property.  This is not true in the
-	   middle-end any more and we have no choice but to ignore the hint
-	   at this stage.  */
+	  const_flag = false;
 
 	gnu_type
 	  = build_qualified_type (gnu_type,
 				  TYPE_QUALS (gnu_type)
+				  | (TYPE_QUAL_CONST * const_flag)
 				  | (TYPE_QUAL_VOLATILE * volatile_flag));
 
 	Sloc_to_locus (Sloc (gnat_entity), &input_location);
@@ -4077,8 +4084,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
 	  gnu_stub_type
 	    = build_qualified_type (gnu_stub_type,
 				    TYPE_QUALS (gnu_stub_type)
-				    | (Exception_Mechanism == Back_End_Exceptions
-				       ? TYPE_QUAL_CONST * pure_flag : 0)
+				    | (TYPE_QUAL_CONST * const_flag)
 				    | (TYPE_QUAL_VOLATILE * volatile_flag));
 
 	/* If we have a builtin decl for that function, check the signatures
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 432b55e..a199f2b 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,9 @@
+2008-11-13  Olivier Hainque  <hainque@adacore.com>
+
+	* gnat.dg/test_raise_from_pure.adb: Adjust to match revised intent.
+	* gnat.dg/wrap_raise_from_pure.adb: Remove.
+	* gnat.dg/handle_raise_from_pure.adb: New test.
+
 2008-11-12  Tobias Burnus  <burnus@net-b.de>
 
 	PR fortran/38094
diff --git a/gcc/testsuite/gnat.dg/handle_raise_from_pure.adb b/gcc/testsuite/gnat.dg/handle_raise_from_pure.adb
new file mode 100644
index 0000000..0248d35
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/handle_raise_from_pure.adb
@@ -0,0 +1,11 @@
+--  { dg-do run }
+--  { dg-options "-O2" }
+with Ada.Text_Io; use Ada.Text_IO;
+with Raise_From_Pure; use Raise_From_Pure;
+procedure handle_raise_from_pure is
+   K : Integer;
+begin
+   K := Raise_CE_If_0 (0);
+exception
+   when others => Put_Line ("exception caught");
+end;
diff --git a/gcc/testsuite/gnat.dg/test_raise_from_pure.adb b/gcc/testsuite/gnat.dg/test_raise_from_pure.adb
index ab1ed16..a3a9c64 100644
--- a/gcc/testsuite/gnat.dg/test_raise_from_pure.adb
+++ b/gcc/testsuite/gnat.dg/test_raise_from_pure.adb
@@ -1,9 +1,8 @@
 --  { dg-do run }
 --  { dg-options "-O2" }
-with Wrap_Raise_From_Pure; use Wrap_Raise_From_Pure;
+with Raise_From_Pure; use Raise_From_Pure;
 procedure test_raise_from_pure is
+   K : Integer;
 begin
-   Wrap_Raise_From_Pure.Check;
-exception
-   when Constraint_Error => null;
+   K := Raise_CE_If_0 (0);
 end;
diff --git a/gcc/testsuite/gnat.dg/wrap_raise_from_pure.adb b/gcc/testsuite/gnat.dg/wrap_raise_from_pure.adb
deleted file mode 100644
index ec8f342..0000000
--- a/gcc/testsuite/gnat.dg/wrap_raise_from_pure.adb
+++ /dev/null
@@ -1,10 +0,0 @@
-with Ada.Text_Io; use Ada.Text_Io;
-with Raise_From_Pure; use Raise_From_Pure;
-package body Wrap_Raise_From_Pure is
-   procedure Check is
-      K : Integer;
-   begin
-      K := Raise_CE_If_0 (0);
-      Put_Line ("Should never reach here");
-   end;
-end;
diff --git a/gcc/testsuite/gnat.dg/wrap_raise_from_pure.ads b/gcc/testsuite/gnat.dg/wrap_raise_from_pure.ads
deleted file mode 100644
index 521c04a..0000000
--- a/gcc/testsuite/gnat.dg/wrap_raise_from_pure.ads
+++ /dev/null
@@ -1,4 +0,0 @@
-
-package Wrap_Raise_From_Pure is
-   procedure Check;
-end;