From 915e412789c55d34e1809deae9a39c6a9fc5543e Mon Sep 17 00:00:00 2001 From: hainque Date: Fri, 1 Aug 2008 10:36:01 +0000 Subject: [PATCH] ada/ * decl.c (gnat_to_gnu_entity) : 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. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@138509 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/ada/ChangeLog | 5 +++++ gcc/ada/gcc-interface/decl.c | 16 ++++++---------- gcc/testsuite/ChangeLog | 6 ++++++ gcc/testsuite/gnat.dg/raise_from_pure.adb | 11 +++++++++++ gcc/testsuite/gnat.dg/raise_from_pure.ads | 5 +++++ gcc/testsuite/gnat.dg/test_raise_from_pure.adb | 9 +++++++++ gcc/testsuite/gnat.dg/wrap_raise_from_pure.adb | 10 ++++++++++ gcc/testsuite/gnat.dg/wrap_raise_from_pure.ads | 4 ++++ 8 files changed, 56 insertions(+), 10 deletions(-) create mode 100644 gcc/testsuite/gnat.dg/raise_from_pure.adb create mode 100644 gcc/testsuite/gnat.dg/raise_from_pure.ads create mode 100644 gcc/testsuite/gnat.dg/test_raise_from_pure.adb create mode 100644 gcc/testsuite/gnat.dg/wrap_raise_from_pure.adb create mode 100644 gcc/testsuite/gnat.dg/wrap_raise_from_pure.ads diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 220065229e3..4101dada644 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,8 @@ +2008-08-01 Olivier Hainque + + * decl.c (gnat_to_gnu_entity) : Do not turn Ada + Pure into GCC const, now implicitely implying nothrow as well. + 2008-08-01 Robert Dewar * 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 f7f4a0d1b61..89621db6eab 100644 --- 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 6f9210d8336..bd823ca614a 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,9 @@ +2008-08-01 Olivier Hainque + + * 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 * 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 index 00000000000..62e543e94db --- /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 index 00000000000..9c363a5be48 --- /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 index 00000000000..ab1ed16db5c --- /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 index 00000000000..ec8f342c6b5 --- /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 index 00000000000..521c04a5fc9 --- /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; -- 2.11.4.GIT