Commit fc7a823e by Eric Botcazou Committed by Eric Botcazou

gigi.h (gnat_stabilize_reference): Adjust.

	* gcc-interface/gigi.h (gnat_stabilize_reference): Adjust.
	(rewrite_fn): Remove third parameter.
	(type_is_padding_self_referential): New inline predicate.
	(return_type_with_variable_size_p): Likewise.
	* gcc-interface/decl.c (allocatable_size_p): More around.
	(cannot_be_superflat_p): Rename into...
	(cannot_be_superflat ): ...this.
	(initial_value_needs_conversion): New predicate.
	(gnat_to_gnu_entity): Invoke type_is_padding_self_referential,
	initial_value_needs_conversion and adjust to above renaming.
	For a renaming, force the materialization if the inner expression
	is compound.  Adjust calls to elaborate_reference and build a
	compound expression if needed.
	(struct er_dat): Add N field.
	(elaborate_reference_1): Remove N parameter and adjust.
	(elaborate_reference): Add INIT parameter and pass it in the call to
	gnat_rewrite_reference.  Adjust initial expression.
	* gcc-interface/trans.c (Call_to_gnu): Treat renamings the same way as
	regular object declarations when it comes to creating a temporary.
	Adjust call to gnat_stabilize_reference and build a compound expression
 	if needed.  Invoke return_type_with_variable_size_p.
	(gnat_to_gnu): Invoke type_is_padding_self_referential.  In case #4,
	return a call to a function unmodified if it returns with variable size
 	and is also the initial expression in an object declaration.
	* gcc-interface/utils2.c (build_binary_op) <INIT_EXPR>: Use the RHS'
	type if it is a call to a function that returns with variable size.
	(build_unary_op): Invoke type_is_padding_self_referential.
	(gnat_stabilize_reference_1): Remove N parameter and adjust.
	(gnat_stabilize_reference): Add INIT parameter and pass it in the call
	to gnat_rewrite_reference.
	(gnat_rewrite_reference):  Remove N, add INIT parameter and adjust.
	<COMPOUND_EXPR>: New case.

From-SVN: r223834
parent 318a4e6d
2015-05-28 Eric Botcazou <ebotcazou@adacore.com>
* gcc-interface/gigi.h (gnat_stabilize_reference): Adjust.
(rewrite_fn): Remove third parameter.
(type_is_padding_self_referential): New inline predicate.
(return_type_with_variable_size_p): Likewise.
* gcc-interface/decl.c (allocatable_size_p): More around.
(cannot_be_superflat_p): Rename into...
(cannot_be_superflat ): ...this.
(initial_value_needs_conversion): New predicate.
(gnat_to_gnu_entity): Invoke type_is_padding_self_referential,
initial_value_needs_conversion and adjust to above renaming.
For a renaming, force the materialization if the inner expression
is compound. Adjust calls to elaborate_reference and build a
compound expression if needed.
(struct er_dat): Add N field.
(elaborate_reference_1): Remove N parameter and adjust.
(elaborate_reference): Add INIT parameter and pass it in the call to
gnat_rewrite_reference. Adjust initial expression.
* gcc-interface/trans.c (Call_to_gnu): Treat renamings the same way as
regular object declarations when it comes to creating a temporary.
Adjust call to gnat_stabilize_reference and build a compound expression
if needed. Invoke return_type_with_variable_size_p.
(gnat_to_gnu): Invoke type_is_padding_self_referential. In case #4,
return a call to a function unmodified if it returns with variable size
and is also the initial expression in an object declaration.
* gcc-interface/utils2.c (build_binary_op) <INIT_EXPR>: Use the RHS'
type if it is a call to a function that returns with variable size.
(build_unary_op): Invoke type_is_padding_self_referential.
(gnat_stabilize_reference_1): Remove N parameter and adjust.
(gnat_stabilize_reference): Add INIT parameter and pass it in the call
to gnat_rewrite_reference.
(gnat_rewrite_reference): Remove N, add INIT parameter and adjust.
<COMPOUND_EXPR>: New case.
2015-05-28 Ed Schonberg <schonberg@adacore.com> 2015-05-28 Ed Schonberg <schonberg@adacore.com>
* sem_ch3.adb (Is_Visible_Component): Component is visible * sem_ch3.adb (Is_Visible_Component): Component is visible
......
...@@ -959,16 +959,16 @@ extern tree gnat_protect_expr (tree exp); ...@@ -959,16 +959,16 @@ extern tree gnat_protect_expr (tree exp);
/* This is equivalent to stabilize_reference in tree.c but we know how to /* This is equivalent to stabilize_reference in tree.c but we know how to
handle our own nodes and we take extra arguments. FORCE says whether to handle our own nodes and we take extra arguments. FORCE says whether to
force evaluation of everything. */ force evaluation of everything in REF. INIT is set to the first arm of
extern tree gnat_stabilize_reference (tree ref, bool force); a COMPOUND_EXPR present in REF, if any. */
extern tree gnat_stabilize_reference (tree ref, bool force, tree *init);
/* Rewrite reference REF and call FUNC on each expression within REF in the /* Rewrite reference REF and call FUNC on each expression within REF in the
process. DATA is passed unmodified to FUNC and N is bumped each time it process. DATA is passed unmodified to FUNC. INIT is set to the first
is passed to FUNC, so FUNC is guaranteed to see a given N only once per arm of a COMPOUND_EXPR present in REF, if any. */
reference to be rewritten. */ typedef tree (*rewrite_fn) (tree, void *);
typedef tree (*rewrite_fn) (tree, void *, int);
extern tree gnat_rewrite_reference (tree ref, rewrite_fn func, void *data, extern tree gnat_rewrite_reference (tree ref, rewrite_fn func, void *data,
int n = 1); tree *init);
/* This is equivalent to get_inner_reference in expr.c but it returns the /* This is equivalent to get_inner_reference in expr.c but it returns the
ultimate containing object only if the reference (lvalue) is constant, ultimate containing object only if the reference (lvalue) is constant,
...@@ -1085,3 +1085,30 @@ call_is_atomic_load (tree exp) ...@@ -1085,3 +1085,30 @@ call_is_atomic_load (tree exp)
enum built_in_function code = DECL_FUNCTION_CODE (fndecl); enum built_in_function code = DECL_FUNCTION_CODE (fndecl);
return BUILT_IN_ATOMIC_LOAD_N <= code && code <= BUILT_IN_ATOMIC_LOAD_16; return BUILT_IN_ATOMIC_LOAD_N <= code && code <= BUILT_IN_ATOMIC_LOAD_16;
} }
/* Return true if TYPE is padding a self-referential type. */
static inline bool
type_is_padding_self_referential (tree type)
{
if (!TYPE_IS_PADDING_P (type))
return false;
return CONTAINS_PLACEHOLDER_P (DECL_SIZE (TYPE_FIELDS (type)));
}
/* Return true if a function returning TYPE doesn't return a fixed size. */
static inline bool
return_type_with_variable_size_p (tree type)
{
if (TREE_CODE (TYPE_SIZE (type)) != INTEGER_CST)
return true;
/* Return true for an unconstrained type with default discriminant, see
the E_Subprogram_Type case of gnat_to_gnu_entity. */
if (type_is_padding_self_referential (type))
return true;
return false;
}
...@@ -4189,9 +4189,9 @@ Call_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, tree gnu_target, ...@@ -4189,9 +4189,9 @@ 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 because we need to preserve the return value before copying back the
parameters. parameters.
2. There is no target and this is not an object declaration, and the 2. There is no target and this is neither an object nor a renaming
return type has variable size, because in these cases the gimplifier declaration, and the return type has variable size, because in
cannot create the temporary. these cases the gimplifier cannot create the temporary.
3. There is a target and it is a slice or an array with fixed size, 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 and the return type has variable size, because the gimplifier
...@@ -4203,6 +4203,7 @@ Call_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, tree gnu_target, ...@@ -4203,6 +4203,7 @@ Call_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, tree gnu_target,
&& ((!gnu_target && TYPE_CI_CO_LIST (gnu_subprog_type)) && ((!gnu_target && TYPE_CI_CO_LIST (gnu_subprog_type))
|| (!gnu_target || (!gnu_target
&& Nkind (Parent (gnat_node)) != N_Object_Declaration && Nkind (Parent (gnat_node)) != N_Object_Declaration
&& Nkind (Parent (gnat_node)) != N_Object_Renaming_Declaration
&& TREE_CODE (TYPE_SIZE (gnu_result_type)) != INTEGER_CST) && TREE_CODE (TYPE_SIZE (gnu_result_type)) != INTEGER_CST)
|| (gnu_target || (gnu_target
&& (TREE_CODE (gnu_target) == ARRAY_RANGE_REF && (TREE_CODE (gnu_target) == ARRAY_RANGE_REF
...@@ -4258,7 +4259,13 @@ Call_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, tree gnu_target, ...@@ -4258,7 +4259,13 @@ Call_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, tree gnu_target,
if (Ekind (gnat_formal) != E_In_Parameter if (Ekind (gnat_formal) != E_In_Parameter
&& !is_by_ref_formal_parm && !is_by_ref_formal_parm
&& TREE_CODE (gnu_name) != NULL_EXPR) && TREE_CODE (gnu_name) != NULL_EXPR)
gnu_name = gnat_stabilize_reference (gnu_name, true); {
tree init = NULL_TREE;
gnu_name = gnat_stabilize_reference (gnu_name, true, &init);
if (init)
gnu_name
= build_compound_expr (TREE_TYPE (gnu_name), init, gnu_name);
}
/* If we are passing a non-addressable parameter by reference, pass the /* If we are passing a non-addressable parameter by reference, pass the
address of a copy. In the Out or In Out case, set up to copy back address of a copy. In the Out or In Out case, set up to copy back
...@@ -4724,12 +4731,8 @@ Call_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, tree gnu_target, ...@@ -4724,12 +4731,8 @@ Call_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, tree gnu_target,
/* ??? If the return type has variable size, then force the return /* ??? If the return type has variable size, then force the return
slot optimization as we would not be able to create a temporary. slot optimization as we would not be able to create a temporary.
Likewise if it was unconstrained as we would copy too much data.
That's what has been done historically. */ That's what has been done historically. */
if (TREE_CODE (TYPE_SIZE (gnu_result_type)) != INTEGER_CST if (return_type_with_variable_size_p (gnu_result_type))
|| (TYPE_IS_PADDING_P (gnu_result_type)
&& CONTAINS_PLACEHOLDER_P
(TYPE_SIZE (TREE_TYPE (TYPE_FIELDS (gnu_result_type))))))
op_code = INIT_EXPR; op_code = INIT_EXPR;
else else
op_code = MODIFY_EXPR; op_code = MODIFY_EXPR;
...@@ -6802,10 +6805,8 @@ gnat_to_gnu (Node_Id gnat_node) ...@@ -6802,10 +6805,8 @@ gnat_to_gnu (Node_Id gnat_node)
/* Do not remove the padding from GNU_RET_VAL if the inner type is /* Do not remove the padding from GNU_RET_VAL if the inner type is
self-referential since we want to allocate the fixed size. */ self-referential since we want to allocate the fixed size. */
if (TREE_CODE (gnu_ret_val) == COMPONENT_REF if (TREE_CODE (gnu_ret_val) == COMPONENT_REF
&& TYPE_IS_PADDING_P && type_is_padding_self_referential
(TREE_TYPE (TREE_OPERAND (gnu_ret_val, 0))) (TREE_OPERAND (gnu_ret_val, 0)))
&& CONTAINS_PLACEHOLDER_P
(TYPE_SIZE (TREE_TYPE (gnu_ret_val))))
gnu_ret_val = TREE_OPERAND (gnu_ret_val, 0); gnu_ret_val = TREE_OPERAND (gnu_ret_val, 0);
/* If the function returns by direct reference, return a pointer /* If the function returns by direct reference, return a pointer
...@@ -7486,7 +7487,7 @@ gnat_to_gnu (Node_Id gnat_node) ...@@ -7486,7 +7487,7 @@ gnat_to_gnu (Node_Id gnat_node)
actual returned object. We must do this before any conversions. */ 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 && !(TREE_CODE (gnu_result) == CALL_EXPR
&& TYPE_IS_PADDING_P (TREE_TYPE (gnu_result))) && type_is_padding_self_referential (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_protect_expr (gnu_result); gnu_result = gnat_protect_expr (gnu_result);
...@@ -7512,9 +7513,10 @@ gnat_to_gnu (Node_Id gnat_node) ...@@ -7512,9 +7513,10 @@ 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. If this a call to a function that returns an unconstrained type with 4. If this is a call to a function that returns with variable size and
default discriminant, return the call expression unmodified since we the call is used as the expression in either an object or a renaming
cannot compute the size of the actual returned object. declaration, return the result unmodified because we want to use the
return slot optimization in this case.
5. Finally, if the type of the result is already correct. */ 5. Finally, if the type of the result is already correct. */
...@@ -7543,9 +7545,7 @@ gnat_to_gnu (Node_Id gnat_node) ...@@ -7543,9 +7545,7 @@ gnat_to_gnu (Node_Id gnat_node)
size: in that case it must be an object of unconstrained type size: in that case it must be an object of unconstrained type
with a default discriminant and we want to avoid copying too with a default discriminant and we want to avoid copying too
much data. */ much data. */
if (TYPE_IS_PADDING_P (TREE_TYPE (gnu_result)) if (type_is_padding_self_referential (TREE_TYPE (gnu_result)))
&& CONTAINS_PLACEHOLDER_P (TYPE_SIZE (TREE_TYPE (TYPE_FIELDS
(TREE_TYPE (gnu_result))))))
gnu_result = convert (TREE_TYPE (TYPE_FIELDS (TREE_TYPE (gnu_result))), gnu_result = convert (TREE_TYPE (TYPE_FIELDS (TREE_TYPE (gnu_result))),
gnu_result); gnu_result);
} }
...@@ -7567,11 +7567,11 @@ gnat_to_gnu (Node_Id gnat_node) ...@@ -7567,11 +7567,11 @@ 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 (TREE_CODE (gnu_result) == CALL_EXPR else if (Present (Parent (gnat_node))
&& TYPE_IS_PADDING_P (TREE_TYPE (gnu_result)) && (Nkind (Parent (gnat_node)) == N_Object_Declaration
&& TREE_TYPE (TYPE_FIELDS (TREE_TYPE (gnu_result))) || Nkind (Parent (gnat_node)) == N_Object_Renaming_Declaration)
== gnu_result_type && TREE_CODE (gnu_result) == CALL_EXPR
&& CONTAINS_PLACEHOLDER_P (TYPE_SIZE (gnu_result_type))) && return_type_with_variable_size_p (TREE_TYPE (gnu_result)))
; ;
else if (TREE_TYPE (gnu_result) != gnu_result_type) else if (TREE_TYPE (gnu_result) != gnu_result_type)
......
...@@ -923,13 +923,10 @@ build_binary_op (enum tree_code op_code, tree result_type, ...@@ -923,13 +923,10 @@ build_binary_op (enum tree_code op_code, tree result_type,
operation_type = left_type; operation_type = left_type;
} }
/* If we have a call to a function that returns an unconstrained type /* If we have a call to a function that returns with variable size, use
with default discriminant on the RHS, use the RHS type (which is the RHS type in case we want to use the return slot optimization. */
padded) as we cannot compute the size of the actual assignment. */
else if (TREE_CODE (right_operand) == CALL_EXPR else if (TREE_CODE (right_operand) == CALL_EXPR
&& TYPE_IS_PADDING_P (right_type) && return_type_with_variable_size_p (right_type))
&& CONTAINS_PLACEHOLDER_P
(TYPE_SIZE (TREE_TYPE (TYPE_FIELDS (right_type)))))
operation_type = right_type; operation_type = right_type;
/* Find the best type to use for copying between aggregate types. */ /* Find the best type to use for copying between aggregate types. */
...@@ -1420,10 +1417,7 @@ build_unary_op (enum tree_code op_code, tree result_type, tree operand) ...@@ -1420,10 +1417,7 @@ build_unary_op (enum tree_code op_code, tree result_type, tree operand)
/* If INNER is a padding type whose field has a self-referential /* If INNER is a padding type whose field has a self-referential
size, convert to that inner type. We know the offset is zero size, convert to that inner type. We know the offset is zero
and we need to have that type visible. */ and we need to have that type visible. */
if (TYPE_IS_PADDING_P (TREE_TYPE (inner)) if (type_is_padding_self_referential (TREE_TYPE (inner)))
&& CONTAINS_PLACEHOLDER_P
(TYPE_SIZE (TREE_TYPE (TYPE_FIELDS
(TREE_TYPE (inner))))))
inner = convert (TREE_TYPE (TYPE_FIELDS (TREE_TYPE (inner))), inner = convert (TREE_TYPE (TYPE_FIELDS (TREE_TYPE (inner))),
inner); inner);
...@@ -2663,7 +2657,7 @@ gnat_protect_expr (tree exp) ...@@ -2663,7 +2657,7 @@ gnat_protect_expr (tree exp)
argument to force evaluation of everything. */ argument to force evaluation of everything. */
static tree static tree
gnat_stabilize_reference_1 (tree e, void *data, int n) gnat_stabilize_reference_1 (tree e, void *data)
{ {
const bool force = *(bool *)data; const bool force = *(bool *)data;
enum tree_code code = TREE_CODE (e); enum tree_code code = TREE_CODE (e);
...@@ -2688,7 +2682,7 @@ gnat_stabilize_reference_1 (tree e, void *data, int n) ...@@ -2688,7 +2682,7 @@ gnat_stabilize_reference_1 (tree e, void *data, int n)
&& TYPE_IS_FAT_POINTER_P (TREE_TYPE (TREE_OPERAND (e, 0)))) && TYPE_IS_FAT_POINTER_P (TREE_TYPE (TREE_OPERAND (e, 0))))
result result
= build3 (code, type, = build3 (code, type,
gnat_stabilize_reference_1 (TREE_OPERAND (e, 0), data, n), gnat_stabilize_reference_1 (TREE_OPERAND (e, 0), data),
TREE_OPERAND (e, 1), TREE_OPERAND (e, 2)); TREE_OPERAND (e, 1), TREE_OPERAND (e, 2));
/* If the expression has side-effects, then encase it in a SAVE_EXPR /* If the expression has side-effects, then encase it in a SAVE_EXPR
so that it will only be evaluated once. */ so that it will only be evaluated once. */
...@@ -2704,15 +2698,15 @@ gnat_stabilize_reference_1 (tree e, void *data, int n) ...@@ -2704,15 +2698,15 @@ gnat_stabilize_reference_1 (tree e, void *data, int n)
/* Recursively stabilize each operand. */ /* Recursively stabilize each operand. */
result result
= build2 (code, type, = build2 (code, type,
gnat_stabilize_reference_1 (TREE_OPERAND (e, 0), data, n), gnat_stabilize_reference_1 (TREE_OPERAND (e, 0), data),
gnat_stabilize_reference_1 (TREE_OPERAND (e, 1), data, n)); gnat_stabilize_reference_1 (TREE_OPERAND (e, 1), data));
break; break;
case tcc_unary: case tcc_unary:
/* Recursively stabilize each operand. */ /* Recursively stabilize each operand. */
result result
= build1 (code, type, = build1 (code, type,
gnat_stabilize_reference_1 (TREE_OPERAND (e, 0), data, n)); gnat_stabilize_reference_1 (TREE_OPERAND (e, 0), data));
break; break;
default: default:
...@@ -2728,21 +2722,22 @@ gnat_stabilize_reference_1 (tree e, void *data, int n) ...@@ -2728,21 +2722,22 @@ gnat_stabilize_reference_1 (tree e, void *data, int n)
/* This is equivalent to stabilize_reference in tree.c but we know how to /* This is equivalent to stabilize_reference in tree.c but we know how to
handle our own nodes and we take extra arguments. FORCE says whether to handle our own nodes and we take extra arguments. FORCE says whether to
force evaluation of everything. */ force evaluation of everything in REF. INIT is set to the first arm of
a COMPOUND_EXPR present in REF, if any. */
tree tree
gnat_stabilize_reference (tree ref, bool force) gnat_stabilize_reference (tree ref, bool force, tree *init)
{ {
return gnat_rewrite_reference (ref, gnat_stabilize_reference_1, &force); return
gnat_rewrite_reference (ref, gnat_stabilize_reference_1, &force, init);
} }
/* Rewrite reference REF and call FUNC on each expression within REF in the /* Rewrite reference REF and call FUNC on each expression within REF in the
process. DATA is passed unmodified to FUNC and N is bumped each time it process. DATA is passed unmodified to FUNC. INIT is set to the first
is passed to FUNC, so FUNC is guaranteed to see a given N only once per arm of a COMPOUND_EXPR present in REF, if any. */
reference to be rewritten. */
tree tree
gnat_rewrite_reference (tree ref, rewrite_fn func, void *data, int n) gnat_rewrite_reference (tree ref, rewrite_fn func, void *data, tree *init)
{ {
tree type = TREE_TYPE (ref); tree type = TREE_TYPE (ref);
enum tree_code code = TREE_CODE (ref); enum tree_code code = TREE_CODE (ref);
...@@ -2764,25 +2759,25 @@ gnat_rewrite_reference (tree ref, rewrite_fn func, void *data, int n) ...@@ -2764,25 +2759,25 @@ gnat_rewrite_reference (tree ref, rewrite_fn func, void *data, int n)
result result
= build1 (code, type, = build1 (code, type,
gnat_rewrite_reference (TREE_OPERAND (ref, 0), func, data, gnat_rewrite_reference (TREE_OPERAND (ref, 0), func, data,
n)); init));
break; break;
case INDIRECT_REF: case INDIRECT_REF:
case UNCONSTRAINED_ARRAY_REF: case UNCONSTRAINED_ARRAY_REF:
result = build1 (code, type, func (TREE_OPERAND (ref, 0), data, n)); result = build1 (code, type, func (TREE_OPERAND (ref, 0), data));
break; break;
case COMPONENT_REF: case COMPONENT_REF:
result = build3 (COMPONENT_REF, type, result = build3 (COMPONENT_REF, type,
gnat_rewrite_reference (TREE_OPERAND (ref, 0), func, gnat_rewrite_reference (TREE_OPERAND (ref, 0), func,
data, n), data, init),
TREE_OPERAND (ref, 1), NULL_TREE); TREE_OPERAND (ref, 1), NULL_TREE);
break; break;
case BIT_FIELD_REF: case BIT_FIELD_REF:
result = build3 (BIT_FIELD_REF, type, result = build3 (BIT_FIELD_REF, type,
gnat_rewrite_reference (TREE_OPERAND (ref, 0), func, gnat_rewrite_reference (TREE_OPERAND (ref, 0), func,
data, n), data, init),
TREE_OPERAND (ref, 1), TREE_OPERAND (ref, 2)); TREE_OPERAND (ref, 1), TREE_OPERAND (ref, 2));
break; break;
...@@ -2791,11 +2786,18 @@ gnat_rewrite_reference (tree ref, rewrite_fn func, void *data, int n) ...@@ -2791,11 +2786,18 @@ gnat_rewrite_reference (tree ref, rewrite_fn func, void *data, int n)
result result
= build4 (code, type, = build4 (code, type,
gnat_rewrite_reference (TREE_OPERAND (ref, 0), func, data, gnat_rewrite_reference (TREE_OPERAND (ref, 0), func, data,
n + 1), init),
func (TREE_OPERAND (ref, 1), data, n), func (TREE_OPERAND (ref, 1), data),
TREE_OPERAND (ref, 2), TREE_OPERAND (ref, 3)); TREE_OPERAND (ref, 2), TREE_OPERAND (ref, 3));
break; break;
case COMPOUND_EXPR:
gcc_assert (*init == NULL_TREE);
*init = TREE_OPERAND (ref, 0);
/* We expect only the pattern built in Call_to_gnu. */
gcc_assert (DECL_P (TREE_OPERAND (ref, 1)));
return TREE_OPERAND (ref, 1);
case CALL_EXPR: case CALL_EXPR:
{ {
/* This can only be an atomic load. */ /* This can only be an atomic load. */
...@@ -2808,9 +2810,9 @@ gnat_rewrite_reference (tree ref, rewrite_fn func, void *data, int n) ...@@ -2808,9 +2810,9 @@ gnat_rewrite_reference (tree ref, rewrite_fn func, void *data, int n)
if (TREE_CODE (t) == ADDR_EXPR) if (TREE_CODE (t) == ADDR_EXPR)
t = build1 (ADDR_EXPR, TREE_TYPE (t), t = build1 (ADDR_EXPR, TREE_TYPE (t),
gnat_rewrite_reference (TREE_OPERAND (t, 0), func, data, gnat_rewrite_reference (TREE_OPERAND (t, 0), func, data,
n)); init));
else else
t = func (t, data, n); t = func (t, data);
t = fold_convert (TREE_TYPE (CALL_EXPR_ARG (ref, 0)), t); t = fold_convert (TREE_TYPE (CALL_EXPR_ARG (ref, 0)), t);
result = build_call_expr (TREE_OPERAND (CALL_EXPR_FN (ref), 0), 2, result = build_call_expr (TREE_OPERAND (CALL_EXPR_FN (ref), 0), 2,
......
2015-05-28 Eric Botcazou <ebotcazou@adacore.com>
* gnat.dg/varsize_temp.adb: Rename into...
* gnat.dg/varsize1.adb: ...this.
* gnat.dg/varsize_copy.ad[sb]: Rename into...
* gnat.dg/varsize2.ad[sb]: ...this.
* gnat.dg/varsize3_1.adb: New test.
* gnat.dg/varsize3_2.adb: Likewise.
* gnat.dg/varsize3_3.adb: Likewise.
* gnat.dg/varsize3_4.adb: Likewise.
* gnat.dg/varsize3_5.adb: Likewise.
* gnat.dg/varsize3_6.adb: Likewise.
* gnat.dg/varsize3_pkg1.ads: New helper.
* gnat.dg/varsize3_pkg2.ads: Likewise.
* gnat.dg/varsize3_pkg3.ads: Likewise.
2015-05-28 Richard Biener <rguenther@suse.de> 2015-05-28 Richard Biener <rguenther@suse.de>
* gcc.dg/vect/slp-reduc-sad.c: New testcase. * gcc.dg/vect/slp-reduc-sad.c: New testcase.
......
-- { dg-do compile } -- { dg-do compile }
procedure Varsize_Temp (Nbytes : Natural) is procedure Varsize1 (Nbytes : Natural) is
type Message_T (Length : Natural) is record type Message_T (Length : Natural) is record
case Length is case Length is
...@@ -25,5 +25,3 @@ procedure Varsize_Temp (Nbytes : Natural) is ...@@ -25,5 +25,3 @@ procedure Varsize_Temp (Nbytes : Natural) is
begin begin
Process (One_Message); Process (One_Message);
end; end;
-- { dg-do compile } -- { dg-do compile }
-- { dg-options "-O -gnatws" } -- { dg-options "-O -gnatws" }
package body Varsize_Copy is package body Varsize2 is
type Key_Mapping_Type is record type Key_Mapping_Type is record
Page : Page_Type; Page : Page_Type;
...@@ -21,4 +21,4 @@ package body Varsize_Copy is ...@@ -21,4 +21,4 @@ package body Varsize_Copy is
return S.Key_Mappings (Key).Page; return S.Key_Mappings (Key).Page;
end; end;
end Varsize_Copy; end Varsize2;
package Varsize_Copy is package Varsize2 is
type Key_Type is type Key_Type is
(Nul, Cntrl, Stx, Etx, Eot, Enq, Ack, Spad, Clr, Dc_1, Dc_2, Dc_3, Dc_4); (Nul, Cntrl, Stx, Etx, Eot, Enq, Ack, Spad, Clr, Dc_1, Dc_2, Dc_3, Dc_4);
...@@ -27,4 +27,4 @@ package Varsize_Copy is ...@@ -27,4 +27,4 @@ package Varsize_Copy is
function F (Key : Key_Type) return Page_Type; function F (Key : Key_Type) return Page_Type;
end Varsize_Copy; end Varsize2;
-- { dg-do compile }
package body Varsize3_1 is
end Varsize3_1;
with Varsize3_Pkg1; use Varsize3_Pkg1;
package Varsize3_1 is
pragma Elaborate_Body;
Filter : constant Object := True;
end Varsize3_1;
-- { dg-do compile }
with Varsize3_Pkg1; use Varsize3_Pkg1;
procedure Varsize3_2 is
Filter : constant Object := True;
begin
null;
end;
-- { dg-do compile }
with Varsize3_Pkg1; use Varsize3_Pkg1;
procedure Varsize3_3 is
Filter : Object;
begin
Filter := True;
end;
-- { dg-do compile }
with Varsize3_Pkg1; use Varsize3_Pkg1;
procedure Varsize3_4 is
Filter : Object renames True;
begin
null;
end;
-- { dg-do compile }
with Varsize3_Pkg1; use Varsize3_Pkg1;
procedure Varsize3_5 is
Filter : constant Arr := True.E;
begin
null;
end;
-- { dg-do compile }
with Varsize3_Pkg1; use Varsize3_Pkg1;
procedure Varsize3_6 is
Filter : Arr renames True.E;
begin
null;
end;
with Varsize3_Pkg2;
with Varsize3_Pkg3;
package Varsize3_Pkg1 is
type Arr is array (Positive range 1 .. Varsize3_Pkg2.Last_Index) of Boolean;
package My_G is new Varsize3_Pkg3 (Arr);
type Object is new My_G.Object;
end Varsize3_Pkg1;
package Varsize3_Pkg2 is
function Last_Index return Positive;
end Varsize3_Pkg2;
generic
type T is private;
package Varsize3_Pkg3 is
type Object is record
E : T;
end record;
function True return Object;
end Varsize3_Pkg3;
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