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

        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

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 2200652..4101dad 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/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

diff --git a/gcc/ada/gcc-interface/decl.c b/gcc/ada/gcc-interface/decl.c
index f7f4a0d..89621db 100644 (file)
--- a/gcc/ada/gcc-interface/decl.c
+++ b/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);

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 6f9210d..bd823ca 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/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.

diff --git a/gcc/testsuite/gnat.dg/raise_from_pure.adb b/gcc/testsuite/gnat.dg/raise_from_pure.adb
new file mode 100644 (file)
index 0000000..62e543e
--- /dev/null
+++ b/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;
+
+

diff --git a/gcc/testsuite/gnat.dg/raise_from_pure.ads b/gcc/testsuite/gnat.dg/raise_from_pure.ads
new file mode 100644 (file)
index 0000000..9c363a5
--- /dev/null
+++ b/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;

diff --git a/gcc/testsuite/gnat.dg/test_raise_from_pure.adb b/gcc/testsuite/gnat.dg/test_raise_from_pure.adb
new file mode 100644 (file)
index 0000000..ab1ed16
--- /dev/null
+++ b/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;

diff --git a/gcc/testsuite/gnat.dg/wrap_raise_from_pure.adb b/gcc/testsuite/gnat.dg/wrap_raise_from_pure.adb
new file mode 100644 (file)
index 0000000..ec8f342
--- /dev/null
+++ b/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;

diff --git a/gcc/testsuite/gnat.dg/wrap_raise_from_pure.ads b/gcc/testsuite/gnat.dg/wrap_raise_from_pure.ads
new file mode 100644 (file)
index 0000000..521c04a
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/wrap_raise_from_pure.ads
@@ -0,0 +1,4 @@
+
+package Wrap_Raise_From_Pure is
+   procedure Check;
+end;