Commit 16934bbf by Eric Botcazou Committed by Eric Botcazou

trans.c (gnat_to_gnu): Avoid making a SAVE_EXPR for a call to a function that…

trans.c (gnat_to_gnu): Avoid making a SAVE_EXPR for a call to a function that returns an unconstrained...

	* 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
parent 5f2e59d4
2012-01-27 Eric Botcazou <ebotcazou@adacore.com> 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/ada-tree.h (DECL_ALIASED_P): New flag.
* gcc-interface/decl.c (is_variable_size): Rename to... * gcc-interface/decl.c (is_variable_size): Rename to...
(type_has_variable_size): ...this. (type_has_variable_size): ...this.
......
...@@ -6869,10 +6869,14 @@ gnat_to_gnu (Node_Id gnat_node) ...@@ -6869,10 +6869,14 @@ gnat_to_gnu (Node_Id gnat_node)
N_Raise_Constraint_Error)); N_Raise_Constraint_Error));
} }
/* If our result has side-effects and is of an unconstrained type, /* If the result has side-effects and is of an unconstrained type, make a
make a SAVE_EXPR so that we can be sure it will only be referenced SAVE_EXPR so that we can be sure it will only be referenced once. But
once. Note we must do this before any conversions. */ 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) 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 && (TREE_CODE (gnu_result_type) == UNCONSTRAINED_ARRAY_TYPE
|| CONTAINS_PLACEHOLDER_P (TYPE_SIZE (gnu_result_type)))) || CONTAINS_PLACEHOLDER_P (TYPE_SIZE (gnu_result_type))))
gnu_result = gnat_stabilize_reference (gnu_result, false, NULL); gnu_result = gnat_stabilize_reference (gnu_result, false, NULL);
...@@ -6898,7 +6902,11 @@ gnat_to_gnu (Node_Id gnat_node) ...@@ -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 3. If the type is void or if we have no result, return error_mark_node
to show we have no result. 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)) if (Present (Parent (gnat_node))
&& (lhs_or_actual_p (gnat_node) && (lhs_or_actual_p (gnat_node)
...@@ -6949,7 +6957,19 @@ gnat_to_gnu (Node_Id 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) else if (gnu_result == error_mark_node || gnu_result_type == void_type_node)
gnu_result = error_mark_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); gnu_result = convert (gnu_result_type, gnu_result);
/* We don't need any NOP_EXPR or NON_LVALUE_EXPR on the result. */ /* We don't need any NOP_EXPR or NON_LVALUE_EXPR on the result. */
......
2012-01-27 Eric Botcazou <ebotcazou@adacore.com> 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. * gnat.dg/discr33.adb: New test.
2012-01-27 Eric Botcazou <ebotcazou@adacore.com> 2012-01-27 Eric Botcazou <ebotcazou@adacore.com>
......
-- { dg-do compile }
with Discr34_Pkg; use Discr34_Pkg;
procedure Discr34 is
Object : Rec := F;
begin
null;
end;
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;
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment