OpenE2K/gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

decl.c (gnat_to_gnu_entity): Turn Ada Pure on subprograms back into GCC CONST when...

Browse Source 
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
This commit is contained in:
Olivier Hainque 2008-11-13 14:43:23 +00:00 committed by Olivier Hainque
parent cea094edca
commit 255e5b0481
7 changed files with 45 additions and 31 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
gcc/ada/ChangeLog
View File

@ -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.

32
gcc/ada/gcc-interface/decl.c
View File

@ -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

6
gcc/testsuite/ChangeLog
View File

@ -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

11
gcc/testsuite/gnat.dg/handle_raise_from_pure.adb Normal file
View File

@ -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;

7
gcc/testsuite/gnat.dg/test_raise_from_pure.adb
View File

@ -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;

10
gcc/testsuite/gnat.dg/wrap_raise_from_pure.adb
View File

@ -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;

4
gcc/testsuite/gnat.dg/wrap_raise_from_pure.ads
View File

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