From: Olivier Hainque Date: Thu, 13 Nov 2008 14:43:23 +0000 (+0000) Subject: decl.c (gnat_to_gnu_entity): Turn Ada Pure on subprograms back into GCC CONST when... X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=255e5b0481a06f5fb7cf41c8b1d511cf506b943f;p=gcc.git 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) : 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 5c604ee1d8a..3df2baf5850 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,9 @@ +2008-11-13 Olivier Hainque + + * gcc-interface/decl.c (gnat_to_gnu_entity) : + Turn Ada Pure on subprograms back into GCC CONST when eh constructs + are explicit to the middle-end. Tidy. + 2008-11-09 Eric Botcazou * 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 188b896180d..22ca3a51fa7 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 432b55e7687..a199f2b3149 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,9 @@ +2008-11-13 Olivier Hainque + + * 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 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 00000000000..0248d350d71 --- /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 ab1ed16db5c..a3a9c649659 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 ec8f342c6b5..00000000000 --- 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 521c04a5fc9..00000000000 --- 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;