From 113c69ff2d41091359ec37789974cc47f1169e05 Mon Sep 17 00:00:00 2001 From: Eric Botcazou Date: Wed, 8 Apr 2015 09:08:12 +0000 Subject: [PATCH] decl.c (gnat_to_gnu_entity): Do not make a function returning an unconstrained type 'const' for the middle-end. * gcc-interface/decl.c (gnat_to_gnu_entity) : Do not make a function returning an unconstrained type 'const' for the middle-end. * gcc-interface/trans.c (Pragma_to_gnu) : Use exact condition to detect Reason => "..." pattern. From-SVN: r221916 --- gcc/ada/ChangeLog | 8 ++++++++ gcc/ada/gcc-interface/decl.c | 20 ++++++++++++-------- gcc/ada/gcc-interface/trans.c | 3 ++- gcc/testsuite/ChangeLog | 6 ++++++ gcc/testsuite/gnat.dg/opt48.adb | 12 ++++++++++++ gcc/testsuite/gnat.dg/opt48_pkg1.adb | 17 +++++++++++++++++ gcc/testsuite/gnat.dg/opt48_pkg1.ads | 7 +++++++ gcc/testsuite/gnat.dg/opt48_pkg2.adb | 8 ++++++++ gcc/testsuite/gnat.dg/opt48_pkg2.ads | 11 +++++++++++ 9 files changed, 83 insertions(+), 9 deletions(-) create mode 100644 gcc/testsuite/gnat.dg/opt48.adb create mode 100644 gcc/testsuite/gnat.dg/opt48_pkg1.adb create mode 100644 gcc/testsuite/gnat.dg/opt48_pkg1.ads create mode 100644 gcc/testsuite/gnat.dg/opt48_pkg2.adb create mode 100644 gcc/testsuite/gnat.dg/opt48_pkg2.ads diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 8b9fbe5b65f..d93e5ac9c88 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,11 @@ +2015-04-08 Eric Botcazou + + * gcc-interface/decl.c (gnat_to_gnu_entity) : Do not make + a function returning an unconstrained type 'const' for the middle-end. + + * gcc-interface/trans.c (Pragma_to_gnu) : Use + exact condition to detect Reason => "..." pattern. + 2015-03-31 Tom de Vries PR ada/65490 diff --git a/gcc/ada/gcc-interface/decl.c b/gcc/ada/gcc-interface/decl.c index 0027d6f2f0c..d908a1b750d 100644 --- a/gcc/ada/gcc-interface/decl.c +++ b/gcc/ada/gcc-interface/decl.c @@ -4266,8 +4266,9 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) return_by_direct_ref_p = true; } - /* If we are supposed to return an unconstrained array type, make - the actual return type the fat pointer type. */ + /* If the return type is an unconstrained array type, the return + value will be allocated on the secondary stack so the actual + return type is the fat pointer type. */ else if (TREE_CODE (gnu_return_type) == UNCONSTRAINED_ARRAY_TYPE) { gnu_return_type = TREE_TYPE (gnu_return_type); @@ -4275,8 +4276,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) } /* Likewise, if the return type requires a transient scope, the - return value will be allocated on the secondary stack so the - actual return type is the pointer type. */ + return value will also be allocated on the secondary stack so + the actual return type is the pointer type. */ else if (Requires_Transient_Scope (gnat_return_type)) { gnu_return_type = build_pointer_type (gnu_return_type); @@ -4591,11 +4592,14 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) return_by_direct_ref_p, return_by_invisi_ref_p); - /* A subprogram (something that doesn't return anything) shouldn't - be considered const since there would be no reason for such a + /* A procedure (something that doesn't return anything) shouldn't be + considered const since there would be no reason for calling 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) + have already been converted into a function with a return type. + Similarly, if the function returns an unconstrained type, then the + function will allocate the return value on the secondary stack and + thus calls to it cannot be CSE'ed, lest the stack be reclaimed. */ + if (TREE_CODE (gnu_return_type) == VOID_TYPE || return_unconstrained_p) const_flag = false; if (const_flag || volatile_flag) diff --git a/gcc/ada/gcc-interface/trans.c b/gcc/ada/gcc-interface/trans.c index 73794772158..6ffee062a04 100644 --- a/gcc/ada/gcc-interface/trans.c +++ b/gcc/ada/gcc-interface/trans.c @@ -1444,7 +1444,8 @@ Pragma_to_gnu (Node_Id gnat_node) } /* Deal with optional pattern (but ignore Reason => "..."). */ - if (Present (Next (gnat_temp)) && No (Chars (Next (gnat_temp)))) + if (Present (Next (gnat_temp)) + && Chars (Next (gnat_temp)) != Name_Reason) { /* pragma Warnings (On | Off, Name) is handled differently. */ if (Nkind (Expression (Next (gnat_temp))) != N_String_Literal) diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 74a39ec2a23..a6a7be318be 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,9 @@ +2015-04-08 Eric Botcazou + + * gnat.dg/opt48.adb: New test. + * gnat.dg/opt48_pkg1.ad[sb]: New helper. + * gnat.dg/opt48_pkg2.ad[sb]: Likewise. + 2015-04-07 Jan Hubicka PR ipa/65540 diff --git a/gcc/testsuite/gnat.dg/opt48.adb b/gcc/testsuite/gnat.dg/opt48.adb new file mode 100644 index 00000000000..3f611cd1d6a --- /dev/null +++ b/gcc/testsuite/gnat.dg/opt48.adb @@ -0,0 +1,12 @@ +-- { dg-do run } +-- { dg-options "-O" } + +with Opt48_Pkg1; use Opt48_Pkg1; +with Opt48_Pkg2; use Opt48_Pkg2; + +procedure Opt48 is +begin + if Get_Z /= (12, "Hello world!") then + raise Program_Error; + end if; +end; diff --git a/gcc/testsuite/gnat.dg/opt48_pkg1.adb b/gcc/testsuite/gnat.dg/opt48_pkg1.adb new file mode 100644 index 00000000000..306551cea5f --- /dev/null +++ b/gcc/testsuite/gnat.dg/opt48_pkg1.adb @@ -0,0 +1,17 @@ +package body Opt48_Pkg1 is + + function G return Rec is + begin + return (32, "AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA"); + end G; + + X : Rec := F; + Y : Rec := G; + Z : Rec := F; + + function Get_Z return Rec is + begin + return Z; + end; + +end Opt48_Pkg1; diff --git a/gcc/testsuite/gnat.dg/opt48_pkg1.ads b/gcc/testsuite/gnat.dg/opt48_pkg1.ads new file mode 100644 index 00000000000..50154c20c03 --- /dev/null +++ b/gcc/testsuite/gnat.dg/opt48_pkg1.ads @@ -0,0 +1,7 @@ +with Opt48_Pkg2; use Opt48_Pkg2; + +package Opt48_Pkg1 is + + function Get_Z return Rec; + +end Opt48_Pkg1; diff --git a/gcc/testsuite/gnat.dg/opt48_pkg2.adb b/gcc/testsuite/gnat.dg/opt48_pkg2.adb new file mode 100644 index 00000000000..41836e7be71 --- /dev/null +++ b/gcc/testsuite/gnat.dg/opt48_pkg2.adb @@ -0,0 +1,8 @@ +package body Opt48_Pkg2 is + + function F return Rec is + begin + return (12, "Hello world!"); + end F; + +end Opt48_Pkg2; diff --git a/gcc/testsuite/gnat.dg/opt48_pkg2.ads b/gcc/testsuite/gnat.dg/opt48_pkg2.ads new file mode 100644 index 00000000000..d3edbeadb68 --- /dev/null +++ b/gcc/testsuite/gnat.dg/opt48_pkg2.ads @@ -0,0 +1,11 @@ +package Opt48_Pkg2 is + + pragma Pure; + + type Rec (L : Natural) is record + S : String (1 .. L); + end record; + + function F return Rec; + +end Opt48_Pkg2; -- 2.30.2