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) <E_Function>: Do not make a function returning an unconstrained type 'const' for the middle-end. * gcc-interface/trans.c (Pragma_to_gnu) <case Pragma_Warning>: Use exact condition to detect Reason => "..." pattern. From-SVN: r221916
This commit is contained in:
parent
43941fa55c
commit
113c69ff2d
|
@ -1,3 +1,11 @@
|
|||
2015-04-08 Eric Botcazou <ebotcazou@adacore.com>
|
||||
|
||||
* gcc-interface/decl.c (gnat_to_gnu_entity) <E_Function>: Do not make
|
||||
a function returning an unconstrained type 'const' for the middle-end.
|
||||
|
||||
* gcc-interface/trans.c (Pragma_to_gnu) <case Pragma_Warning>: Use
|
||||
exact condition to detect Reason => "..." pattern.
|
||||
|
||||
2015-03-31 Tom de Vries <tom@codesourcery.com>
|
||||
|
||||
PR ada/65490
|
||||
|
|
|
@ -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)
|
||||
|
|
|
@ -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)
|
||||
|
|
|
@ -1,3 +1,9 @@
|
|||
2015-04-08 Eric Botcazou <ebotcazou@adacore.com>
|
||||
|
||||
* 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 <hubicka@ucw.cz>
|
||||
|
||||
PR ipa/65540
|
||||
|
|
|
@ -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;
|
|
@ -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;
|
|
@ -0,0 +1,7 @@
|
|||
with Opt48_Pkg2; use Opt48_Pkg2;
|
||||
|
||||
package Opt48_Pkg1 is
|
||||
|
||||
function Get_Z return Rec;
|
||||
|
||||
end Opt48_Pkg1;
|
|
@ -0,0 +1,8 @@
|
|||
package body Opt48_Pkg2 is
|
||||
|
||||
function F return Rec is
|
||||
begin
|
||||
return (12, "Hello world!");
|
||||
end F;
|
||||
|
||||
end Opt48_Pkg2;
|
|
@ -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;
|
Loading…
Reference in New Issue