Tobias Burnus wrote:
I am now down to a single kind of failure: pointer_remapping_*.f08
fails. One has code like:
ptr(1:5, 1:2) => arr
The question is how to solve that one. If one removes the AR_FULL and
sets lse.descriptor_only, the test cases fail; nevetheless, I wonder
whether something along those lines could be the solution.
That's what I do now: I added descriptor_only support to
gfc_conv_expr_descriptor.
The attached patch build and regtested successfully on x86-64-gnu-linux.
OK for the trunk?
Tobias
2012-08-23 Tobias Burnus <bur...@net-b.de>
Mikael Morin <mik...@gcc.gnu.org>
PR fortran/54350
* trans-array.c (free_ss_info): Free data.array.subscript.
(gfc_free_ss): No longer free data.array.subscript.
(walk_coarray): New function, moved from trans-intrinsic.c
(gfc_conv_expr_descriptor): Walk array descriptor instead
of taking passed "ss".
(get_array_ctor_all_strlen, gfc_add_loop_ss_code,
gfc_conv_array_parameter): Update call and cleanup ss handling.
* trans-array.h (gfc_conv_expr_descriptor,
gfc_conv_array_parameter): Update prototype.
* trans-expr.c (gfc_conv_derived_to_class,
conv_isocbinding_procedure, gfc_conv_procedure_call,
gfc_trans_alloc_subarray_assign, gfc_trans_subcomponent_assign,
gfc_trans_pointer_assignment, gfc_trans_arrayfunc_assign): Update
call to gfc_conv_expr_descriptor and gfc_conv_array_parameter, and
clean up.
* trans-intrinsic.c (walk_coarray): Moved to trans-array.c
(trans_this_image, trans_image_index, gfc_conv_intrinsic_rank
gfc_conv_intrinsic_bound, gfc_conv_intrinsic_cobound,
gfc_conv_intrinsic_len, gfc_conv_intrinsic_size,
gfc_conv_intrinsic_sizeof, gfc_conv_intrinsic_storage_size,
gfc_conv_intrinsic_transfer, gfc_conv_allocated,
gfc_conv_associated, gfc_conv_intrinsic_loc,
conv_intrinsic_move_alloc): Update calls.
* trans-io.c (gfc_convert_array_to_string, set_internal_unit,
gfc_trans_transfer): Ditto.
* trans-stmt.c (gfc_conv_elemental_dependencies,
gfc_trans_sync, trans_associate_var,
gfc_trans_pointer_assign_need_temp): Ditto.
diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c
index 8c254dd..891fab4 100644
--- a/gcc/fortran/trans-array.c
+++ b/gcc/fortran/trans-array.c
@@ -510,10 +510,24 @@ gfc_free_ss_chain (gfc_ss * ss)
static void
free_ss_info (gfc_ss_info *ss_info)
{
+ int n;
+
ss_info->refcount--;
if (ss_info->refcount > 0)
return;
+ switch (ss_info->type)
+ {
+ case GFC_SS_SECTION:
+ for (n = 0; n < GFC_MAX_DIMENSIONS; n++)
+ if (ss_info->data.array.subscript[n])
+ gfc_free_ss_chain (ss_info->data.array.subscript[n]);
+ break;
+
+ default:
+ break;
+ }
+
gcc_assert (ss_info->refcount == 0);
free (ss_info);
}
@@ -524,26 +538,7 @@ free_ss_info (gfc_ss_info *ss_info)
void
gfc_free_ss (gfc_ss * ss)
{
- gfc_ss_info *ss_info;
- int n;
-
- ss_info = ss->info;
-
- switch (ss_info->type)
- {
- case GFC_SS_SECTION:
- for (n = 0; n < ss->dimen; n++)
- {
- if (ss_info->data.array.subscript[ss->dim[n]])
- gfc_free_ss_chain (ss_info->data.array.subscript[ss->dim[n]]);
- }
- break;
-
- default:
- break;
- }
-
- free_ss_info (ss_info);
+ free_ss_info (ss->info);
free (ss);
}
@@ -1805,7 +1800,6 @@ static void
get_array_ctor_all_strlen (stmtblock_t *block, gfc_expr *e, tree *len)
{
gfc_se se;
- gfc_ss *ss;
/* Don't bother if we already know the length is a constant. */
if (*len && INTEGER_CST_P (*len))
@@ -1821,15 +1815,14 @@ get_array_ctor_all_strlen (stmtblock_t *block, gfc_expr *e, tree *len)
else
{
/* Otherwise, be brutal even if inefficient. */
- ss = gfc_walk_expr (e);
gfc_init_se (&se, NULL);
/* No function call, in case of side effects. */
se.no_function_call = 1;
- if (ss == gfc_ss_terminator)
+ if (e->rank == 0)
gfc_conv_expr (&se, e);
else
- gfc_conv_expr_descriptor (&se, e, ss);
+ gfc_conv_expr_descriptor (&se, e);
/* Fix the value. */
*len = gfc_evaluate_now (se.string_length, &se.pre);
@@ -2527,7 +2520,7 @@ gfc_add_loop_ss_code (gfc_loopinfo * loop, gfc_ss * ss, bool subscript,
case GFC_SS_VECTOR:
/* Get the vector's descriptor and store it in SS. */
gfc_init_se (&se, NULL);
- gfc_conv_expr_descriptor (&se, expr, gfc_walk_expr (expr));
+ gfc_conv_expr_descriptor (&se, expr);
gfc_add_block_to_block (&outer_loop->pre, &se.pre);
gfc_add_block_to_block (&outer_loop->post, &se.post);
info->descriptor = se.expr;
@@ -6328,6 +6321,44 @@ transposed_dims (gfc_ss *ss)
return false;
}
+
+/* Convert the last ref of a scalar coarray from an AR_ELEMENT to an
+ AR_FULL, suitable for the scalarizer. */
+
+static gfc_ss *
+walk_coarray (gfc_expr *e)
+{
+ gfc_ss *ss;
+
+ gcc_assert (gfc_get_corank (e) > 0);
+
+ ss = gfc_walk_expr (e);
+
+ /* Fix scalar coarray. */
+ if (ss == gfc_ss_terminator)
+ {
+ gfc_ref *ref;
+
+ ref = e->ref;
+ while (ref)
+ {
+ if (ref->type == REF_ARRAY
+ && ref->u.ar.codimen > 0)
+ break;
+
+ ref = ref->next;
+ }
+
+ gcc_assert (ref != NULL);
+ if (ref->u.ar.type == AR_ELEMENT)
+ ref->u.ar.type = AR_SECTION;
+ ss = gfc_reverse_ss (gfc_walk_array_ref (ss, e, ref));
+ }
+
+ return ss;
+}
+
+
/* Convert an array for passing as an actual argument. Expressions and
vector subscripts are evaluated and stored in a temporary, which is then
passed. For whole arrays the descriptor is passed. For array sections
@@ -6358,8 +6389,9 @@ transposed_dims (gfc_ss *ss)
function call. */
void
-gfc_conv_expr_descriptor (gfc_se * se, gfc_expr * expr, gfc_ss * ss)
+gfc_conv_expr_descriptor (gfc_se *se, gfc_expr *expr)
{
+ gfc_ss *ss;
gfc_ss_type ss_type;
gfc_ss_info *ss_info;
gfc_loopinfo loop;
@@ -6375,6 +6407,11 @@ gfc_conv_expr_descriptor (gfc_se * se, gfc_expr * expr, gfc_ss * ss)
bool subref_array_target = false;
gfc_expr *arg, *ss_expr;
+ if (se->want_coarray)
+ ss = walk_coarray (expr);
+ else
+ ss = gfc_walk_expr (expr);
+
gcc_assert (ss != NULL);
gcc_assert (ss != gfc_ss_terminator);
@@ -6382,6 +6419,16 @@ gfc_conv_expr_descriptor (gfc_se * se, gfc_expr * expr, gfc_ss * ss)
ss_type = ss_info->type;
ss_expr = ss_info->expr;
+ /* Special case: TRANSPOSE which needs no temporary. */
+ if (expr->expr_type == EXPR_FUNCTION && expr->value.function.isym
+ && expr->value.function.isym->id == GFC_ISYM_TRANSPOSE
+ && NULL != (arg = gfc_get_noncopying_intrinsic_argument (expr)))
+ {
+ /* This is a call to transpose which has already been handled by the
+ scalarizer, so that we just need to get its argument's descriptor. */
+ expr = expr->value.function.actual->expr;
+ }
+
/* Special case things we know we can pass easily. */
switch (expr->expr_type)
{
@@ -6411,7 +6458,7 @@ gfc_conv_expr_descriptor (gfc_se * se, gfc_expr * expr, gfc_ss * ss)
/* Create a new descriptor if the array doesn't have one. */
full = 0;
}
- else if (info->ref->u.ar.type == AR_FULL)
+ else if (info->ref->u.ar.type == AR_FULL || se->descriptor_only)
full = 1;
else if (se->direct_byref)
full = 0;
@@ -6443,6 +6490,7 @@ gfc_conv_expr_descriptor (gfc_se * se, gfc_expr * expr, gfc_ss * ss)
if (expr->ts.type == BT_CHARACTER)
se->string_length = gfc_get_expr_charlen (expr);
+ gfc_free_ss_chain (ss);
return;
}
break;
@@ -6457,7 +6505,8 @@ gfc_conv_expr_descriptor (gfc_se * se, gfc_expr * expr, gfc_ss * ss)
gcc_assert (expr->value.function.isym->id == GFC_ISYM_TRANSPOSE);
/* ... which has already been handled by the scalarizer, so
that we just need to get its argument's descriptor. */
- gfc_conv_expr_descriptor (se, expr->value.function.actual->expr, ss);
+ gfc_free_ss_chain (ss);
+ gfc_conv_expr_descriptor (se, expr->value.function.actual->expr);
return;
}
@@ -6477,6 +6526,7 @@ gfc_conv_expr_descriptor (gfc_se * se, gfc_expr * expr, gfc_ss * ss)
gcc_assert (se->ss == ss);
se->expr = gfc_build_addr_expr (NULL_TREE, se->expr);
gfc_conv_expr (se, expr);
+ gfc_free_ss_chain (ss);
return;
}
@@ -6896,7 +6946,7 @@ array_parameter_size (tree desc, gfc_expr *expr, tree *size)
/* TODO: Optimize passing g77 arrays. */
void
-gfc_conv_array_parameter (gfc_se * se, gfc_expr * expr, gfc_ss * ss, bool g77,
+gfc_conv_array_parameter (gfc_se * se, gfc_expr * expr, bool g77,
const gfc_symbol *fsym, const char *proc_name,
tree *size)
{
@@ -6967,7 +7017,7 @@ gfc_conv_array_parameter (gfc_se * se, gfc_expr * expr, gfc_ss * ss, bool g77,
if (sym->ts.type == BT_DERIVED || sym->ts.type == BT_CLASS)
{
- gfc_conv_expr_descriptor (se, expr, ss);
+ gfc_conv_expr_descriptor (se, expr);
se->expr = gfc_conv_array_data (se->expr);
return;
}
@@ -6993,7 +7043,7 @@ gfc_conv_array_parameter (gfc_se * se, gfc_expr * expr, gfc_ss * ss, bool g77,
{
if (sym->attr.dummy || sym->attr.result)
{
- gfc_conv_expr_descriptor (se, expr, ss);
+ gfc_conv_expr_descriptor (se, expr);
tmp = se->expr;
}
if (size)
@@ -7037,7 +7087,7 @@ gfc_conv_array_parameter (gfc_se * se, gfc_expr * expr, gfc_ss * ss, bool g77,
if (no_pack || array_constructor || good_allocatable || ultimate_alloc_comp)
{
- gfc_conv_expr_descriptor (se, expr, ss);
+ gfc_conv_expr_descriptor (se, expr);
if (expr->ts.type == BT_CHARACTER)
se->string_length = expr->ts.u.cl->backend_decl;
if (size)
@@ -7049,7 +7099,7 @@ gfc_conv_array_parameter (gfc_se * se, gfc_expr * expr, gfc_ss * ss, bool g77,
if (this_array_result)
{
/* Result of the enclosing function. */
- gfc_conv_expr_descriptor (se, expr, ss);
+ gfc_conv_expr_descriptor (se, expr);
if (size)
array_parameter_size (se->expr, expr, size);
se->expr = gfc_build_addr_expr (NULL_TREE, se->expr);
@@ -7065,7 +7115,7 @@ gfc_conv_array_parameter (gfc_se * se, gfc_expr * expr, gfc_ss * ss, bool g77,
{
/* Every other type of array. */
se->want_pointer = 1;
- gfc_conv_expr_descriptor (se, expr, ss);
+ gfc_conv_expr_descriptor (se, expr);
if (size)
array_parameter_size (build_fold_indirect_ref_loc (input_location,
se->expr),
diff --git a/gcc/fortran/trans-array.h b/gcc/fortran/trans-array.h
index 5ad794a..de03202 100644
--- a/gcc/fortran/trans-array.h
+++ b/gcc/fortran/trans-array.h
@@ -131,9 +131,9 @@ void gfc_conv_tmp_array_ref (gfc_se * se);
void gfc_conv_tmp_ref (gfc_se *);
/* Evaluate an array expression. */
-void gfc_conv_expr_descriptor (gfc_se *, gfc_expr *, gfc_ss *);
+void gfc_conv_expr_descriptor (gfc_se *, gfc_expr *);
/* Convert an array for passing as an actual function parameter. */
-void gfc_conv_array_parameter (gfc_se *, gfc_expr *, gfc_ss *, bool,
+void gfc_conv_array_parameter (gfc_se *, gfc_expr *, bool,
const gfc_symbol *, const char *, tree *);
/* Evaluate and transpose a matrix expression. */
void gfc_conv_array_transpose (gfc_se *, gfc_expr *);
diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index cfb0862..ebaa238 100644
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -304,7 +304,7 @@ gfc_conv_derived_to_class (gfc_se *parmse, gfc_expr *e,
else
{
parmse->ss = ss;
- gfc_conv_expr_descriptor (parmse, e, ss);
+ gfc_conv_expr_descriptor (parmse, e);
if (e->rank != class_ts.u.derived->components->as->rank)
class_array_data_assign (&parmse->pre, ctree, parmse->expr, true);
@@ -533,8 +533,8 @@ gfc_copy_class_to_class (tree from, tree to, tree nelems)
loop.to[0] = nelems;
gfc_trans_scalarizing_loops (&loop, &loopbody);
gfc_add_block_to_block (&body, &loop.pre);
- gfc_cleanup_loop (&loop);
tmp = gfc_finish_block (&body);
+ gfc_cleanup_loop (&loop);
}
else
{
@@ -3385,8 +3385,7 @@ conv_isocbinding_procedure (gfc_se * se, gfc_symbol * sym,
gfc_actual_arglist * arg)
{
gfc_symbol *fsym;
- gfc_ss *argss;
-
+
if (sym->intmod_sym_id == ISOCBINDING_LOC)
{
if (arg->expr->rank == 0)
@@ -3404,9 +3403,7 @@ conv_isocbinding_procedure (gfc_se * se, gfc_symbol * sym,
&& fsym->as->type != AS_ASSUMED_SHAPE;
f = f || !sym->attr.always_explicit;
- argss = gfc_walk_expr (arg->expr);
- gfc_conv_array_parameter (se, arg->expr, argss, f,
- NULL, NULL, NULL);
+ gfc_conv_array_parameter (se, arg->expr, f, NULL, NULL, NULL);
}
/* TODO -- the following two lines shouldn't be necessary, but if
@@ -3434,7 +3431,7 @@ conv_isocbinding_procedure (gfc_se * se, gfc_symbol * sym,
gfc_se cptrse;
gfc_se fptrse;
gfc_se shapese;
- gfc_ss *ss, *shape_ss;
+ gfc_ss *shape_ss;
tree desc, dim, tmp, stride, offset;
stmtblock_t body, block;
gfc_loopinfo loop;
@@ -3469,10 +3466,8 @@ conv_isocbinding_procedure (gfc_se * se, gfc_symbol * sym,
gfc_start_block (&block);
/* Get the descriptor of the Fortran pointer. */
- ss = gfc_walk_expr (arg->next->expr);
- gcc_assert (ss != gfc_ss_terminator);
fptrse.descriptor_only = 1;
- gfc_conv_expr_descriptor (&fptrse, arg->next->expr, ss);
+ gfc_conv_expr_descriptor (&fptrse, arg->next->expr);
gfc_add_block_to_block (&block, &fptrse.pre);
desc = fptrse.expr;
@@ -3534,7 +3529,6 @@ conv_isocbinding_procedure (gfc_se * se, gfc_symbol * sym,
gfc_add_block_to_block (&block, &loop.post);
gfc_add_block_to_block (&block, &fptrse.post);
gfc_cleanup_loop (&loop);
- gfc_free_ss (ss);
gfc_add_modify (&block, offset,
fold_build1_loc (input_location, NEGATE_EXPR,
@@ -3615,7 +3609,6 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
tree tmp;
tree fntype;
gfc_se parmse;
- gfc_ss *argss;
gfc_array_info *info;
int byref;
int parm_kind;
@@ -3818,11 +3811,20 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
}
else
{
- /* A scalar or transformational function. */
- gfc_init_se (&parmse, NULL);
+ bool scalar;
+ gfc_ss *argss;
+
+ /* Check whether the expression is a scalar or not; we cannot use
+ e->rank as it can be nonzero for functions arguments. */
argss = gfc_walk_expr (e);
+ scalar = argss == gfc_ss_terminator;
+ if (!scalar)
+ gfc_free_ss_chain (argss);
- if (argss == gfc_ss_terminator)
+ /* A scalar or transformational function. */
+ gfc_init_se (&parmse, NULL);
+
+ if (scalar)
{
if (e->expr_type == EXPR_VARIABLE
&& e->symtree->n.sym->attr.cray_pointee
@@ -3977,7 +3979,7 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
{
/* Pass a class array. */
gfc_init_se (&parmse, se);
- gfc_conv_expr_descriptor (&parmse, e, argss);
+ gfc_conv_expr_descriptor (&parmse, e);
/* The conversion does not repackage the reference to a class
array - _data descriptor. */
gfc_conv_class_to_class (&parmse, e, fsym->ts, false);
@@ -4060,8 +4062,7 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
fsym ? fsym->attr.intent : INTENT_INOUT,
fsym && fsym->attr.pointer);
else
- gfc_conv_array_parameter (&parmse, e, argss, f, fsym,
- sym->name, NULL);
+ gfc_conv_array_parameter (&parmse, e, f, fsym, sym->name, NULL);
/* If an ALLOCATABLE dummy argument has INTENT(OUT) and is
allocated on entry, it must be deallocated. */
@@ -5355,7 +5356,6 @@ gfc_trans_alloc_subarray_assign (tree dest, gfc_component * cm,
gfc_expr * expr)
{
gfc_se se;
- gfc_ss *rss;
stmtblock_t block;
tree offset;
int n;
@@ -5368,9 +5368,8 @@ gfc_trans_alloc_subarray_assign (tree dest, gfc_component * cm,
gfc_init_se (&se, NULL);
/* Get the descriptor for the expressions. */
- rss = gfc_walk_expr (expr);
se.want_pointer = 0;
- gfc_conv_expr_descriptor (&se, expr, rss);
+ gfc_conv_expr_descriptor (&se, expr);
gfc_add_block_to_block (&block, &se.pre);
gfc_add_modify (&block, dest, se.expr);
@@ -5501,7 +5500,6 @@ gfc_trans_subcomponent_assign (tree dest, gfc_component * cm, gfc_expr * expr)
{
gfc_se se;
gfc_se lse;
- gfc_ss *rss;
stmtblock_t block;
tree tmp;
@@ -5518,10 +5516,9 @@ gfc_trans_subcomponent_assign (tree dest, gfc_component * cm, gfc_expr * expr)
gfc_conv_descriptor_data_set (&block, dest, null_pointer_node);
else
{
- rss = gfc_walk_expr (expr);
se.direct_byref = 1;
se.expr = dest;
- gfc_conv_expr_descriptor (&se, expr, rss);
+ gfc_conv_expr_descriptor (&se, expr);
gfc_add_block_to_block (&block, &se.pre);
gfc_add_block_to_block (&block, &se.post);
}
@@ -5966,25 +5963,29 @@ gfc_trans_pointer_assignment (gfc_expr * expr1, gfc_expr * expr2)
{
gfc_se lse;
gfc_se rse;
- gfc_ss *lss;
- gfc_ss *rss;
stmtblock_t block;
tree desc;
tree tmp;
tree decl;
+ bool scalar;
+ gfc_ss *ss;
gfc_start_block (&block);
gfc_init_se (&lse, NULL);
- lss = gfc_walk_expr (expr1);
- rss = gfc_walk_expr (expr2);
- if (lss == gfc_ss_terminator)
+ /* Check whether the expression is a scalar or not; we cannot use
+ expr1->rank as it can be nonzero for proc pointers. */
+ ss = gfc_walk_expr (expr1);
+ scalar = ss == gfc_ss_terminator;
+ if (!scalar)
+ gfc_free_ss_chain (ss);
+
+ if (scalar)
{
/* Scalar pointers. */
lse.want_pointer = 1;
gfc_conv_expr (&lse, expr1);
- gcc_assert (rss == gfc_ss_terminator);
gfc_init_se (&rse, NULL);
rse.want_pointer = 1;
gfc_conv_expr (&rse, expr2);
@@ -6048,13 +6049,12 @@ gfc_trans_pointer_assignment (gfc_expr * expr1, gfc_expr * expr2)
for (remap = expr1->ref; remap; remap = remap->next)
if (!remap->next && remap->type == REF_ARRAY
&& remap->u.ar.type == AR_SECTION)
- {
- remap->u.ar.type = AR_FULL;
- break;
- }
+ break;
rank_remap = (remap && remap->u.ar.end[0]);
- gfc_conv_expr_descriptor (&lse, expr1, lss);
+ if (remap)
+ lse.descriptor_only = 1;
+ gfc_conv_expr_descriptor (&lse, expr1);
strlen_lhs = lse.string_length;
desc = lse.expr;
@@ -6070,14 +6070,14 @@ gfc_trans_pointer_assignment (gfc_expr * expr1, gfc_expr * expr2)
gfc_init_se (&rse, NULL);
rse.direct_byref = 1;
rse.byref_noassign = 1;
- gfc_conv_expr_descriptor (&rse, expr2, rss);
+ gfc_conv_expr_descriptor (&rse, expr2);
strlen_rhs = rse.string_length;
}
else if (expr2->expr_type == EXPR_VARIABLE)
{
/* Assign directly to the LHS's descriptor. */
lse.direct_byref = 1;
- gfc_conv_expr_descriptor (&lse, expr2, rss);
+ gfc_conv_expr_descriptor (&lse, expr2);
strlen_rhs = lse.string_length;
/* If this is a subreference array pointer assignment, use the rhs
@@ -6103,7 +6103,7 @@ gfc_trans_pointer_assignment (gfc_expr * expr1, gfc_expr * expr2)
lse.expr = tmp;
lse.direct_byref = 1;
- gfc_conv_expr_descriptor (&lse, expr2, rss);
+ gfc_conv_expr_descriptor (&lse, expr2);
strlen_rhs = lse.string_length;
gfc_add_modify (&lse.pre, desc, tmp);
}
@@ -6715,7 +6715,7 @@ static tree
gfc_trans_arrayfunc_assign (gfc_expr * expr1, gfc_expr * expr2)
{
gfc_se se;
- gfc_ss *ss;
+ gfc_ss *ss = NULL;
gfc_component *comp = NULL;
gfc_loopinfo loop;
@@ -6730,13 +6730,11 @@ gfc_trans_arrayfunc_assign (gfc_expr * expr1, gfc_expr * expr2)
|| (!comp && gfc_return_by_reference (expr2->value.function.esym)
&& expr2->value.function.esym->result->attr.dimension));
- ss = gfc_walk_expr (expr1);
- gcc_assert (ss != gfc_ss_terminator);
gfc_init_se (&se, NULL);
gfc_start_block (&se.pre);
se.want_pointer = 1;
- gfc_conv_array_parameter (&se, expr1, ss, false, NULL, NULL, NULL);
+ gfc_conv_array_parameter (&se, expr1, false, NULL, NULL, NULL);
if (expr1->ts.type == BT_DERIVED
&& expr1->ts.u.derived->attr.alloc_comp)
@@ -6770,8 +6768,10 @@ gfc_trans_arrayfunc_assign (gfc_expr * expr1, gfc_expr * expr2)
if (!expr2->value.function.isym)
{
+ ss = gfc_walk_expr (expr1);
+ gcc_assert (ss != gfc_ss_terminator);
+
realloc_lhs_loop_for_fcn_call (&se, &expr1->where, &ss, &loop);
- gfc_cleanup_loop (&loop);
ss->is_alloc_lhs = 1;
}
else
@@ -6780,7 +6780,6 @@ gfc_trans_arrayfunc_assign (gfc_expr * expr1, gfc_expr * expr2)
gfc_conv_function_expr (&se, expr2);
gfc_add_block_to_block (&se.pre, &se.post);
- gfc_free_ss (se.ss);
return gfc_finish_block (&se.pre);
}
diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c
index d0aebe9..5160cf0 100644
--- a/gcc/fortran/trans-intrinsic.c
+++ b/gcc/fortran/trans-intrinsic.c
@@ -923,43 +923,6 @@ gfc_conv_intrinsic_exponent (gfc_se *se, gfc_expr *expr)
}
-/* Convert the last ref of a scalar coarray from an AR_ELEMENT to an
- AR_FULL, suitable for the scalarizer. */
-
-static gfc_ss *
-walk_coarray (gfc_expr *e)
-{
- gfc_ss *ss;
-
- gcc_assert (gfc_get_corank (e) > 0);
-
- ss = gfc_walk_expr (e);
-
- /* Fix scalar coarray. */
- if (ss == gfc_ss_terminator)
- {
- gfc_ref *ref;
-
- ref = e->ref;
- while (ref)
- {
- if (ref->type == REF_ARRAY
- && ref->u.ar.codimen > 0)
- break;
-
- ref = ref->next;
- }
-
- gcc_assert (ref != NULL);
- if (ref->u.ar.type == AR_ELEMENT)
- ref->u.ar.type = AR_SECTION;
- ss = gfc_reverse_ss (gfc_walk_array_ref (ss, e, ref));
- }
-
- return ss;
-}
-
-
static void
trans_this_image (gfc_se * se, gfc_expr *expr)
{
@@ -967,7 +930,6 @@ trans_this_image (gfc_se * se, gfc_expr *expr)
tree type, desc, dim_arg, cond, tmp, m, loop_var, exit_label, min_var,
lbound, ubound, extent, ml;
gfc_se argse;
- gfc_ss *ss;
int rank, corank;
/* The case -fcoarray=single is handled elsewhere. */
@@ -991,10 +953,8 @@ trans_this_image (gfc_se * se, gfc_expr *expr)
/* Obtain the descriptor of the COARRAY. */
gfc_init_se (&argse, NULL);
- ss = walk_coarray (expr->value.function.actual->expr);
- gcc_assert (ss != gfc_ss_terminator);
argse.want_coarray = 1;
- gfc_conv_expr_descriptor (&argse, expr->value.function.actual->expr, ss);
+ gfc_conv_expr_descriptor (&argse, expr->value.function.actual->expr);
gfc_add_block_to_block (&se->pre, &argse.pre);
gfc_add_block_to_block (&se->post, &argse.post);
desc = argse.expr;
@@ -1186,7 +1146,6 @@ trans_image_index (gfc_se * se, gfc_expr *expr)
tree num_images, cond, coindex, type, lbound, ubound, desc, subdesc,
tmp, invalid_bound;
gfc_se argse, subse;
- gfc_ss *ss, *subss;
int rank, corank, codim;
type = gfc_get_int_type (gfc_default_integer_kind);
@@ -1195,20 +1154,15 @@ trans_image_index (gfc_se * se, gfc_expr *expr)
/* Obtain the descriptor of the COARRAY. */
gfc_init_se (&argse, NULL);
- ss = walk_coarray (expr->value.function.actual->expr);
- gcc_assert (ss != gfc_ss_terminator);
argse.want_coarray = 1;
- gfc_conv_expr_descriptor (&argse, expr->value.function.actual->expr, ss);
+ gfc_conv_expr_descriptor (&argse, expr->value.function.actual->expr);
gfc_add_block_to_block (&se->pre, &argse.pre);
gfc_add_block_to_block (&se->post, &argse.post);
desc = argse.expr;
/* Obtain a handle to the SUB argument. */
gfc_init_se (&subse, NULL);
- subss = gfc_walk_expr (expr->value.function.actual->next->expr);
- gcc_assert (subss != gfc_ss_terminator);
- gfc_conv_expr_descriptor (&subse, expr->value.function.actual->next->expr,
- subss);
+ gfc_conv_expr_descriptor (&subse, expr->value.function.actual->next->expr);
gfc_add_block_to_block (&se->pre, &subse.pre);
gfc_add_block_to_block (&se->post, &subse.post);
subdesc = build_fold_indirect_ref_loc (input_location,
@@ -1319,16 +1273,12 @@ static void
gfc_conv_intrinsic_rank (gfc_se *se, gfc_expr *expr)
{
gfc_se argse;
- gfc_ss *ss;
- ss = gfc_walk_expr (expr->value.function.actual->expr);
- gcc_assert (ss != gfc_ss_terminator);
gfc_init_se (&argse, NULL);
argse.data_not_needed = 1;
argse.descriptor_only = 1;
- gfc_conv_expr_descriptor (&argse, expr->value.function.actual->expr, ss);
- gfc_free_ss (ss);
+ gfc_conv_expr_descriptor (&argse, expr->value.function.actual->expr);
gfc_add_block_to_block (&se->pre, &argse.pre);
gfc_add_block_to_block (&se->post, &argse.post);
@@ -1352,7 +1302,6 @@ gfc_conv_intrinsic_bound (gfc_se * se, gfc_expr * expr, int upper)
tree ubound;
tree lbound;
gfc_se argse;
- gfc_ss *ss;
gfc_array_spec * as;
bool assumed_rank_lb_one;
@@ -1387,10 +1336,8 @@ gfc_conv_intrinsic_bound (gfc_se * se, gfc_expr * expr, int upper)
/* TODO: don't re-evaluate the descriptor on each iteration. */
/* Get a descriptor for the first parameter. */
- ss = gfc_walk_expr (arg->expr);
- gcc_assert (ss != gfc_ss_terminator);
gfc_init_se (&argse, NULL);
- gfc_conv_expr_descriptor (&argse, arg->expr, ss);
+ gfc_conv_expr_descriptor (&argse, arg->expr);
gfc_add_block_to_block (&se->pre, &argse.pre);
gfc_add_block_to_block (&se->post, &argse.post);
@@ -1556,7 +1503,6 @@ conv_intrinsic_cobound (gfc_se * se, gfc_expr * expr)
gfc_actual_arglist *arg;
gfc_actual_arglist *arg2;
gfc_se argse;
- gfc_ss *ss;
tree bound, resbound, resbound2, desc, cond, tmp;
tree type;
int corank;
@@ -1571,12 +1517,10 @@ conv_intrinsic_cobound (gfc_se * se, gfc_expr * expr)
gcc_assert (arg->expr->expr_type == EXPR_VARIABLE);
corank = gfc_get_corank (arg->expr);
- ss = walk_coarray (arg->expr);
- gcc_assert (ss != gfc_ss_terminator);
gfc_init_se (&argse, NULL);
argse.want_coarray = 1;
- gfc_conv_expr_descriptor (&argse, arg->expr, ss);
+ gfc_conv_expr_descriptor (&argse, arg->expr);
gfc_add_block_to_block (&se->pre, &argse.pre);
gfc_add_block_to_block (&se->post, &argse.post);
desc = argse.expr;
@@ -4595,7 +4539,6 @@ gfc_conv_intrinsic_len (gfc_se * se, gfc_expr * expr)
gfc_symbol *sym;
gfc_se argse;
gfc_expr *arg;
- gfc_ss *ss;
gcc_assert (!se->ss);
@@ -4637,12 +4580,11 @@ gfc_conv_intrinsic_len (gfc_se * se, gfc_expr * expr)
default:
/* Anybody stupid enough to do this deserves inefficient code. */
- ss = gfc_walk_expr (arg);
gfc_init_se (&argse, se);
- if (ss == gfc_ss_terminator)
+ if (arg->rank == 0)
gfc_conv_expr (&argse, arg);
else
- gfc_conv_expr_descriptor (&argse, arg, ss);
+ gfc_conv_expr_descriptor (&argse, arg);
gfc_add_block_to_block (&se->pre, &argse.pre);
gfc_add_block_to_block (&se->post, &argse.post);
len = argse.string_length;
@@ -5099,7 +5041,6 @@ gfc_conv_intrinsic_size (gfc_se * se, gfc_expr * expr)
tree fncall0;
tree fncall1;
gfc_se argse;
- gfc_ss *ss;
gfc_init_se (&argse, NULL);
actual = expr->value.function.actual;
@@ -5107,11 +5048,9 @@ gfc_conv_intrinsic_size (gfc_se * se, gfc_expr * expr)
if (actual->expr->ts.type == BT_CLASS)
gfc_add_class_array_ref (actual->expr);
- ss = gfc_walk_expr (actual->expr);
- gcc_assert (ss != gfc_ss_terminator);
argse.want_pointer = 1;
argse.data_not_needed = 1;
- gfc_conv_expr_descriptor (&argse, actual->expr, ss);
+ gfc_conv_expr_descriptor (&argse, actual->expr);
gfc_add_block_to_block (&se->pre, &argse.pre);
gfc_add_block_to_block (&se->post, &argse.post);
arg1 = gfc_evaluate_now (argse.expr, &se->pre);
@@ -5214,7 +5153,6 @@ static void
gfc_conv_intrinsic_sizeof (gfc_se *se, gfc_expr *expr)
{
gfc_expr *arg;
- gfc_ss *ss;
gfc_se argse;
tree source_bytes;
tree type;
@@ -5226,9 +5164,8 @@ gfc_conv_intrinsic_sizeof (gfc_se *se, gfc_expr *expr)
arg = expr->value.function.actual->expr;
gfc_init_se (&argse, NULL);
- ss = gfc_walk_expr (arg);
- if (ss == gfc_ss_terminator)
+ if (arg->rank == 0)
{
if (arg->ts.type == BT_CLASS)
gfc_add_data_component (arg);
@@ -5249,7 +5186,7 @@ gfc_conv_intrinsic_sizeof (gfc_se *se, gfc_expr *expr)
{
source_bytes = gfc_create_var (gfc_array_index_type, "bytes");
argse.want_pointer = 0;
- gfc_conv_expr_descriptor (&argse, arg, ss);
+ gfc_conv_expr_descriptor (&argse, arg);
type = gfc_get_element_type (TREE_TYPE (argse.expr));
/* Obtain the argument's word length. */
@@ -5286,7 +5223,6 @@ static void
gfc_conv_intrinsic_storage_size (gfc_se *se, gfc_expr *expr)
{
gfc_expr *arg;
- gfc_ss *ss;
gfc_se argse,eight;
tree type, result_type, tmp;
@@ -5295,10 +5231,9 @@ gfc_conv_intrinsic_storage_size (gfc_se *se, gfc_expr *expr)
gfc_conv_expr (&eight, gfc_get_int_expr (expr->ts.kind, NULL, 8));
gfc_init_se (&argse, NULL);
- ss = gfc_walk_expr (arg);
result_type = gfc_get_int_type (expr->ts.kind);
- if (ss == gfc_ss_terminator)
+ if (arg->rank == 0)
{
if (arg->ts.type == BT_CLASS)
{
@@ -5316,7 +5251,7 @@ gfc_conv_intrinsic_storage_size (gfc_se *se, gfc_expr *expr)
else
{
argse.want_pointer = 0;
- gfc_conv_expr_descriptor (&argse, arg, ss);
+ gfc_conv_expr_descriptor (&argse, arg);
type = gfc_get_element_type (TREE_TYPE (argse.expr));
}
@@ -5410,7 +5345,6 @@ gfc_conv_intrinsic_transfer (gfc_se * se, gfc_expr * expr)
tree stmt;
gfc_actual_arglist *arg;
gfc_se argse;
- gfc_ss *ss;
gfc_array_info *info;
stmtblock_t block;
int n;
@@ -5436,12 +5370,11 @@ gfc_conv_intrinsic_transfer (gfc_se * se, gfc_expr * expr)
arg->expr->value.function.name = "__transfer_in_transfer";
gfc_init_se (&argse, NULL);
- ss = gfc_walk_expr (arg->expr);
source_bytes = gfc_create_var (gfc_array_index_type, NULL);
/* Obtain the pointer to source and the length of source in bytes. */
- if (ss == gfc_ss_terminator)
+ if (arg->expr->rank == 0)
{
gfc_conv_expr_reference (&argse, arg->expr);
source = argse.expr;
@@ -5460,7 +5393,7 @@ gfc_conv_intrinsic_transfer (gfc_se * se, gfc_expr * expr)
else
{
argse.want_pointer = 0;
- gfc_conv_expr_descriptor (&argse, arg->expr, ss);
+ gfc_conv_expr_descriptor (&argse, arg->expr);
source = gfc_conv_descriptor_data_get (argse.expr);
source_type = gfc_get_element_type (TREE_TYPE (argse.expr));
@@ -5534,11 +5467,10 @@ gfc_conv_intrinsic_transfer (gfc_se * se, gfc_expr * expr)
arg = arg->next;
gfc_init_se (&argse, NULL);
- ss = gfc_walk_expr (arg->expr);
scalar_mold = arg->expr->rank == 0;
- if (ss == gfc_ss_terminator)
+ if (arg->expr->rank == 0)
{
gfc_conv_expr_reference (&argse, arg->expr);
mold_type = TREE_TYPE (build_fold_indirect_ref_loc (input_location,
@@ -5548,7 +5480,7 @@ gfc_conv_intrinsic_transfer (gfc_se * se, gfc_expr * expr)
{
gfc_init_se (&argse, NULL);
argse.want_pointer = 0;
- gfc_conv_expr_descriptor (&argse, arg->expr, ss);
+ gfc_conv_expr_descriptor (&argse, arg->expr);
mold_type = gfc_get_element_type (TREE_TYPE (argse.expr));
}
@@ -5741,7 +5673,6 @@ gfc_conv_allocated (gfc_se *se, gfc_expr *expr)
{
gfc_actual_arglist *arg1;
gfc_se arg1se;
- gfc_ss *ss1;
tree tmp;
gfc_init_se (&arg1se, NULL);
@@ -5758,9 +5689,7 @@ gfc_conv_allocated (gfc_se *se, gfc_expr *expr)
gfc_add_data_component (arg1->expr);
}
- ss1 = gfc_walk_expr (arg1->expr);
-
- if (ss1 == gfc_ss_terminator)
+ if (arg1->expr->rank == 0)
{
/* Allocatable scalar. */
arg1se.want_pointer = 1;
@@ -5771,7 +5700,7 @@ gfc_conv_allocated (gfc_se *se, gfc_expr *expr)
{
/* Allocatable array. */
arg1se.descriptor_only = 1;
- gfc_conv_expr_descriptor (&arg1se, arg1->expr, ss1);
+ gfc_conv_expr_descriptor (&arg1se, arg1->expr);
tmp = gfc_conv_descriptor_data_get (arg1se.expr);
}
@@ -5798,7 +5727,8 @@ gfc_conv_associated (gfc_se *se, gfc_expr *expr)
tree tmp;
tree nonzero_charlen;
tree nonzero_arraylen;
- gfc_ss *ss1, *ss2;
+ gfc_ss *ss;
+ bool scalar;
gfc_init_se (&arg1se, NULL);
gfc_init_se (&arg2se, NULL);
@@ -5806,12 +5736,18 @@ gfc_conv_associated (gfc_se *se, gfc_expr *expr)
if (arg1->expr->ts.type == BT_CLASS)
gfc_add_data_component (arg1->expr);
arg2 = arg1->next;
- ss1 = gfc_walk_expr (arg1->expr);
+
+ /* Check whether the expression is a scalar or not; we cannot use
+ arg1->expr->rank as it can be nonzero for proc pointers. */
+ ss = gfc_walk_expr (arg1->expr);
+ scalar = ss == gfc_ss_terminator;
+ if (!scalar)
+ gfc_free_ss_chain (ss);
if (!arg2->expr)
{
/* No optional target. */
- if (ss1 == gfc_ss_terminator)
+ if (scalar)
{
/* A pointer to a scalar. */
arg1se.want_pointer = 1;
@@ -5825,7 +5761,7 @@ gfc_conv_associated (gfc_se *se, gfc_expr *expr)
else
{
/* A pointer to an array. */
- gfc_conv_expr_descriptor (&arg1se, arg1->expr, ss1);
+ gfc_conv_expr_descriptor (&arg1se, arg1->expr);
tmp2 = gfc_conv_descriptor_data_get (arg1se.expr);
}
gfc_add_block_to_block (&se->pre, &arg1se.pre);
@@ -5839,7 +5775,6 @@ gfc_conv_associated (gfc_se *se, gfc_expr *expr)
/* An optional target. */
if (arg2->expr->ts.type == BT_CLASS)
gfc_add_data_component (arg2->expr);
- ss2 = gfc_walk_expr (arg2->expr);
nonzero_charlen = NULL_TREE;
if (arg1->expr->ts.type == BT_CHARACTER)
@@ -5847,11 +5782,9 @@ gfc_conv_associated (gfc_se *se, gfc_expr *expr)
boolean_type_node,
arg1->expr->ts.u.cl->backend_decl,
integer_zero_node);
-
- if (ss1 == gfc_ss_terminator)
+ if (scalar)
{
/* A pointer to a scalar. */
- gcc_assert (ss2 == gfc_ss_terminator);
arg1se.want_pointer = 1;
gfc_conv_expr (&arg1se, arg1->expr);
if (arg1->expr->symtree->n.sym->attr.proc_pointer
@@ -5894,12 +5827,11 @@ gfc_conv_associated (gfc_se *se, gfc_expr *expr)
build_int_cst (TREE_TYPE (tmp), 0));
/* A pointer to an array, call library function _gfor_associated. */
- gcc_assert (ss2 != gfc_ss_terminator);
arg1se.want_pointer = 1;
- gfc_conv_expr_descriptor (&arg1se, arg1->expr, ss1);
+ gfc_conv_expr_descriptor (&arg1se, arg1->expr);
arg2se.want_pointer = 1;
- gfc_conv_expr_descriptor (&arg2se, arg2->expr, ss2);
+ gfc_conv_expr_descriptor (&arg2se, arg2->expr);
gfc_add_block_to_block (&se->pre, &arg2se.pre);
gfc_add_block_to_block (&se->post, &arg2se.post);
se->expr = build_call_expr_loc (input_location,
@@ -6254,16 +6186,14 @@ gfc_conv_intrinsic_loc (gfc_se * se, gfc_expr * expr)
{
tree temp_var;
gfc_expr *arg_expr;
- gfc_ss *ss;
gcc_assert (!se->ss);
arg_expr = expr->value.function.actual->expr;
- ss = gfc_walk_expr (arg_expr);
- if (ss == gfc_ss_terminator)
+ if (arg_expr->rank == 0)
gfc_conv_expr_reference (se, arg_expr);
else
- gfc_conv_array_parameter (se, arg_expr, ss, true, NULL, NULL, NULL);
+ gfc_conv_array_parameter (se, arg_expr, true, NULL, NULL, NULL);
se->expr= convert (gfc_get_int_type (gfc_index_integer_kind), se->expr);
/* Create a temporary variable for loc return value. Without this,
@@ -7302,7 +7232,6 @@ conv_intrinsic_move_alloc (gfc_code *code)
gfc_expr *from_expr, *to_expr;
gfc_expr *to_expr2, *from_expr2 = NULL;
gfc_se from_se, to_se;
- gfc_ss *from_ss, *to_ss;
tree tmp;
bool coarray;
@@ -7428,19 +7357,15 @@ conv_intrinsic_move_alloc (gfc_code *code)
}
}
+
/* Deallocate "to". */
- if (from_expr->rank != 0)
- {
- to_ss = gfc_walk_expr (to_expr);
- from_ss = gfc_walk_expr (from_expr);
- }
- else
+ if (from_expr->rank == 0)
{
- to_ss = walk_coarray (to_expr);
- from_ss = walk_coarray (from_expr);
+ to_se.want_coarray = 1;
+ from_se.want_coarray = 1;
}
- gfc_conv_expr_descriptor (&to_se, to_expr, to_ss);
- gfc_conv_expr_descriptor (&from_se, from_expr, from_ss);
+ gfc_conv_expr_descriptor (&to_se, to_expr);
+ gfc_conv_expr_descriptor (&from_se, from_expr);
/* For coarrays, call SYNC ALL if TO is already deallocated as MOVE_ALLOC
is an image control "statement", cf. IR F08/0040 in 12-006A. */
diff --git a/gcc/fortran/trans-io.c b/gcc/fortran/trans-io.c
index 9d7d5b6..34db6fd 100644
--- a/gcc/fortran/trans-io.c
+++ b/gcc/fortran/trans-io.c
@@ -664,7 +664,7 @@ gfc_convert_array_to_string (gfc_se * se, gfc_expr * e)
return;
}
- gfc_conv_array_parameter (se, e, gfc_walk_expr (e), true, NULL, NULL, &size);
+ gfc_conv_array_parameter (se, e, true, NULL, NULL, &size);
se->string_length = fold_convert (gfc_charlen_type_node, size);
}
@@ -780,8 +780,6 @@ set_internal_unit (stmtblock_t * block, stmtblock_t * post_block,
/* Character array. */
else if (e->rank > 0)
{
- se.ss = gfc_walk_expr (e);
-
if (is_subref_array (e))
{
/* Use a temporary for components of arrays of derived types
@@ -796,7 +794,7 @@ set_internal_unit (stmtblock_t * block, stmtblock_t * post_block,
else
{
/* Return the data pointer and rank from the descriptor. */
- gfc_conv_expr_descriptor (&se, e, se.ss);
+ gfc_conv_expr_descriptor (&se, e);
tmp = gfc_conv_descriptor_data_get (se.expr);
se.expr = gfc_build_addr_expr (pchar_type_node, se.expr);
}
@@ -2236,12 +2234,10 @@ gfc_trans_transfer (gfc_code * code)
gfc_init_block (&body);
expr = code->expr1;
- ss = gfc_walk_expr (expr);
-
ref = NULL;
gfc_init_se (&se, NULL);
- if (ss == gfc_ss_terminator)
+ if (expr->rank == 0)
{
/* Transfer a scalar value. */
gfc_conv_expr_reference (&se, expr);
@@ -2281,15 +2277,16 @@ gfc_trans_transfer (gfc_code * code)
else
{
/* Get the descriptor. */
- gfc_conv_expr_descriptor (&se, expr, ss);
+ gfc_conv_expr_descriptor (&se, expr);
tmp = gfc_build_addr_expr (NULL_TREE, se.expr);
}
transfer_array_desc (&se, &expr->ts, tmp);
goto finish_block_label;
}
-
+
/* Initialize the scalarizer. */
+ ss = gfc_walk_expr (expr);
gfc_init_loopinfo (&loop);
gfc_add_ss_to_loop (&loop, ss);
diff --git a/gcc/fortran/trans-stmt.c b/gcc/fortran/trans-stmt.c
index 7ece492..9467601 100644
--- a/gcc/fortran/trans-stmt.c
+++ b/gcc/fortran/trans-stmt.c
@@ -274,7 +274,7 @@ gfc_conv_elemental_dependencies (gfc_se * se, gfc_se * loopse,
/* Obtain the argument descriptor for unpacking. */
gfc_init_se (&parmse, NULL);
parmse.want_pointer = 1;
- gfc_conv_expr_descriptor (&parmse, e, gfc_walk_expr (e));
+ gfc_conv_expr_descriptor (&parmse, e);
gfc_add_block_to_block (&se->pre, &parmse.pre);
/* If we've got INTENT(INOUT) or a derived type with INTENT(OUT),
@@ -864,9 +864,7 @@ gfc_trans_sync (gfc_code *code, gfc_exec_op type)
"implemented for image-set at %L",
gfc_c_int_kind, &code->expr1->where);
- gfc_conv_array_parameter (&se, code->expr1,
- gfc_walk_expr (code->expr1), true, NULL,
- NULL, &len);
+ gfc_conv_array_parameter (&se, code->expr1, true, NULL, NULL, &len);
images = se.expr;
tmp = gfc_typenode_for_spec (&code->expr1->ts);
@@ -1160,7 +1158,6 @@ trans_associate_var (gfc_symbol *sym, gfc_wrapped_block *block)
&& (sym->as->type == AS_DEFERRED || sym->assoc->variable))
{
gfc_se se;
- gfc_ss *ss;
tree desc;
desc = sym->backend_decl;
@@ -1168,13 +1165,12 @@ trans_associate_var (gfc_symbol *sym, gfc_wrapped_block *block)
/* If association is to an expression, evaluate it and create temporary.
Otherwise, get descriptor of target for pointer assignment. */
gfc_init_se (&se, NULL);
- ss = gfc_walk_expr (e);
if (sym->assoc->variable)
{
se.direct_byref = 1;
se.expr = desc;
}
- gfc_conv_expr_descriptor (&se, e, ss);
+ gfc_conv_expr_descriptor (&se, e);
/* If we didn't already do the pointer assignment, set associate-name
descriptor to the one generated for the temporary. */
@@ -1229,7 +1225,7 @@ trans_associate_var (gfc_symbol *sym, gfc_wrapped_block *block)
if (sym->ts.type == BT_CLASS && CLASS_DATA (sym)->attr.dimension)
{
/* For a class array we need a descriptor for the selector. */
- gfc_conv_expr_descriptor (&se, e, gfc_walk_expr (e));
+ gfc_conv_expr_descriptor (&se, e);
/* Obtain a temporary class container for the result. */
gfc_conv_class_to_class (&se, e, sym->ts, false);
@@ -3502,8 +3498,7 @@ gfc_trans_pointer_assign_need_temp (gfc_expr * expr1, gfc_expr * expr2,
gfc_init_se (&lse, NULL);
lse.expr = gfc_build_array_ref (tmp1, count, NULL);
lse.direct_byref = 1;
- rss = gfc_walk_expr (expr2);
- gfc_conv_expr_descriptor (&lse, expr2, rss);
+ gfc_conv_expr_descriptor (&lse, expr2);
gfc_add_block_to_block (&body, &lse.pre);
gfc_add_block_to_block (&body, &lse.post);
@@ -3524,9 +3519,8 @@ gfc_trans_pointer_assign_need_temp (gfc_expr * expr1, gfc_expr * expr2,
gfc_add_modify (block, count, gfc_index_zero_node);
parm = gfc_build_array_ref (tmp1, count, NULL);
- lss = gfc_walk_expr (expr1);
gfc_init_se (&lse, NULL);
- gfc_conv_expr_descriptor (&lse, expr1, lss);
+ gfc_conv_expr_descriptor (&lse, expr1);
gfc_add_modify (&lse.pre, lse.expr, parm);
gfc_start_block (&body);
gfc_add_block_to_block (&body, &lse.pre);
