decl.c (gnat_to_gnu_entity): Do not turn Ada Pure into GCC const, now implicitely implying nothrow as well.

ada/
        * decl.c (gnat_to_gnu_entity) <case E_Function>: Do not turn Ada
        Pure into GCC const, now implicitely implying nothrow as well.

        testsuite/
        * gnat.dg/raise_from_pure.ad[bs],
        * gnat.dg/wrap_raise_from_pure.ad[bs]: Support for ...
        * gnat.dg/test_raise_from_pure.adb: New test.

From-SVN: r138509

gcc/ada/ChangeLog

@@ -1,3 +1,8 @@
+2008-08-01  Olivier Hainque  <hainque@adacore.com>
+	
+	* decl.c (gnat_to_gnu_entity) <case E_Function>: Do not turn Ada
+	Pure into GCC const, now implicitely implying nothrow as well.
+
 2008-08-01  Robert Dewar  <dewar@adacore.com>
 
 	* sem_prag.adb (Check_Form_Of_Interface_Name): Refine and improve

gcc/ada/gcc-interface/decl.c

@@ -4025,19 +4025,15 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
 	if (TREE_CODE (gnu_return_type) == VOID_TYPE)
 	  pure_flag = false;
 
-	/* 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.  But this is true only 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.  */
+	/* 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.  */
+
 	gnu_type
 	  = build_qualified_type (gnu_type,
 				  TYPE_QUALS (gnu_type)
-				  | (Exception_Mechanism == Back_End_Exceptions
-				     ? TYPE_QUAL_CONST * pure_flag : 0)
 				  | (TYPE_QUAL_VOLATILE * volatile_flag));
 
 	Sloc_to_locus (Sloc (gnat_entity), &input_location);

gcc/testsuite/ChangeLog

@@ -1,3 +1,9 @@
+2008-08-01  Olivier Hainque  <hainque@adacore.com>
+
+	* gnat.dg/raise_from_pure.ad[bs],
+	* gnat.dg/wrap_raise_from_pure.ad[bs]: Support for ...
+	* gnat.dg/test_raise_from_pure.adb: New test.
+	
 2008-07-31  Adam Nemet  <anemet@caviumnetworks.com>
 
 	* gcc.target/mips/ext-1.c: New test.

gcc/testsuite/gnat.dg/raise_from_pure.adb

@@ -0,0 +1,11 @@
+package body raise_from_pure is
+   function Raise_CE_If_0 (P : Integer) return Integer is
+   begin
+      if P = 0 then
+         raise Constraint_error;
+      end if;
+      return 1;
+   end;
+end;
+
+

gcc/testsuite/gnat.dg/raise_from_pure.ads

@@ -0,0 +1,5 @@
+
+package raise_from_pure is
+   pragma Pure;
+   function Raise_CE_If_0 (P : Integer) return Integer;
+end;

gcc/testsuite/gnat.dg/test_raise_from_pure.adb

@@ -0,0 +1,9 @@
+--  { dg-do run }
+--  { dg-options "-O2" }
+with Wrap_Raise_From_Pure; use Wrap_Raise_From_Pure;
+procedure test_raise_from_pure is
+begin
+   Wrap_Raise_From_Pure.Check;
+exception
+   when Constraint_Error => null;
+end;

gcc/testsuite/gnat.dg/wrap_raise_from_pure.adb

@@ -0,0 +1,10 @@
+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;

gcc/testsuite/gnat.dg/wrap_raise_from_pure.ads

@@ -0,0 +1,4 @@
+
+package Wrap_Raise_From_Pure is
+   procedure Check;
+end;