diff options
| -rw-r--r-- | gcc/ada/ChangeLog | 7 | ||||
| -rw-r--r-- | gcc/ada/gcc-interface/trans.c | 30 | ||||
| -rw-r--r-- | gcc/testsuite/ChangeLog | 5 | ||||
| -rw-r--r-- | gcc/testsuite/gnat.dg/discr34.adb | 9 | ||||
| -rw-r--r-- | gcc/testsuite/gnat.dg/discr34_pkg.ads | 16 |
5 files changed, 62 insertions, 5 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 433fff4..2b9db09 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,5 +1,12 @@ 2012-01-27 Eric Botcazou <ebotcazou@adacore.com> + * 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 <ebotcazou@adacore.com> + * gcc-interface/ada-tree.h (DECL_ALIASED_P): New flag. * gcc-interface/decl.c (is_variable_size): Rename to... (type_has_variable_size): ...this. diff --git a/gcc/ada/gcc-interface/trans.c b/gcc/ada/gcc-interface/trans.c index 077d4a6..53a277e 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 66a5eed..a1844b7 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,5 +1,10 @@ 2012-01-27 Eric Botcazou <ebotcazou@adacore.com> + * gnat.dg/discr34.adb: New test. + * gnat.dg/discr34_pkg.ads: New helper. + +2012-01-27 Eric Botcazou <ebotcazou@adacore.com> + * gnat.dg/discr33.adb: New test. 2012-01-27 Eric Botcazou <ebotcazou@adacore.com> diff --git a/gcc/testsuite/gnat.dg/discr34.adb b/gcc/testsuite/gnat.dg/discr34.adb new file mode 100644 index 0000000..7beab95 --- /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 0000000..9a3380e --- /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; |