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

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 5c604ee..3df2baf 100644 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
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 (file)
--- 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 (file)
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 (file)
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;