* 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
+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>
* sem_ch3.adb (Is_Visible_Component): Component is visible
static GTY ((cache)) hash_table<value_annotation_hasher> *annotate_value_cache;
-static bool allocatable_size_p (tree, bool);
static void prepend_one_attribute (struct attrib **,
enum attr_type, tree, tree, Node_Id);
static void prepend_one_attribute_pragma (struct attrib **, Node_Id);
static tree elaborate_expression_1 (tree, Entity_Id, const char *, bool, bool);
static tree elaborate_expression_2 (tree, Entity_Id, const char *, bool, bool,
unsigned int);
-static tree elaborate_reference (tree, Entity_Id, bool);
+static tree elaborate_reference (tree, Entity_Id, bool, tree *);
static tree gnat_to_gnu_component_type (Entity_Id, bool, bool);
static tree gnat_to_gnu_param (Entity_Id, Mechanism_Type, Entity_Id, bool,
bool *);
static bool same_discriminant_p (Entity_Id, Entity_Id);
static bool array_type_has_nonaliased_component (tree, Entity_Id);
static bool compile_time_known_address_p (Node_Id);
-static bool cannot_be_superflat_p (Node_Id);
+static bool cannot_be_superflat (Node_Id);
static bool constructor_address_p (tree);
+static bool allocatable_size_p (tree, bool);
+static bool initial_value_needs_conversion (tree, tree);
static int compare_field_bitpos (const PTR, const PTR);
static bool components_to_record (tree, Node_Id, tree, int, bool, bool, bool,
bool, bool, bool, bool, bool, tree, tree *);
to make it more likely to rename the underlying object. */
if (Present (Renamed_Object (gnat_entity)))
{
- /* If the renamed object had padding, strip off the reference
- to the inner object and reset our type. */
+ /* If the renamed object had padding, strip off the reference to
+ the inner object and reset our type. */
if ((TREE_CODE (gnu_expr) == COMPONENT_REF
&& TYPE_IS_PADDING_P (TREE_TYPE (TREE_OPERAND (gnu_expr, 0))))
/* Strip useless conversions around the object. */
/* Or else, if the renamed object has an unconstrained type with
default discriminant, use the padded type. */
- else if (TYPE_IS_PADDING_P (TREE_TYPE (gnu_expr))
- && TREE_TYPE (TYPE_FIELDS (TREE_TYPE (gnu_expr)))
- == gnu_type
- && CONTAINS_PLACEHOLDER_P (TYPE_SIZE (gnu_type)))
+ else if (type_is_padding_self_referential (TREE_TYPE (gnu_expr)))
gnu_type = TREE_TYPE (gnu_expr);
/* Case 1: if this is a constant renaming stemming from a function
/* Case 2: if the renaming entity need not be materialized, use
the elaborated renamed expression for the renaming. But this
means that the caller is responsible for evaluating the address
- of the renaming at the correct spot in the definition case to
+ of the renaming in the correct place for the definition case to
instantiate the SAVE_EXPRs. */
- else if (!Materialize_Entity (gnat_entity))
+ else if (TREE_CODE (inner) != COMPOUND_EXPR
+ && !Materialize_Entity (gnat_entity))
{
+ tree init = NULL_TREE;
+
gnu_decl
- = elaborate_reference (gnu_expr, gnat_entity, definition);
+ = elaborate_reference (gnu_expr, gnat_entity, definition,
+ &init);
+
+ /* We cannot evaluate the first arm of a COMPOUND_EXPR in the
+ correct place for this case, hence the above test. */
+ gcc_assert (init == NULL_TREE);
/* No DECL_EXPR will be created so the expression needs to be
marked manually because it will likely be shared. */
volatility of the renamed object through the indirection. */
else
{
+ tree init = NULL_TREE;
+
if (TREE_THIS_VOLATILE (gnu_expr) && !TYPE_VOLATILE (gnu_type))
gnu_type
= change_qualified_type (gnu_type, TYPE_QUAL_VOLATILE);
gnu_size = NULL_TREE;
renamed_obj
- = elaborate_reference (gnu_expr, gnat_entity, definition);
+ = elaborate_reference (gnu_expr, gnat_entity, definition,
+ &init);
/* If we are not defining the entity, the expression will not
be attached through DECL_INITIAL so it needs to be marked
&& TREE_CODE (renamed_obj) == ERROR_MARK)
gnu_expr = NULL_TREE;
else
- gnu_expr
- = build_unary_op (ADDR_EXPR, gnu_type, renamed_obj);
+ {
+ gnu_expr
+ = build_unary_op (ADDR_EXPR, gnu_type, renamed_obj);
+ if (init)
+ gnu_expr
+ = build_compound_expr (TREE_TYPE (gnu_expr), init,
+ gnu_expr);
+ }
}
}
gnu_expr = gnat_build_constructor (gnu_type, v);
}
- /* Convert the expression to the type of the object except in the
- case where the object's type is unconstrained or the object's type
- is a padded record whose field is of self-referential size. In
- the former case, converting will generate unnecessary evaluations
- of the CONSTRUCTOR to compute the size and in the latter case, we
- want to only copy the actual data. Also don't convert to a record
- type with a variant part from a record type without one, to keep
- the object simpler. */
- if (gnu_expr
- && TREE_CODE (gnu_type) != UNCONSTRAINED_ARRAY_TYPE
- && !CONTAINS_PLACEHOLDER_P (TYPE_SIZE (gnu_type))
- && !(TYPE_IS_PADDING_P (gnu_type)
- && CONTAINS_PLACEHOLDER_P
- (TYPE_SIZE (TREE_TYPE (TYPE_FIELDS (gnu_type)))))
- && !(TREE_CODE (gnu_type) == RECORD_TYPE
- && TREE_CODE (TREE_TYPE (gnu_expr)) == RECORD_TYPE
- && get_variant_part (gnu_type) != NULL_TREE
- && get_variant_part (TREE_TYPE (gnu_expr)) == NULL_TREE))
+ /* Convert the expression to the type of the object if need be. */
+ if (gnu_expr && initial_value_needs_conversion (gnu_type, gnu_expr))
gnu_expr = convert (gnu_type, gnu_expr);
/* If this is a pointer that doesn't have an initializing expression,
if (const_flag)
gnu_type = change_qualified_type (gnu_type, TYPE_QUAL_CONST);
- /* Convert the expression to the type of the object except in the
- case where the object's type is unconstrained or the object's type
- is a padded record whose field is of self-referential size. In
- the former case, converting will generate unnecessary evaluations
- of the CONSTRUCTOR to compute the size and in the latter case, we
- want to only copy the actual data. Also don't convert to a record
- type with a variant part from a record type without one, to keep
- the object simpler. */
- if (gnu_expr
- && TREE_CODE (gnu_type) != UNCONSTRAINED_ARRAY_TYPE
- && !CONTAINS_PLACEHOLDER_P (TYPE_SIZE (gnu_type))
- && !(TYPE_IS_PADDING_P (gnu_type)
- && CONTAINS_PLACEHOLDER_P
- (TYPE_SIZE (TREE_TYPE (TYPE_FIELDS (gnu_type)))))
- && !(TREE_CODE (gnu_type) == RECORD_TYPE
- && TREE_CODE (TREE_TYPE (gnu_expr)) == RECORD_TYPE
- && get_variant_part (gnu_type) != NULL_TREE
- && get_variant_part (TREE_TYPE (gnu_expr)) == NULL_TREE))
+ /* Convert the expression to the type of the object if need be. */
+ if (gnu_expr && initial_value_needs_conversion (gnu_type, gnu_expr))
gnu_expr = convert (gnu_type, gnu_expr);
/* If this name is external or a name was specified, use it, but don't
this. If we can prove that the array can never be superflat,
we can just use the high bound of the index type. */
else if ((Nkind (gnat_index) == N_Range
- && cannot_be_superflat_p (gnat_index))
+ && cannot_be_superflat (gnat_index))
/* Bit-Packed Array Impl. Types are never superflat. */
|| (Is_Packed_Array_Impl_Type (gnat_entity)
&& Is_Bit_Packed_Array
inequality HB >= LB-1 is true. LB and HB are the low and high bounds. */
static bool
-cannot_be_superflat_p (Node_Id gnat_range)
+cannot_be_superflat (Node_Id gnat_range)
{
Node_Id gnat_lb = Low_Bound (gnat_range), gnat_hb = High_Bound (gnat_range);
Node_Id scalar_range;
return (TREE_CODE (gnu_expr) == ADDR_EXPR
&& TREE_CODE (TREE_OPERAND (gnu_expr, 0)) == CONSTRUCTOR);
}
+
+/* Return true if the size in units represented by GNU_SIZE can be handled by
+ an allocation. If STATIC_P is true, consider only what can be done with a
+ static allocation. */
+
+static bool
+allocatable_size_p (tree gnu_size, bool static_p)
+{
+ /* We can allocate a fixed size if it is a valid for the middle-end. */
+ if (TREE_CODE (gnu_size) == INTEGER_CST)
+ return valid_constant_size_p (gnu_size);
+
+ /* We can allocate a variable size if this isn't a static allocation. */
+ else
+ return !static_p;
+}
+
+/* Return true if GNU_EXPR needs a conversion to GNU_TYPE when used as the
+ initial value of an object of GNU_TYPE. */
+
+static bool
+initial_value_needs_conversion (tree gnu_type, tree gnu_expr)
+{
+ /* Do not convert if the object's type is unconstrained because this would
+ generate useless evaluations of the CONSTRUCTOR to compute the size. */
+ if (TREE_CODE (gnu_type) == UNCONSTRAINED_ARRAY_TYPE
+ || CONTAINS_PLACEHOLDER_P (TYPE_SIZE (gnu_type)))
+ return false;
+
+ /* Do not convert if the object's type is a padding record whose field is of
+ self-referential size because we want to copy only the actual data. */
+ if (type_is_padding_self_referential (gnu_type))
+ return false;
+
+ /* Do not convert a call to a function that returns with variable size since
+ we want to use the return slot optimization in this case. */
+ if (TREE_CODE (gnu_expr) == CALL_EXPR
+ && return_type_with_variable_size_p (TREE_TYPE (gnu_expr)))
+ return false;
+
+ /* Do not convert to a record type with a variant part from a record type
+ without one, to keep the object simpler. */
+ if (TREE_CODE (gnu_type) == RECORD_TYPE
+ && TREE_CODE (TREE_TYPE (gnu_expr)) == RECORD_TYPE
+ && get_variant_part (gnu_type) != NULL_TREE
+ && get_variant_part (TREE_TYPE (gnu_expr)) == NULL_TREE)
+ return false;
+
+ /* In all the other cases, convert the expression to the object's type. */
+ return true;
+}
\f
/* Given GNAT_ENTITY, elaborate all expressions that are required to
be elaborated at the point of its definition, but do nothing else. */
}
}
\f
-/* Return true if the size in units represented by GNU_SIZE can be handled by
- an allocation. If STATIC_P is true, consider only what can be done with a
- static allocation. */
-
-static bool
-allocatable_size_p (tree gnu_size, bool static_p)
-{
- /* We can allocate a fixed size if it is a valid for the middle-end. */
- if (TREE_CODE (gnu_size) == INTEGER_CST)
- return valid_constant_size_p (gnu_size);
-
- /* We can allocate a variable size if this isn't a static allocation. */
- else
- return !static_p;
-}
-\f
/* Prepend to ATTR_LIST an entry for an attribute with provided TYPE,
NAME, ARGS and ERROR_POINT. */
{
Entity_Id entity;
bool definition;
+ unsigned int n;
};
/* Wrapper function around elaborate_expression_1 for elaborate_reference. */
static tree
-elaborate_reference_1 (tree ref, void *data, int n)
+elaborate_reference_1 (tree ref, void *data)
{
struct er_data *er = (struct er_data *)data;
char suffix[16];
if (TREE_CODE (ref) == COMPONENT_REF
&& TYPE_IS_FAT_POINTER_P (TREE_TYPE (TREE_OPERAND (ref, 0))))
return build3 (COMPONENT_REF, TREE_TYPE (ref),
- elaborate_reference_1 (TREE_OPERAND (ref, 0), data, n),
+ elaborate_reference_1 (TREE_OPERAND (ref, 0), data),
TREE_OPERAND (ref, 1), TREE_OPERAND (ref, 2));
- sprintf (suffix, "EXP%d", n);
+ sprintf (suffix, "EXP%d", ++er->n);
return
elaborate_expression_1 (ref, er->entity, suffix, er->definition, false);
}
/* Elaborate the reference REF to be used as renamed object for GNAT_ENTITY.
- DEFINITION is true if this is done for a definition of GNAT_ENTITY. */
+ DEFINITION is true if this is done for a definition of GNAT_ENTITY and
+ INIT is set to the first arm of a COMPOUND_EXPR present in REF, if any. */
static tree
-elaborate_reference (tree ref, Entity_Id gnat_entity, bool definition)
+elaborate_reference (tree ref, Entity_Id gnat_entity, bool definition,
+ tree *init)
{
- struct er_data er = { gnat_entity, definition };
- return gnat_rewrite_reference (ref, elaborate_reference_1, &er);
+ struct er_data er = { gnat_entity, definition, 0 };
+ return gnat_rewrite_reference (ref, elaborate_reference_1, &er, init);
}
\f
/* Given a GNU tree and a GNAT list of choices, generate an expression to test
/* 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
- force evaluation of everything. */
-extern tree gnat_stabilize_reference (tree ref, bool force);
+ force evaluation of everything in REF. INIT is set to the first arm of
+ 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
- process. DATA is passed unmodified to FUNC and N is bumped each time it
- is passed to FUNC, so FUNC is guaranteed to see a given N only once per
- reference to be rewritten. */
-typedef tree (*rewrite_fn) (tree, void *, int);
+ process. DATA is passed unmodified to FUNC. INIT is set to the first
+ arm of a COMPOUND_EXPR present in REF, if any. */
+typedef tree (*rewrite_fn) (tree, void *);
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
ultimate containing object only if the reference (lvalue) is constant,
enum built_in_function code = DECL_FUNCTION_CODE (fndecl);
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;
+}
because we need to preserve the return value before copying back the
parameters.
- 2. There is no target and this is not an object declaration, and the
- return type has variable size, because in these cases the gimplifier
- cannot create the temporary.
+ 2. There is no target and this is neither an object nor a renaming
+ declaration, and the return type has variable size, because in
+ these cases the gimplifier cannot create the temporary.
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
&& ((!gnu_target && TYPE_CI_CO_LIST (gnu_subprog_type))
|| (!gnu_target
&& Nkind (Parent (gnat_node)) != N_Object_Declaration
+ && Nkind (Parent (gnat_node)) != N_Object_Renaming_Declaration
&& TREE_CODE (TYPE_SIZE (gnu_result_type)) != INTEGER_CST)
|| (gnu_target
&& (TREE_CODE (gnu_target) == ARRAY_RANGE_REF
if (Ekind (gnat_formal) != E_In_Parameter
&& !is_by_ref_formal_parm
&& 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
address of a copy. In the Out or In Out case, set up to copy back
/* ??? If the return type has variable size, then force the return
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. */
- if (TREE_CODE (TYPE_SIZE (gnu_result_type)) != INTEGER_CST
- || (TYPE_IS_PADDING_P (gnu_result_type)
- && CONTAINS_PLACEHOLDER_P
- (TYPE_SIZE (TREE_TYPE (TYPE_FIELDS (gnu_result_type))))))
+ if (return_type_with_variable_size_p (gnu_result_type))
op_code = INIT_EXPR;
else
op_code = MODIFY_EXPR;
/* Do not remove the padding from GNU_RET_VAL if the inner type is
self-referential since we want to allocate the fixed size. */
if (TREE_CODE (gnu_ret_val) == COMPONENT_REF
- && TYPE_IS_PADDING_P
- (TREE_TYPE (TREE_OPERAND (gnu_ret_val, 0)))
- && CONTAINS_PLACEHOLDER_P
- (TYPE_SIZE (TREE_TYPE (gnu_ret_val))))
+ && type_is_padding_self_referential
+ (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
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)))
+ && type_is_padding_self_referential (TREE_TYPE (gnu_result)))
&& (TREE_CODE (gnu_result_type) == UNCONSTRAINED_ARRAY_TYPE
|| CONTAINS_PLACEHOLDER_P (TYPE_SIZE (gnu_result_type))))
gnu_result = gnat_protect_expr (gnu_result);
3. If the type is void or if we have no result, return error_mark_node
to show we have no result.
- 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.
+ 4. If this is a call to a function that returns with variable size and
+ the call is used as the expression in either an object or a renaming
+ 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. */
size: in that case it must be an object of unconstrained type
with a default discriminant and we want to avoid copying too
much data. */
- if (TYPE_IS_PADDING_P (TREE_TYPE (gnu_result))
- && CONTAINS_PLACEHOLDER_P (TYPE_SIZE (TREE_TYPE (TYPE_FIELDS
- (TREE_TYPE (gnu_result))))))
+ if (type_is_padding_self_referential (TREE_TYPE (gnu_result)))
gnu_result = convert (TREE_TYPE (TYPE_FIELDS (TREE_TYPE (gnu_result))),
gnu_result);
}
else if (gnu_result == error_mark_node || gnu_result_type == void_type_node)
gnu_result = error_mark_node;
- else if (TREE_CODE (gnu_result) == CALL_EXPR
- && TYPE_IS_PADDING_P (TREE_TYPE (gnu_result))
- && TREE_TYPE (TYPE_FIELDS (TREE_TYPE (gnu_result)))
- == gnu_result_type
- && CONTAINS_PLACEHOLDER_P (TYPE_SIZE (gnu_result_type)))
+ else if (Present (Parent (gnat_node))
+ && (Nkind (Parent (gnat_node)) == N_Object_Declaration
+ || Nkind (Parent (gnat_node)) == N_Object_Renaming_Declaration)
+ && TREE_CODE (gnu_result) == CALL_EXPR
+ && return_type_with_variable_size_p (TREE_TYPE (gnu_result)))
;
else if (TREE_TYPE (gnu_result) != gnu_result_type)
operation_type = left_type;
}
- /* If we have a call to a function that returns an unconstrained type
- with default discriminant on the RHS, use the RHS type (which is
- padded) as we cannot compute the size of the actual assignment. */
+ /* If we have a call to a function that returns with variable size, use
+ the RHS type in case we want to use the return slot optimization. */
else if (TREE_CODE (right_operand) == CALL_EXPR
- && TYPE_IS_PADDING_P (right_type)
- && CONTAINS_PLACEHOLDER_P
- (TYPE_SIZE (TREE_TYPE (TYPE_FIELDS (right_type)))))
+ && return_type_with_variable_size_p (right_type))
operation_type = right_type;
/* Find the best type to use for copying between aggregate types. */
/* If INNER is a padding type whose field has a self-referential
size, convert to that inner type. We know the offset is zero
and we need to have that type visible. */
- if (TYPE_IS_PADDING_P (TREE_TYPE (inner))
- && CONTAINS_PLACEHOLDER_P
- (TYPE_SIZE (TREE_TYPE (TYPE_FIELDS
- (TREE_TYPE (inner))))))
+ if (type_is_padding_self_referential (TREE_TYPE (inner)))
inner = convert (TREE_TYPE (TYPE_FIELDS (TREE_TYPE (inner))),
inner);
argument to force evaluation of everything. */
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;
enum tree_code code = TREE_CODE (e);
&& TYPE_IS_FAT_POINTER_P (TREE_TYPE (TREE_OPERAND (e, 0))))
result
= 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));
/* If the expression has side-effects, then encase it in a SAVE_EXPR
so that it will only be evaluated once. */
/* Recursively stabilize each operand. */
result
= build2 (code, type,
- gnat_stabilize_reference_1 (TREE_OPERAND (e, 0), data, n),
- gnat_stabilize_reference_1 (TREE_OPERAND (e, 1), data, n));
+ gnat_stabilize_reference_1 (TREE_OPERAND (e, 0), data),
+ gnat_stabilize_reference_1 (TREE_OPERAND (e, 1), data));
break;
case tcc_unary:
/* Recursively stabilize each operand. */
result
= build1 (code, type,
- gnat_stabilize_reference_1 (TREE_OPERAND (e, 0), data, n));
+ gnat_stabilize_reference_1 (TREE_OPERAND (e, 0), data));
break;
default:
/* 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
- 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
-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
- process. DATA is passed unmodified to FUNC and N is bumped each time it
- is passed to FUNC, so FUNC is guaranteed to see a given N only once per
- reference to be rewritten. */
+ process. DATA is passed unmodified to FUNC. INIT is set to the first
+ arm of a COMPOUND_EXPR present in REF, if any. */
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);
enum tree_code code = TREE_CODE (ref);
result
= build1 (code, type,
gnat_rewrite_reference (TREE_OPERAND (ref, 0), func, data,
- n));
+ init));
break;
case INDIRECT_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;
case COMPONENT_REF:
result = build3 (COMPONENT_REF, type,
gnat_rewrite_reference (TREE_OPERAND (ref, 0), func,
- data, n),
+ data, init),
TREE_OPERAND (ref, 1), NULL_TREE);
break;
case BIT_FIELD_REF:
result = build3 (BIT_FIELD_REF, type,
gnat_rewrite_reference (TREE_OPERAND (ref, 0), func,
- data, n),
+ data, init),
TREE_OPERAND (ref, 1), TREE_OPERAND (ref, 2));
break;
result
= build4 (code, type,
gnat_rewrite_reference (TREE_OPERAND (ref, 0), func, data,
- n + 1),
- func (TREE_OPERAND (ref, 1), data, n),
+ init),
+ func (TREE_OPERAND (ref, 1), data),
TREE_OPERAND (ref, 2), TREE_OPERAND (ref, 3));
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:
{
/* This can only be an atomic load. */
if (TREE_CODE (t) == ADDR_EXPR)
t = build1 (ADDR_EXPR, TREE_TYPE (t),
gnat_rewrite_reference (TREE_OPERAND (t, 0), func, data,
- n));
+ init));
else
- t = func (t, data, n);
+ t = func (t, data);
t = fold_convert (TREE_TYPE (CALL_EXPR_ARG (ref, 0)), t);
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>
* gcc.dg/vect/slp-reduc-sad.c: New testcase.
--- /dev/null
+-- { dg-do compile }
+
+procedure Varsize1 (Nbytes : Natural) is
+
+ type Message_T (Length : Natural) is record
+ case Length is
+ when 0 => null;
+ when others => Id : Natural;
+ end case;
+ end record;
+
+ type Local_Message_T is new Message_T (Nbytes);
+
+ function One_message return Local_Message_T is
+ M : Local_Message_T;
+ begin
+ if M.Length > 0 then
+ M.Id := 1;
+ end if;
+ return M;
+ end;
+
+ procedure Process (X : Local_Message_T) is begin null; end;
+
+begin
+ Process (One_Message);
+end;
--- /dev/null
+-- { dg-do compile }
+-- { dg-options "-O -gnatws" }
+
+package body Varsize2 is
+
+ type Key_Mapping_Type is record
+ Page : Page_Type;
+ B : Boolean;
+ end record;
+
+ type Key_Mapping_Array is array (Key_Type) of Key_Mapping_Type;
+
+ type Set is record
+ Key_Mappings : Key_Mapping_Array;
+ end record;
+
+ S : Set;
+
+ function F (Key : Key_Type) return Page_Type is
+ begin
+ return S.Key_Mappings (Key).Page;
+ end;
+
+end Varsize2;
--- /dev/null
+package Varsize2 is
+
+ type Key_Type is
+ (Nul, Cntrl, Stx, Etx, Eot, Enq, Ack, Spad, Clr, Dc_1, Dc_2, Dc_3, Dc_4);
+
+ for Key_Type use
+ (Nul => 0,
+ Cntrl => 1,
+ Stx => 2,
+ Etx => 3,
+ Eot => 4,
+ Enq => 5,
+ Ack => 6,
+ Spad => 7,
+ Clr => 8,
+ Dc_1 => 17,
+ Dc_2 => 18,
+ Dc_3 => 19,
+ Dc_4 => 20);
+
+ type Page_Type(D : Boolean := False) is record
+ case D is
+ when True => I : Integer;
+ when False => null;
+ end case;
+ end record;
+
+ function F (Key : Key_Type) return Page_Type;
+
+end Varsize2;
--- /dev/null
+-- { dg-do compile }
+
+package body Varsize3_1 is
+
+end Varsize3_1;
--- /dev/null
+with Varsize3_Pkg1; use Varsize3_Pkg1;
+
+package Varsize3_1 is
+
+ pragma Elaborate_Body;
+
+ Filter : constant Object := True;
+
+end Varsize3_1;
--- /dev/null
+-- { dg-do compile }
+
+with Varsize3_Pkg1; use Varsize3_Pkg1;
+
+procedure Varsize3_2 is
+
+ Filter : constant Object := True;
+
+begin
+ null;
+end;
--- /dev/null
+-- { dg-do compile }
+
+with Varsize3_Pkg1; use Varsize3_Pkg1;
+
+procedure Varsize3_3 is
+
+ Filter : Object;
+
+begin
+ Filter := True;
+end;
--- /dev/null
+-- { dg-do compile }
+
+with Varsize3_Pkg1; use Varsize3_Pkg1;
+
+procedure Varsize3_4 is
+
+ Filter : Object renames True;
+
+begin
+ null;
+end;
--- /dev/null
+-- { dg-do compile }
+
+with Varsize3_Pkg1; use Varsize3_Pkg1;
+
+procedure Varsize3_5 is
+
+ Filter : constant Arr := True.E;
+
+begin
+ null;
+end;
--- /dev/null
+-- { dg-do compile }
+
+with Varsize3_Pkg1; use Varsize3_Pkg1;
+
+procedure Varsize3_6 is
+
+ Filter : Arr renames True.E;
+
+begin
+ null;
+end;
--- /dev/null
+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;
--- /dev/null
+package Varsize3_Pkg2 is
+
+ function Last_Index return Positive;
+
+end Varsize3_Pkg2;
--- /dev/null
+generic
+
+ type T is private;
+
+package Varsize3_Pkg3 is
+
+ type Object is record
+ E : T;
+ end record;
+
+ function True return Object;
+
+end Varsize3_Pkg3;
+++ /dev/null
--- { dg-do compile }
--- { dg-options "-O -gnatws" }
-
-package body Varsize_Copy is
-
- type Key_Mapping_Type is record
- Page : Page_Type;
- B : Boolean;
- end record;
-
- type Key_Mapping_Array is array (Key_Type) of Key_Mapping_Type;
-
- type Set is record
- Key_Mappings : Key_Mapping_Array;
- end record;
-
- S : Set;
-
- function F (Key : Key_Type) return Page_Type is
- begin
- return S.Key_Mappings (Key).Page;
- end;
-
-end Varsize_Copy;
+++ /dev/null
-package Varsize_Copy is
-
- type Key_Type is
- (Nul, Cntrl, Stx, Etx, Eot, Enq, Ack, Spad, Clr, Dc_1, Dc_2, Dc_3, Dc_4);
-
- for Key_Type use
- (Nul => 0,
- Cntrl => 1,
- Stx => 2,
- Etx => 3,
- Eot => 4,
- Enq => 5,
- Ack => 6,
- Spad => 7,
- Clr => 8,
- Dc_1 => 17,
- Dc_2 => 18,
- Dc_3 => 19,
- Dc_4 => 20);
-
- type Page_Type(D : Boolean := False) is record
- case D is
- when True => I : Integer;
- when False => null;
- end case;
- end record;
-
- function F (Key : Key_Type) return Page_Type;
-
-end Varsize_Copy;
+++ /dev/null
--- { dg-do compile }
-
-procedure Varsize_Temp (Nbytes : Natural) is
-
- type Message_T (Length : Natural) is record
- case Length is
- when 0 => null;
- when others => Id : Natural;
- end case;
- end record;
-
- type Local_Message_T is new Message_T (Nbytes);
-
- function One_message return Local_Message_T is
- M : Local_Message_T;
- begin
- if M.Length > 0 then
- M.Id := 1;
- end if;
- return M;
- end;
-
- procedure Process (X : Local_Message_T) is begin null; end;
-
-begin
- Process (One_Message);
-end;
-
-
projects / gcc.git / commitdiff