From 93a0049f748e997db75d4a4f45bc40c021853bab Mon Sep 17 00:00:00 2001 From: Eric Botcazou Date: Sat, 2 Jun 2018 09:58:46 +0000 Subject: [PATCH] backport: trans.c (Call_to_gnu): If this is a function call and there is no target... Backport from mainline 2018-05-31 Eric Botcazou * gcc-interface/trans.c (Call_to_gnu): If this is a function call and there is no target, also create a temporary for the return value for an allocator if the type is an unconstrained record type with default discriminant. From-SVN: r261105 --- gcc/ada/ChangeLog | 10 ++++++++++ gcc/ada/gcc-interface/trans.c | 16 ++++++++++------ gcc/testsuite/ChangeLog | 5 +++++ gcc/testsuite/gnat.dg/discr53.adb | 19 +++++++++++++++++++ gcc/testsuite/gnat.dg/discr53.ads | 16 ++++++++++++++++ gcc/testsuite/gnat.dg/discr53_pkg.ads | 5 +++++ 6 files changed, 65 insertions(+), 6 deletions(-) create mode 100644 gcc/testsuite/gnat.dg/discr53.adb create mode 100644 gcc/testsuite/gnat.dg/discr53.ads create mode 100644 gcc/testsuite/gnat.dg/discr53_pkg.ads diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 67abd8fcf94c..7f6106e0fbdf 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,13 @@ +2018-06-02 Eric Botcazou + + Backport from mainline + 2018-05-31 Eric Botcazou + + * gcc-interface/trans.c (Call_to_gnu): If this is a function call and + there is no target, also create a temporary for the return value for + an allocator if the type is an unconstrained record type with default + discriminant. + 2018-03-06 Eric Botcazou * gcc-interface/trans.c (convert_with_check): Fix typo in the condition diff --git a/gcc/ada/gcc-interface/trans.c b/gcc/ada/gcc-interface/trans.c index 245994181f34..46d88fc8e285 100644 --- a/gcc/ada/gcc-interface/trans.c +++ b/gcc/ada/gcc-interface/trans.c @@ -4302,12 +4302,15 @@ Call_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, tree gnu_target, because we need to preserve the return value before copying back the parameters. - 2. There is no target and the call is made for neither an object nor a + 2. There is no target and the call is made for neither an object, nor a renaming declaration, nor a return statement, nor an allocator, and the return type has variable size because in this case the gimplifier - cannot create the temporary, or more generally is simply an aggregate - type, because the gimplifier would then create the temporary in the - outermost scope instead of locally. + cannot create the temporary, or more generally is an aggregate type, + because the gimplifier would create the temporary in the outermost + scope instead of locally. But there is an exception for an allocator + of an unconstrained record type with default discriminant because we + allocate the actual size in this case, unlike the other 3 cases, so + we need a temporary to fetch the discriminant and we create it here. 3. There is a target and it is a slice or an array with fixed size, and the return type has variable size, because the gimplifier @@ -4326,8 +4329,9 @@ Call_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, tree gnu_target, && Nkind (Parent (gnat_node)) != N_Object_Declaration && Nkind (Parent (gnat_node)) != N_Object_Renaming_Declaration && Nkind (Parent (gnat_node)) != N_Simple_Return_Statement - && !(Nkind (Parent (gnat_node)) == N_Qualified_Expression - && Nkind (Parent (Parent (gnat_node))) == N_Allocator) + && (!(Nkind (Parent (gnat_node)) == N_Qualified_Expression + && Nkind (Parent (Parent (gnat_node))) == N_Allocator) + || type_is_padding_self_referential (gnu_result_type)) && AGGREGATE_TYPE_P (gnu_result_type) && !TYPE_IS_FAT_POINTER_P (gnu_result_type)) || (gnu_target diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 95dfdec8e410..e21528939c42 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2018-06-02 Eric Botcazou + + * gnat.dg/discr53.ad[sb]: New test. + * gnat.dg/discr53_pkg.ads: New helper. + 2018-05-25 Steven G. Kargl PR fortran/85895 diff --git a/gcc/testsuite/gnat.dg/discr53.adb b/gcc/testsuite/gnat.dg/discr53.adb new file mode 100644 index 000000000000..2e362a7fd297 --- /dev/null +++ b/gcc/testsuite/gnat.dg/discr53.adb @@ -0,0 +1,19 @@ +-- { dg-do compile } + +package body Discr53 is + + function F return Rec is + Data : Rec; + begin + return Data; + end; + + type Ptr is access Rec; + + procedure Proc is + Local : Ptr; + begin + Local := new Rec'(F); + end; + +end Discr53; diff --git a/gcc/testsuite/gnat.dg/discr53.ads b/gcc/testsuite/gnat.dg/discr53.ads new file mode 100644 index 000000000000..3fa9f0f4845c --- /dev/null +++ b/gcc/testsuite/gnat.dg/discr53.ads @@ -0,0 +1,16 @@ +with Discr53_Pkg; + +package Discr53 is + + type Rec (D : Boolean := False) is record + case D is + when True => S : String (1 .. Discr53_Pkg.Max); + when False => null; + end case; + end record; + + function F return Rec; + + procedure Proc; + +end Discr53; diff --git a/gcc/testsuite/gnat.dg/discr53_pkg.ads b/gcc/testsuite/gnat.dg/discr53_pkg.ads new file mode 100644 index 000000000000..d36e1ba2a12c --- /dev/null +++ b/gcc/testsuite/gnat.dg/discr53_pkg.ads @@ -0,0 +1,5 @@ +package Discr53_Pkg is + + function Max return Natural; + +end Discr53_Pkg; -- 2.47.2