From 2960a3685367ff2a1da3dfa428c200e07d97fe6e Mon Sep 17 00:00:00 2001 From: Tobias Burnus Date: Fri, 24 Aug 2012 09:43:23 +0200 Subject: [PATCH] re PR fortran/54350 (FAIL: gfortran.dg/realloc_on_assign_*.f90 -O (internal compiler error) at r190586) 2012-08-24 Tobias Burnus 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 --- gcc/fortran/ChangeLog | 32 +++++++ gcc/fortran/trans-array.c | 129 ++++++++++++++++++---------- gcc/fortran/trans-array.h | 4 +- gcc/fortran/trans-expr.c | 89 ++++++++++--------- gcc/fortran/trans-intrinsic.c | 157 +++++++++------------------------- gcc/fortran/trans-io.c | 15 ++-- gcc/fortran/trans-stmt.c | 18 ++-- 7 files changed, 214 insertions(+), 230 deletions(-) diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 88e0bbd8d54..e8b4b4168bd 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,35 @@ +2012-08-23 Tobias Burnus + + 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 * trans-decl.c (trans_function_start, generate_coarray_init, diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index 8c254dda6b0..c350c3b5e3a 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -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), diff --git a/gcc/fortran/trans-array.h b/gcc/fortran/trans-array.h index 5ad794ad752..de032020261 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 cfb08621219..ebaa2386055 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 { + 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); } diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c index d0aebe94774..5160cf0c0f1 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) + 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. */ diff --git a/gcc/fortran/trans-io.c b/gcc/fortran/trans-io.c index 9d7d5b6cb72..34db6fd5a11 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 7ece49246ba..9467601c08d 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);