From 16934bbf731f4cd735b9d93d6695f181c7ec59ef Mon Sep 17 00:00:00 2001 From: Eric Botcazou Date: Fri, 27 Jan 2012 09:44:27 +0000 Subject: [PATCH] trans.c (gnat_to_gnu): Avoid making a SAVE_EXPR for a call to a function that returns an unconstrained... MIME-Version: 1.0 Content-Type: text/plain; charset=utf8 Content-Transfer-Encoding: 8bit * gcc-interface/trans.c (gnat_to_gnu): Avoid making a SAVE_EXPR for a call to a function that returns an unconstrained type with default discriminant.  Similarly, avoid doing the conversion to the nominal From-SVN: r183610 --- gcc/ada/ChangeLog | 7 +++++++ gcc/ada/gcc-interface/trans.c | 30 ++++++++++++++++++++++----- gcc/testsuite/ChangeLog | 5 +++++ gcc/testsuite/gnat.dg/discr34.adb | 9 ++++++++ gcc/testsuite/gnat.dg/discr34_pkg.ads | 16 ++++++++++++++ 5 files changed, 62 insertions(+), 5 deletions(-) create mode 100644 gcc/testsuite/gnat.dg/discr34.adb create mode 100644 gcc/testsuite/gnat.dg/discr34_pkg.ads diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 433fff461d8..2b9db093cab 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,10 @@ +2012-01-27 Eric Botcazou + + * gcc-interface/trans.c (gnat_to_gnu): Avoid making a SAVE_EXPR for + a call to a function that returns an unconstrained type with default + discriminant.  Similarly, avoid doing the conversion to the nominal + result type in this case. + 2012-01-27 Eric Botcazou * gcc-interface/ada-tree.h (DECL_ALIASED_P): New flag. diff --git a/gcc/ada/gcc-interface/trans.c b/gcc/ada/gcc-interface/trans.c index 077d4a64769..53a277e368f 100644 --- a/gcc/ada/gcc-interface/trans.c +++ b/gcc/ada/gcc-interface/trans.c @@ -6869,10 +6869,14 @@ gnat_to_gnu (Node_Id gnat_node) N_Raise_Constraint_Error)); } - /* If our result has side-effects and is of an unconstrained type, - make a SAVE_EXPR so that we can be sure it will only be referenced - once. Note we must do this before any conversions. */ + /* If the result has side-effects and is of an unconstrained type, make a + SAVE_EXPR so that we can be sure it will only be referenced once. But + this is useless for a call to a function that returns an unconstrained + type with default discriminant, as we cannot compute the size of the + actual returned object. We must do this before any conversions. */ if (TREE_SIDE_EFFECTS (gnu_result) + && !(TREE_CODE (gnu_result) == CALL_EXPR + && TYPE_IS_PADDING_P (TREE_TYPE (gnu_result))) && (TREE_CODE (gnu_result_type) == UNCONSTRAINED_ARRAY_TYPE || CONTAINS_PLACEHOLDER_P (TYPE_SIZE (gnu_result_type)))) gnu_result = gnat_stabilize_reference (gnu_result, false, NULL); @@ -6898,7 +6902,11 @@ gnat_to_gnu (Node_Id gnat_node) 3. If the type is void or if we have no result, return error_mark_node to show we have no result. - 4. Finally, if the type of the result is already correct. */ + 4. If this a call to a function that returns an unconstrained type with + default discriminant, return the call expression unmodified since we + cannot compute the size of the actual returned object. + + 5. Finally, if the type of the result is already correct. */ if (Present (Parent (gnat_node)) && (lhs_or_actual_p (gnat_node) @@ -6949,7 +6957,19 @@ gnat_to_gnu (Node_Id gnat_node) else if (gnu_result == error_mark_node || gnu_result_type == void_type_node) gnu_result = error_mark_node; - else if (gnu_result_type != TREE_TYPE (gnu_result)) + else if (TREE_CODE (gnu_result) == CALL_EXPR + && TYPE_IS_PADDING_P (TREE_TYPE (gnu_result)) + && CONTAINS_PLACEHOLDER_P (TYPE_SIZE (gnu_result_type))) + { + /* ??? We need to convert if the padded type has fixed size because + gnat_types_compatible_p will say that padded types are compatible + but the gimplifier will not and, therefore, will ultimately choke + if there isn't a conversion added early. */ + if (TREE_CODE (TYPE_SIZE (TREE_TYPE (gnu_result))) == INTEGER_CST) + gnu_result = convert (gnu_result_type, gnu_result); + } + + else if (TREE_TYPE (gnu_result) != gnu_result_type) gnu_result = convert (gnu_result_type, gnu_result); /* We don't need any NOP_EXPR or NON_LVALUE_EXPR on the result. */ diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 66a5eedf184..a1844b7cf90 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2012-01-27 Eric Botcazou + + * gnat.dg/discr34.adb: New test. + * gnat.dg/discr34_pkg.ads: New helper. + 2012-01-27 Eric Botcazou * gnat.dg/discr33.adb: New test. diff --git a/gcc/testsuite/gnat.dg/discr34.adb b/gcc/testsuite/gnat.dg/discr34.adb new file mode 100644 index 00000000000..7beab9540d0 --- /dev/null +++ b/gcc/testsuite/gnat.dg/discr34.adb @@ -0,0 +1,9 @@ +-- { dg-do compile } + +with Discr34_Pkg; use Discr34_Pkg; + +procedure Discr34 is + Object : Rec := F; +begin + null; +end; diff --git a/gcc/testsuite/gnat.dg/discr34_pkg.ads b/gcc/testsuite/gnat.dg/discr34_pkg.ads new file mode 100644 index 00000000000..9a3380e371d --- /dev/null +++ b/gcc/testsuite/gnat.dg/discr34_pkg.ads @@ -0,0 +1,16 @@ +package Discr34_Pkg is + + function N return Natural; + + type Enum is (One, Two); + + type Rec (D : Enum := One) is record + case D is + when One => S : String (1 .. N); + when Two => null; + end case; + end record; + + function F return Rec; + +end Discr34_Pkg; -- 2.30.2