procyberian/gcc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

re PR fortran/54350 (FAIL: gfortran.dg/realloc_on_assign_*.f90 -O (internal compiler error) at r190586)

Browse source 
2012-08-24  Tobias Burnus  <burnus@net-b.de>

        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.

From-SVN: r190641
This commit is contained in:
Tobias Burnus 2012-08-24 09:43:23 +02:00 • committed by Tobias Burnus
parent 3c5e0cc46e
commit 2960a36853
7 changed files with 214 additions and 230 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

32
gcc/fortran/ChangeLog
View file

@ -1,3 +1,35 @@
2012-08-23 Tobias Burnus <burnus@net-b.de>
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.
2012-08-23 Jakub Jelinek <jakub@redhat.com>
* trans-decl.c (trans_function_start, generate_coarray_init,

129
gcc/fortran/trans-array.c
View file

@ -510,11 +510,26 @@ 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;
gcc_assert (ss_info->refcount == 0);
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;
}
free (ss_info);
}
@ -524,26 +539,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 +1801,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 +1816,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 +2521,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 +6322,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 +6390,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 +6408,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 +6420,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. */
while (expr->expr_type == EXPR_FUNCTION && expr->value.function.isym
&& 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. */
gcc_assert (expr->value.function.isym->id == GFC_ISYM_TRANSPOSE);
expr = expr->value.function.actual->expr;
}
/* Special case things we know we can pass easily. */
switch (expr->expr_type)
{
@ -6411,7 +6459,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,24 +6491,12 @@ 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;
case EXPR_FUNCTION:
/* We don't need to copy data in some cases. */
arg = gfc_get_noncopying_intrinsic_argument (expr);
if (arg)
{
/* This is a call to transpose... */
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);
return;
}
/* A transformational function return value will be a temporary
array descriptor. We still need to go through the scalarizer
to create the descriptor. Elemental functions are handled as
@ -6477,6 +6513,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 +6933,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 +7004,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 +7030,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 +7074,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 +7086,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 +7102,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),

4
gcc/fortran/trans-array.h
View file

@ -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 *);

89
gcc/fortran/trans-expr.c
View file

@ -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
{
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);
/* A scalar or transformational function. */
gfc_init_se (&parmse, NULL);
argss = gfc_walk_expr (e);
if (argss == gfc_ss_terminator)
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);
}

157
gcc/fortran/trans-intrinsic.c
View file

@ -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)
if (from_expr->rank == 0)
{
to_ss = gfc_walk_expr (to_expr);
from_ss = gfc_walk_expr (from_expr);
to_se.want_coarray = 1;
from_se.want_coarray = 1;
}
else
{
to_ss = walk_coarray (to_expr);
from_ss = walk_coarray (from_expr);
}
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. */

15
gcc/fortran/trans-io.c
View file

@ -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);

18
gcc/fortran/trans-stmt.c
View file

@ -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);