X-Git-Url: http://git.sourceforge.jp/view?p=pf3gnuchains%2Fgcc-fork.git;a=blobdiff_plain;f=gcc%2Ffortran%2Ftrans-array.c;h=e3134f5efa9e485d0f99cc2205a105a5d2a9aa53;hp=80a6fe67467b0543bcdae6df70fa627b76e683c7;hb=4d0a8b9d7a3cdf29a03dce0098f74fdcad38e81e;hpb=e052a7fa27a91eb9ef9ef15da8d8435402b8f716 diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index 80a6fe67467..e3134f5efa9 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -526,7 +526,6 @@ gfc_get_array_ss (gfc_ss *next, gfc_expr *expr, int dimen, gfc_ss_type type) ss->expr = expr; info = &ss->data.info; info->dimen = dimen; - info->codimen = 0; for (i = 0; i < info->dimen; i++) info->dim[i] = i; @@ -641,7 +640,7 @@ gfc_set_loop_bounds_from_array_spec (gfc_interface_mapping * mapping, tree tmp; if (as && as->type == AS_EXPLICIT) - for (n = 0; n < se->loop->dimen + se->loop->codimen; n++) + for (n = 0; n < se->loop->dimen; n++) { dim = se->ss->data.info.dim[n]; gcc_assert (dim < as->rank); @@ -655,22 +654,18 @@ gfc_set_loop_bounds_from_array_spec (gfc_interface_mapping * mapping, gfc_add_block_to_block (&se->post, &tmpse.post); lower = fold_convert (gfc_array_index_type, tmpse.expr); - if (se->loop->codimen == 0 - || n < se->loop->dimen + se->loop->codimen - 1) - { - /* ...and the upper bound. */ - gfc_init_se (&tmpse, NULL); - gfc_apply_interface_mapping (mapping, &tmpse, as->upper[dim]); - gfc_add_block_to_block (&se->pre, &tmpse.pre); - gfc_add_block_to_block (&se->post, &tmpse.post); - upper = fold_convert (gfc_array_index_type, tmpse.expr); - - /* Set the upper bound of the loop to UPPER - LOWER. */ - tmp = fold_build2_loc (input_location, MINUS_EXPR, - gfc_array_index_type, upper, lower); - tmp = gfc_evaluate_now (tmp, &se->pre); - se->loop->to[n] = tmp; - } + /* ...and the upper bound. */ + gfc_init_se (&tmpse, NULL); + gfc_apply_interface_mapping (mapping, &tmpse, as->upper[dim]); + gfc_add_block_to_block (&se->pre, &tmpse.pre); + gfc_add_block_to_block (&se->post, &tmpse.post); + upper = fold_convert (gfc_array_index_type, tmpse.expr); + + /* Set the upper bound of the loop to UPPER - LOWER. */ + tmp = fold_build2_loc (input_location, MINUS_EXPR, + gfc_array_index_type, upper, lower); + tmp = gfc_evaluate_now (tmp, &se->pre); + se->loop->to[n] = tmp; } } } @@ -977,13 +972,6 @@ gfc_trans_create_temp_array (stmtblock_t * pre, stmtblock_t * post, size, tmp); size = gfc_evaluate_now (size, pre); } - for (n = info->dimen; n < info->dimen + info->codimen; n++) - { - gfc_conv_descriptor_lbound_set (pre, desc, gfc_rank_cst[n], - gfc_index_zero_node); - if (n < info->dimen + info->codimen - 1) - gfc_conv_descriptor_ubound_set (pre, desc, gfc_rank_cst[n], loop->to[n]); - } /* Get the size of the array. */ @@ -1470,8 +1458,8 @@ gfc_trans_array_constructor_value (stmtblock_t * pblock, tree type, size = TREE_INT_CST_LOW (TYPE_SIZE_UNIT (type)); bound = build_int_cst (size_type_node, n * size); tmp = build_call_expr_loc (input_location, - built_in_decls[BUILT_IN_MEMCPY], 3, - tmp, init, bound); + builtin_decl_explicit (BUILT_IN_MEMCPY), + 3, tmp, init, bound); gfc_add_expr_to_block (&body, tmp); *poffset = fold_build2_loc (input_location, PLUS_EXPR, @@ -1876,13 +1864,12 @@ gfc_trans_constant_array_constructor (gfc_loopinfo * loop, info->data = gfc_build_addr_expr (NULL_TREE, tmp); info->offset = gfc_index_zero_node; - for (i = 0; i < info->dimen + info->codimen; i++) + for (i = 0; i < info->dimen; i++) { info->delta[i] = gfc_index_zero_node; info->start[i] = gfc_index_zero_node; info->end[i] = gfc_index_zero_node; info->stride[i] = gfc_index_one_node; - info->dim[i] = i; } if (info->dimen > loop->temp_dim) @@ -1961,7 +1948,7 @@ gfc_trans_array_constructor (gfc_loopinfo * loop, gfc_ss * ss, locus * where) first_len = true; } - ss->data.info.dimen = loop->dimen; + gcc_assert (ss->data.info.dimen == loop->dimen); c = ss->expr->value.constructor; if (ss->expr->ts.type == BT_CHARACTER) @@ -2117,7 +2104,7 @@ gfc_set_vector_loop_bounds (gfc_loopinfo * loop, gfc_ss_info * info) int n; int dim; - for (n = 0; n < loop->dimen + loop->codimen; n++) + for (n = 0; n < loop->dimen; n++) { dim = info->dim[n]; if (info->ref->u.ar.dimen_type[dim] == DIMEN_VECTOR @@ -2622,6 +2609,18 @@ gfc_conv_array_index_offset (gfc_se * se, gfc_ss_info * info, int dim, int i, /* Temporary array or derived type component. */ gcc_assert (se->loop); index = se->loop->loopvar[se->loop->order[i]]; + + /* Pointer functions can have stride[0] different from unity. + Use the stride returned by the function call and stored in + the descriptor for the temporary. */ + if (se->ss && se->ss->type == GFC_SS_FUNCTION + && se->ss->expr + && se->ss->expr->symtree + && se->ss->expr->symtree->n.sym->result + && se->ss->expr->symtree->n.sym->result->attr.pointer) + stride = gfc_conv_descriptor_stride_get (info->descriptor, + gfc_rank_cst[dim]); + if (!integer_zerop (info->delta[dim])) index = fold_build2_loc (input_location, PLUS_EXPR, gfc_array_index_type, index, info->delta[dim]); @@ -2843,6 +2842,7 @@ gfc_trans_preloop_setup (gfc_loopinfo * loop, int dim, int flag, gfc_ss_info *info; gfc_ss *ss; gfc_se se; + gfc_array_ref *ar; int i; /* This code will be executed before entering the scalarization loop @@ -2862,16 +2862,38 @@ gfc_trans_preloop_setup (gfc_loopinfo * loop, int dim, int flag, if (dim >= info->dimen) continue; + if (info->ref) + ar = &info->ref->u.ar; + else + ar = NULL; + + i = dim + 1; + + /* For the time being, there is no loop reordering. */ + gcc_assert (i == loop->order[i]); + i = loop->order[i]; + if (dim == info->dimen - 1) { + i = loop->order[0]; + /* For the time being, the innermost loop is unconditionally on + the first dimension of the scalarization loop. */ + gcc_assert (i == 0); + stride = gfc_conv_array_stride (info->descriptor, info->dim[i]); + + /* Calculate the stride of the innermost loop. Hopefully this will + allow the backend optimizers to do their stuff more effectively. + */ + info->stride0 = gfc_evaluate_now (stride, pblock); + /* For the outermost loop calculate the offset due to any elemental dimensions. It will have been initialized with the base offset of the array. */ if (info->ref) { - for (i = 0; i < info->ref->u.ar.dimen; i++) + for (i = 0; i < ar->dimen; i++) { - if (info->ref->u.ar.dimen_type[i] != DIMEN_ELEMENT) + if (ar->dimen_type[i] != DIMEN_ELEMENT) continue; gfc_init_se (&se, NULL); @@ -2879,8 +2901,7 @@ gfc_trans_preloop_setup (gfc_loopinfo * loop, int dim, int flag, se.expr = info->descriptor; stride = gfc_conv_array_stride (info->descriptor, i); index = gfc_conv_array_index_offset (&se, info, i, -1, - &info->ref->u.ar, - stride); + ar, stride); gfc_add_block_to_block (pblock, &se.pre); info->offset = fold_build2_loc (input_location, PLUS_EXPR, @@ -2889,34 +2910,10 @@ gfc_trans_preloop_setup (gfc_loopinfo * loop, int dim, int flag, info->offset = gfc_evaluate_now (info->offset, pblock); } } - - i = loop->order[0]; - /* For the time being, the innermost loop is unconditionally on - the first dimension of the scalarization loop. */ - gcc_assert (i == 0); - stride = gfc_conv_array_stride (info->descriptor, info->dim[i]); - - /* Calculate the stride of the innermost loop. Hopefully this will - allow the backend optimizers to do their stuff more effectively. - */ - info->stride0 = gfc_evaluate_now (stride, pblock); } else { /* Add the offset for the previous loop dimension. */ - gfc_array_ref *ar; - - if (info->ref) - { - ar = &info->ref->u.ar; - i = loop->order[dim + 1]; - } - else - { - ar = NULL; - i = dim + 1; - } - gfc_init_se (&se, NULL); se.loop = loop; se.expr = info->descriptor; @@ -2949,7 +2946,7 @@ gfc_start_scalarized_body (gfc_loopinfo * loop, stmtblock_t * pbody) gcc_assert (!loop->array_parameter); - for (dim = loop->dimen + loop->codimen - 1; dim >= 0; dim--) + for (dim = loop->dimen - 1; dim >= 0; dim--) { n = loop->order[dim]; @@ -3103,7 +3100,7 @@ gfc_trans_scalarizing_loops (gfc_loopinfo * loop, stmtblock_t * body) pblock = body; /* Generate the loops. */ - for (dim = 0; dim < loop->dimen + loop->codimen; dim++) + for (dim = 0; dim < loop->dimen; dim++) { n = loop->order[dim]; gfc_trans_scalarized_loop_end (loop, n, pblock); @@ -3176,82 +3173,83 @@ gfc_trans_scalarized_loop_boundary (gfc_loopinfo * loop, stmtblock_t * body) } +/* Precalculate (either lower or upper) bound of an array section. + BLOCK: Block in which the (pre)calculation code will go. + BOUNDS[DIM]: Where the bound value will be stored once evaluated. + VALUES[DIM]: Specified bound (NULL <=> unspecified). + DESC: Array descriptor from which the bound will be picked if unspecified + (either lower or upper bound according to LBOUND). */ + +static void +evaluate_bound (stmtblock_t *block, tree *bounds, gfc_expr ** values, + tree desc, int dim, bool lbound) +{ + gfc_se se; + gfc_expr * input_val = values[dim]; + tree *output = &bounds[dim]; + + + if (input_val) + { + /* Specified section bound. */ + gfc_init_se (&se, NULL); + gfc_conv_expr_type (&se, input_val, gfc_array_index_type); + gfc_add_block_to_block (block, &se.pre); + *output = se.expr; + } + else + { + /* No specific bound specified so use the bound of the array. */ + *output = lbound ? gfc_conv_array_lbound (desc, dim) : + gfc_conv_array_ubound (desc, dim); + } + *output = gfc_evaluate_now (*output, block); +} + + /* Calculate the lower bound of an array section. */ static void -gfc_conv_section_startstride (gfc_loopinfo * loop, gfc_ss * ss, int dim, - bool coarray, bool coarray_last) +gfc_conv_section_startstride (gfc_loopinfo * loop, gfc_ss * ss, int dim) { - gfc_expr *start; - gfc_expr *end; gfc_expr *stride = NULL; tree desc; gfc_se se; gfc_ss_info *info; + gfc_array_ref *ar; gcc_assert (ss->type == GFC_SS_SECTION); info = &ss->data.info; + ar = &info->ref->u.ar; - if (info->ref->u.ar.dimen_type[dim] == DIMEN_VECTOR) + if (ar->dimen_type[dim] == DIMEN_VECTOR) { /* We use a zero-based index to access the vector. */ info->start[dim] = gfc_index_zero_node; info->end[dim] = NULL; - if (!coarray) - info->stride[dim] = gfc_index_one_node; + info->stride[dim] = gfc_index_one_node; return; } - gcc_assert (info->ref->u.ar.dimen_type[dim] == DIMEN_RANGE); + gcc_assert (ar->dimen_type[dim] == DIMEN_RANGE + || ar->dimen_type[dim] == DIMEN_THIS_IMAGE); desc = info->descriptor; - start = info->ref->u.ar.start[dim]; - end = info->ref->u.ar.end[dim]; - if (!coarray) - stride = info->ref->u.ar.stride[dim]; + stride = ar->stride[dim]; /* Calculate the start of the range. For vector subscripts this will be the range of the vector. */ - if (start) - { - /* Specified section start. */ - gfc_init_se (&se, NULL); - gfc_conv_expr_type (&se, start, gfc_array_index_type); - gfc_add_block_to_block (&loop->pre, &se.pre); - info->start[dim] = se.expr; - } - else - { - /* No lower bound specified so use the bound of the array. */ - info->start[dim] = gfc_conv_array_lbound (desc, dim); - } - info->start[dim] = gfc_evaluate_now (info->start[dim], &loop->pre); + evaluate_bound (&loop->pre, info->start, ar->start, desc, dim, true); /* Similarly calculate the end. Although this is not used in the scalarizer, it is needed when checking bounds and where the end is an expression with side-effects. */ - if (!coarray_last) - { - if (end) - { - /* Specified section start. */ - gfc_init_se (&se, NULL); - gfc_conv_expr_type (&se, end, gfc_array_index_type); - gfc_add_block_to_block (&loop->pre, &se.pre); - info->end[dim] = se.expr; - } - else - { - /* No upper bound specified so use the bound of the array. */ - info->end[dim] = gfc_conv_array_ubound (desc, dim); - } - info->end[dim] = gfc_evaluate_now (info->end[dim], &loop->pre); - } + evaluate_bound (&loop->pre, info->end, ar->end, desc, dim, false); /* Calculate the stride. */ - if (!coarray && stride == NULL) + if (stride == NULL) info->stride[dim] = gfc_index_one_node; - else if (!coarray) + else { gfc_init_se (&se, NULL); gfc_conv_expr_type (&se, stride, gfc_array_index_type); @@ -3275,8 +3273,7 @@ gfc_conv_ss_startstride (gfc_loopinfo * loop) loop->dimen = 0; /* Determine the rank of the loop. */ - for (ss = loop->ss; - ss != gfc_ss_terminator && loop->dimen == 0; ss = ss->loop_chain) + for (ss = loop->ss; ss != gfc_ss_terminator; ss = ss->loop_chain) { switch (ss->type) { @@ -3285,8 +3282,7 @@ gfc_conv_ss_startstride (gfc_loopinfo * loop) case GFC_SS_FUNCTION: case GFC_SS_COMPONENT: loop->dimen = ss->data.info.dimen; - loop->codimen = ss->data.info.codimen; - break; + goto done; /* As usual, lbound and ubound are exceptions!. */ case GFC_SS_INTRINSIC: @@ -3294,16 +3290,11 @@ gfc_conv_ss_startstride (gfc_loopinfo * loop) { case GFC_ISYM_LBOUND: case GFC_ISYM_UBOUND: - loop->dimen = ss->data.info.dimen; - loop->codimen = 0; - break; - case GFC_ISYM_LCOBOUND: case GFC_ISYM_UCOBOUND: case GFC_ISYM_THIS_IMAGE: loop->dimen = ss->data.info.dimen; - loop->codimen = ss->data.info.codimen; - break; + goto done; default: break; @@ -3316,8 +3307,9 @@ gfc_conv_ss_startstride (gfc_loopinfo * loop) /* We should have determined the rank of the expression by now. If not, that's bad news. */ - gcc_assert (loop->dimen + loop->codimen != 0); + gcc_unreachable (); +done: /* Loop over all the SS in the chain. */ for (ss = loop->ss; ss != gfc_ss_terminator; ss = ss->loop_chain) { @@ -3331,14 +3323,7 @@ gfc_conv_ss_startstride (gfc_loopinfo * loop) gfc_conv_ss_descriptor (&loop->pre, ss, !loop->array_parameter); for (n = 0; n < ss->data.info.dimen; n++) - gfc_conv_section_startstride (loop, ss, ss->data.info.dim[n], - false, false); - for (n = ss->data.info.dimen; - n < ss->data.info.dimen + ss->data.info.codimen; n++) - gfc_conv_section_startstride (loop, ss, ss->data.info.dim[n], true, - n == ss->data.info.dimen - + ss->data.info.codimen -1); - + gfc_conv_section_startstride (loop, ss, ss->data.info.dim[n]); break; case GFC_SS_INTRINSIC: @@ -3857,7 +3842,6 @@ temporary: base_type = gfc_get_element_type (base_type); loop->temp_ss = gfc_get_temp_ss (base_type, dest->string_length, loop->dimen); - loop->temp_ss->data.temp.codimen = loop->codimen; gfc_add_ss_to_loop (loop, loop->temp_ss); } else @@ -3885,7 +3869,7 @@ gfc_conv_loop_setup (gfc_loopinfo * loop, locus * where) mpz_t i; mpz_init (i); - for (n = 0; n < loop->dimen + loop->codimen; n++) + for (n = 0; n < loop->dimen; n++) { loopspec[n] = NULL; dynamic[n] = false; @@ -3994,7 +3978,7 @@ gfc_conv_loop_setup (gfc_loopinfo * loop, locus * where) /* Set the extents of this range. */ cshape = loopspec[n]->shape; - if (n < loop->dimen && cshape && INTEGER_CST_P (info->start[dim]) + if (cshape && INTEGER_CST_P (info->start[dim]) && INTEGER_CST_P (info->stride[dim])) { loop->from[n] = info->start[dim]; @@ -5915,8 +5899,7 @@ gfc_conv_expr_descriptor (gfc_se * se, gfc_expr * expr, gfc_ss * ss) loop.dimen); se->string_length = loop.temp_ss->string_length; - loop.temp_ss->data.temp.dimen = loop.dimen; - loop.temp_ss->data.temp.codimen = loop.codimen; + gcc_assert (loop.temp_ss->data.temp.dimen == loop.dimen); gfc_add_ss_to_loop (&loop, loop.temp_ss); } @@ -5989,6 +5972,35 @@ gfc_conv_expr_descriptor (gfc_se * se, gfc_expr * expr, gfc_ss * ss) tree to; tree base; + ndim = info->ref ? info->ref->u.ar.dimen : info->dimen; + + if (se->want_coarray) + { + gfc_array_ref *ar = &info->ref->u.ar; + + codim = gfc_get_corank (expr); + for (n = 0; n < codim - 1; n++) + { + /* Make sure we are not lost somehow. */ + gcc_assert (ar->dimen_type[n + ndim] == DIMEN_THIS_IMAGE); + + /* Make sure the call to gfc_conv_section_startstride won't + generate unnecessary code to calculate stride. */ + gcc_assert (ar->stride[n + ndim] == NULL); + + gfc_conv_section_startstride (&loop, ss, n + ndim); + loop.from[n + loop.dimen] = info->start[n + ndim]; + loop.to[n + loop.dimen] = info->end[n + ndim]; + } + + gcc_assert (n == codim - 1); + evaluate_bound (&loop.pre, info->start, ar->start, + info->descriptor, n + ndim, true); + loop.from[n + loop.dimen] = info->start[n + ndim]; + } + else + codim = 0; + /* Set the string_length for a character array. */ if (expr->ts.type == BT_CHARACTER) se->string_length = gfc_get_expr_charlen (expr); @@ -6004,9 +6016,8 @@ gfc_conv_expr_descriptor (gfc_se * se, gfc_expr * expr, gfc_ss * ss) { /* Otherwise make a new one. */ parmtype = gfc_get_element_type (TREE_TYPE (desc)); - parmtype = gfc_get_array_type_bounds (parmtype, loop.dimen, - loop.codimen, loop.from, - loop.to, 0, + parmtype = gfc_get_array_type_bounds (parmtype, loop.dimen, codim, + loop.from, loop.to, 0, GFC_ARRAY_UNKNOWN, false); parm = gfc_create_var (parmtype, "parm"); } @@ -6036,8 +6047,6 @@ gfc_conv_expr_descriptor (gfc_se * se, gfc_expr * expr, gfc_ss * ss) else base = NULL_TREE; - ndim = info->ref ? info->ref->u.ar.dimen : info->dimen; - codim = info->codimen; for (n = 0; n < ndim; n++) { stride = gfc_conv_array_stride (desc, n); @@ -6139,24 +6148,15 @@ gfc_conv_expr_descriptor (gfc_se * se, gfc_expr * expr, gfc_ss * ss) gfc_rank_cst[dim], stride); } - for (n = ndim; n < ndim + codim; n++) + for (n = loop.dimen; n < loop.dimen + codim; n++) { - /* look for the corresponding scalarizer dimension: dim. */ - for (dim = 0; dim < ndim + codim; dim++) - if (info->dim[dim] == n) - break; - - /* loop exited early: the DIM being looked for has been found. */ - gcc_assert (dim < ndim + codim); - - from = loop.from[dim]; - to = loop.to[dim]; + from = loop.from[n]; + to = loop.to[n]; gfc_conv_descriptor_lbound_set (&loop.pre, parm, - gfc_rank_cst[dim], from); - if (n < ndim + codim - 1) + gfc_rank_cst[n], from); + if (n < loop.dimen + codim - 1) gfc_conv_descriptor_ubound_set (&loop.pre, parm, - gfc_rank_cst[dim], to); - dim++; + gfc_rank_cst[n], to); } if (se->data_not_needed) @@ -6633,7 +6633,7 @@ duplicate_allocatable (tree dest, tree src, tree type, int rank, gfc_add_expr_to_block (&block, tmp); } - tmp = built_in_decls[BUILT_IN_MEMCPY]; + tmp = builtin_decl_explicit (BUILT_IN_MEMCPY); tmp = build_call_expr_loc (input_location, tmp, 3, dest, src, size); } @@ -6657,7 +6657,7 @@ duplicate_allocatable (tree dest, tree src, tree type, int rank, /* We know the temporary and the value will be the same length, so can use memcpy. */ - tmp = built_in_decls[BUILT_IN_MEMCPY]; + tmp = builtin_decl_explicit (BUILT_IN_MEMCPY); tmp = build_call_expr_loc (input_location, tmp, 3, gfc_conv_descriptor_data_get (dest), gfc_conv_descriptor_data_get (src), size); @@ -7413,7 +7413,7 @@ gfc_alloc_allocatable_for_assignment (gfc_loopinfo *loop, in the array reference - (*desc.data)[]. */ gfc_init_block (&realloc_block); tmp = build_call_expr_loc (input_location, - built_in_decls[BUILT_IN_REALLOC], 2, + builtin_decl_explicit (BUILT_IN_REALLOC), 2, fold_convert (pvoid_type_node, array1), size2); gfc_conv_descriptor_data_set (&realloc_block, @@ -7429,8 +7429,8 @@ gfc_alloc_allocatable_for_assignment (gfc_loopinfo *loop, /* Malloc expression. */ gfc_init_block (&alloc_block); tmp = build_call_expr_loc (input_location, - built_in_decls[BUILT_IN_MALLOC], 1, - size2); + builtin_decl_explicit (BUILT_IN_MALLOC), + 1, size2); gfc_conv_descriptor_data_set (&alloc_block, desc, tmp); tmp = gfc_conv_descriptor_dtype (desc); @@ -7601,14 +7601,22 @@ static gfc_ss * gfc_walk_variable_expr (gfc_ss * ss, gfc_expr * expr) { gfc_ref *ref; - gfc_array_ref *ar; - gfc_ss *newss; - int n; for (ref = expr->ref; ref; ref = ref->next) if (ref->type == REF_ARRAY && ref->u.ar.type != AR_ELEMENT) break; + return gfc_walk_array_ref (ss, expr, ref); +} + + +gfc_ss * +gfc_walk_array_ref (gfc_ss * ss, gfc_expr * expr, gfc_ref * ref) +{ + gfc_array_ref *ar; + gfc_ss *newss; + int n; + for (; ref; ref = ref->next) { if (ref->type == REF_SUBSTRING) @@ -7623,12 +7631,6 @@ gfc_walk_variable_expr (gfc_ss * ss, gfc_expr * expr) ar = &ref->u.ar; - if (ar->as->rank == 0 && ref->next != NULL) - { - /* Scalar coarray. */ - continue; - } - switch (ar->type) { case AR_ELEMENT: @@ -7643,7 +7645,6 @@ gfc_walk_variable_expr (gfc_ss * ss, gfc_expr * expr) /* Make sure array is the same as array(:,:), this way we don't need to special case all the time. */ ar->dimen = ar->as->rank; - ar->codimen = 0; for (n = 0; n < ar->dimen; n++) { ar->dimen_type[n] = DIMEN_RANGE; @@ -7652,14 +7653,6 @@ gfc_walk_variable_expr (gfc_ss * ss, gfc_expr * expr) gcc_assert (ar->end[n] == NULL); gcc_assert (ar->stride[n] == NULL); } - for (n = ar->dimen; n < ar->dimen + ar->as->corank; n++) - { - newss->data.info.dim[n] = n; - ar->dimen_type[n] = DIMEN_RANGE; - - gcc_assert (ar->start[n] == NULL); - gcc_assert (ar->end[n] == NULL); - } ss = newss; break; @@ -7668,14 +7661,12 @@ gfc_walk_variable_expr (gfc_ss * ss, gfc_expr * expr) newss->data.info.ref = ref; /* We add SS chains for all the subscripts in the section. */ - for (n = 0; n < ar->dimen + ar->codimen; n++) + for (n = 0; n < ar->dimen; n++) { gfc_ss *indexss; switch (ar->dimen_type[n]) { - case DIMEN_THIS_IMAGE: - continue; case DIMEN_ELEMENT: /* Add SS for elemental (scalar) subscripts. */ gcc_assert (ar->start[n]); @@ -7687,10 +7678,8 @@ gfc_walk_variable_expr (gfc_ss * ss, gfc_expr * expr) case DIMEN_RANGE: /* We don't add anything for sections, just remember this dimension for later. */ - newss->data.info.dim[newss->data.info.dimen - + newss->data.info.codimen] = n; - if (n < ar->dimen) - newss->data.info.dimen++; + newss->data.info.dim[newss->data.info.dimen] = n; + newss->data.info.dimen++; break; case DIMEN_VECTOR: @@ -7700,10 +7689,8 @@ gfc_walk_variable_expr (gfc_ss * ss, gfc_expr * expr) 1, GFC_SS_VECTOR); indexss->loop_chain = gfc_ss_terminator; newss->data.info.subscript[n] = indexss; - newss->data.info.dim[newss->data.info.dimen - + newss->data.info.codimen] = n; - if (n < ar->dimen) - newss->data.info.dimen++; + newss->data.info.dim[newss->data.info.dimen] = n; + newss->data.info.dimen++; break; default: @@ -7711,8 +7698,10 @@ gfc_walk_variable_expr (gfc_ss * ss, gfc_expr * expr) gcc_unreachable (); } } - /* We should have at least one non-elemental dimension. */ - gcc_assert (newss->data.info.dimen > 0); + /* We should have at least one non-elemental dimension, + unless we are creating a descriptor for a (scalar) coarray. */ + gcc_assert (newss->data.info.dimen > 0 + || newss->data.info.ref->u.ar.as->corank > 0); ss = newss; break;