@@ -7305,19 +7305,6 @@ gfc_conv_array_parameter (gfc_se * se, gfc_expr * expr, bool g77,
expr, size);
}
- /* Deallocate the allocatable components of structures that are
- not variable. */
- if ((expr->ts.type == BT_DERIVED || expr->ts.type == BT_CLASS)
- && expr->ts.u.derived->attr.alloc_comp
- && expr->expr_type != EXPR_VARIABLE)
- {
- tmp = build_fold_indirect_ref_loc (input_location, se->expr);
- tmp = gfc_deallocate_alloc_comp (expr->ts.u.derived, tmp, expr->rank);
-
- /* The components shall be deallocated before their containing entity. */
- gfc_prepend_expr_to_block (&se->post, tmp);
- }
-
if (g77 || (fsym && fsym->attr.contiguous
&& !gfc_is_simply_contiguous (expr, false)))
{
@@ -4536,6 +4536,36 @@ conv_arglist_function (gfc_se *se, gfc_expr *expr, const char *name)
}
+/* Temporary arrays generated to represent array constructors are made
+ using simple copies, so that their elements may alias some variable
+ they were copied from.
+ This function tells whether the expression given as input may alias
+ some other variable, under the assumption that only variables and array
+ constructor may alias (in particular structure constructors don't alias),
+ and array constructor elements alias iff they are copied from a variable.
+ This function is used to decide whether freeing an expression's allocatable
+ components is safe or should be avoided. */
+
+static bool
+expr_may_alias_variables (gfc_expr *e)
+{
+ gfc_constructor *c;
+
+ if (e->expr_type == EXPR_VARIABLE)
+ return true;
+ else if (e->expr_type != EXPR_ARRAY)
+ return false;
+
+ for (c = gfc_constructor_first (e->value.constructor);
+ c; c = gfc_constructor_next (c))
+ if (c->expr
+ && expr_may_alias_variables (c->expr))
+ return true;
+
+ return false;
+}
+
+
/* Generate code for a procedure call. Note can return se->post != NULL.
If se->direct_byref is set then se->expr contains the return parameter.
Return nonzero, if the call has alternate specifiers.
@@ -5328,7 +5358,7 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
if (e && (e->ts.type == BT_DERIVED || e->ts.type == BT_CLASS)
&& e->ts.u.derived->attr.alloc_comp
&& !(e->symtree && e->symtree->n.sym->attr.pointer)
- && (e->expr_type != EXPR_VARIABLE && !e->rank))
+ && !expr_may_alias_variables (e))
{
int parm_rank;
tmp = build_fold_indirect_ref_loc (input_location,
@@ -6642,7 +6672,7 @@ gfc_trans_subarray_assign (tree dest, gfc_component * cm, gfc_expr * expr)
gfc_conv_expr (&rse, expr);
- tmp = gfc_trans_scalar_assign (&lse, &rse, cm->ts, true, false, true);
+ tmp = gfc_trans_scalar_assign (&lse, &rse, cm->ts, true, true, true);
gfc_add_expr_to_block (&body, tmp);
gcc_assert (rse.ss == gfc_ss_terminator);
@@ -7513,20 +7543,6 @@ gfc_conv_expr_reference (gfc_se * se, gfc_expr * expr)
/* Take the address of that value. */
se->expr = gfc_build_addr_expr (NULL_TREE, var);
- if (expr->ts.type == BT_DERIVED && expr->rank
- && !gfc_is_finalizable (expr->ts.u.derived, NULL)
- && expr->ts.u.derived->attr.alloc_comp
- && expr->expr_type != EXPR_VARIABLE)
- {
- tree tmp;
-
- tmp = build_fold_indirect_ref_loc (input_location, se->expr);
- tmp = gfc_deallocate_alloc_comp (expr->ts.u.derived, tmp, expr->rank);
-
- /* The components shall be deallocated before
- their containing entity. */
- gfc_prepend_expr_to_block (&se->post, tmp);
- }
}