From: ebotcazou Date: Wed, 8 Apr 2015 09:08:12 +0000 (+0000) Subject: * gcc-interface/decl.c (gnat_to_gnu_entity) : Do not make X-Git-Tag: upstream/5.3.0~997 X-Git-Url: http://review.tizen.org/git/?a=commitdiff_plain;h=95de51be8bb9d3ede2abc49ab318dd270a7b1b11;p=platform%2Fupstream%2Flinaro-gcc.git * 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. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@221916 138bc75d-0d04-0410-961f-82ee72b054a4 --- diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 8b9fbe5..d93e5ac 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 0027d6f..d908a1b 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 7379477..6ffee06 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 74a39ec..a6a7be3 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 0000000..3f611cd --- /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 0000000..306551c --- /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 0000000..50154c2 --- /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 0000000..41836e7 --- /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 0000000..d3edbea --- /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;