https://gcc.gnu.org/g:dfad133d796570b7d0b27e83f111fdabf4c92bc0
commit dfad133d796570b7d0b27e83f111fdabf4c92bc0 Author: Mikael Morin <[email protected]> Date: Mon Jun 22 16:53:30 2026 +0200 Introductio signed_char_type_node et dim_iter_type_node Correction type rang Revert "Revert partiel type rang" This reverts commit e0b074f9fbd249e6367146e1313f2f9d963ad80a. Suppression déclaration gfc_conv_descriptor_rank Revert "Remise déclaration gfc_conv_descriptor_rank" This reverts commit 5ce7d5bb0d646b8b70f2e639f1320d1c7835ba45. Revert "Export gfc_conv_descriptor_rank" This reverts commit 2b58bb9d3207f1dad1e5abf1b1802a2ded65888f. Sauvegarde openacc.f90 compil' OK Correction régression CFI section-1.f90 Correction régressions coarray Correction régression initialization-1.f90 Sauvegarde Sauvegarde Diff: --- gcc/fortran/trans-array.cc | 30 ++++++++------ gcc/fortran/trans-const.cc | 7 +++- gcc/fortran/trans-const.h | 5 ++- gcc/fortran/trans-decl.cc | 28 +++++++------- gcc/fortran/trans-descriptor.cc | 2 +- gcc/fortran/trans-expr.cc | 19 +++++---- gcc/fortran/trans-intrinsic.cc | 86 ++++++++++++++++++++++++++--------------- gcc/fortran/trans-openmp.cc | 11 +++--- gcc/fortran/trans-types.cc | 9 ++++- gcc/fortran/trans-types.h | 3 ++ 10 files changed, 125 insertions(+), 75 deletions(-) diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc index d1153f5565cf..3447ced7f2d8 100644 --- a/gcc/fortran/trans-array.cc +++ b/gcc/fortran/trans-array.cc @@ -8677,15 +8677,15 @@ gfc_tree_array_size (stmtblock_t *block, tree desc, gfc_expr *expr, tree dim) gcc_assert (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (desc))); enum gfc_array_kind akind = GFC_TYPE_ARRAY_AKIND (TREE_TYPE (desc)); if (expr == NULL || expr->rank < 0) - rank = fold_convert (signed_char_type_node, + rank = fold_convert (gfc_array_dim_rank_type, gfc_conv_descriptor_rank (desc)); else - rank = build_int_cst (signed_char_type_node, expr->rank); + rank = build_int_cst (gfc_array_dim_rank_type, expr->rank); if (dim || (expr && expr->rank == 1)) { if (!dim) - dim = gfc_index_zero_node; + dim = gfc_rank_cst[0]; tree ubound = gfc_conv_descriptor_ubound_get (desc, dim); tree lbound = gfc_conv_descriptor_lbound_get (desc, dim); @@ -8702,8 +8702,11 @@ gfc_tree_array_size (stmtblock_t *block, tree desc, gfc_expr *expr, tree dim) if (akind == GFC_ARRAY_ASSUMED_RANK_CONT || akind == GFC_ARRAY_ASSUMED_RANK) { - tmp = fold_build2_loc (input_location, MINUS_EXPR, signed_char_type_node, - rank, build_int_cst (signed_char_type_node, 1)); + tmp = fold_build2_loc (input_location, MINUS_EXPR, + signed_char_type_node, + fold_convert_loc (input_location, + signed_char_type_node, rank), + build_one_cst (signed_char_type_node)); cond = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node, fold_convert (signed_char_type_node, dim), tmp); @@ -8729,7 +8732,7 @@ gfc_tree_array_size (stmtblock_t *block, tree desc, gfc_expr *expr, tree dim) gfc_init_block (&loop_body); /* Loop: for (i = 0; i < rank; ++i). */ - tree idx = gfc_create_var (signed_char_type_node, "idx"); + tree idx = gfc_create_var (gfc_array_dim_rank_type, "idx"); /* Loop body. */ /* #if (assumed-rank + !allocatable && !pointer) if (idx == rank - 1 && dim[idx].ubound == -1) @@ -8743,10 +8746,15 @@ gfc_tree_array_size (stmtblock_t *block, tree desc, gfc_expr *expr, tree dim) cond = NULL_TREE; if (akind == GFC_ARRAY_ASSUMED_RANK_CONT || akind == GFC_ARRAY_ASSUMED_RANK) { - tmp = fold_build2_loc (input_location, MINUS_EXPR, signed_char_type_node, - rank, build_int_cst (signed_char_type_node, 1)); + tmp = fold_build2_loc (input_location, MINUS_EXPR, + signed_char_type_node, + fold_convert_loc (input_location, + signed_char_type_node, rank), + build_one_cst (signed_char_type_node)); cond = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node, - idx, tmp); + fold_convert_loc (input_location, + signed_char_type_node, idx), + tmp); tmp = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node, gfc_conv_descriptor_ubound_get (desc, idx), build_int_cst (gfc_array_index_type, -1)); @@ -9275,9 +9283,7 @@ gfc_conv_array_parameter (gfc_se *se, gfc_expr *expr, bool g77, if (expr->rank == -1) { - tree idx = gfc_create_var (TREE_TYPE (gfc_conv_descriptor_rank - (old_desc)), - "idx"); + tree idx = gfc_create_var (gfc_array_dim_rank_type, "idx"); tree stride = gfc_create_var (gfc_array_index_type, "stride"); stmtblock_t loop_body; diff --git a/gcc/fortran/trans-const.cc b/gcc/fortran/trans-const.cc index e21bcf68c0ce..418489213152 100644 --- a/gcc/fortran/trans-const.cc +++ b/gcc/fortran/trans-const.cc @@ -35,6 +35,8 @@ along with GCC; see the file COPYING3. If not see #include "target-memory.h" tree gfc_rank_cst[GFC_MAX_DIMENSIONS + 1]; +tree gfc_index_zero_node; +tree gfc_index_one_node; /* Build a constant with given type from an int_cst. */ @@ -194,7 +196,10 @@ gfc_init_constants (void) int n; for (n = 0; n <= GFC_MAX_DIMENSIONS; n++) - gfc_rank_cst[n] = build_int_cst (gfc_array_index_type, n); + gfc_rank_cst[n] = build_int_cst (gfc_array_dim_rank_type, n); + + gfc_index_zero_node = build_zero_cst (gfc_array_index_type); + gfc_index_one_node = build_one_cst (gfc_array_index_type); } /* Converts a GMP integer into a backend tree node. */ diff --git a/gcc/fortran/trans-const.h b/gcc/fortran/trans-const.h index eb268cced40a..abd7d7694518 100644 --- a/gcc/fortran/trans-const.h +++ b/gcc/fortran/trans-const.h @@ -65,5 +65,6 @@ tree gfc_build_const (tree, tree); /* Integer constants 0..GFC_MAX_DIMENSIONS. */ extern GTY(()) tree gfc_rank_cst[GFC_MAX_DIMENSIONS + 1]; -#define gfc_index_zero_node gfc_rank_cst[0] -#define gfc_index_one_node gfc_rank_cst[1] +/* Integer constants 0 and 1, of array index type. */ +extern GTY(()) tree gfc_index_zero_node; +extern GTY(()) tree gfc_index_one_node; diff --git a/gcc/fortran/trans-decl.cc b/gcc/fortran/trans-decl.cc index eb957472920e..fd9e9570eeb0 100644 --- a/gcc/fortran/trans-decl.cc +++ b/gcc/fortran/trans-decl.cc @@ -7357,7 +7357,7 @@ gfc_conv_cfi_to_gfc (stmtblock_t *init, stmtblock_t *finally, tmp3 = tmp2 = tmp = gfc_get_cfi_desc_rank (cfi); if (sym->as->rank != -1) tmp = fold_build2_loc (input_location, NE_EXPR, boolean_type_node, - tmp, build_int_cst (signed_char_type_node, + tmp, build_int_cst (TREE_TYPE (tmp), sym->as->rank)); else { @@ -7602,14 +7602,16 @@ gfc_conv_cfi_to_gfc (stmtblock_t *init, stmtblock_t *finally, if (sym->as->rank < 0) { /* Set gfc->dtype.rank, if assumed-rank. */ - rank = gfc_get_cfi_desc_rank (cfi); + rank = fold_convert_loc (input_location, gfc_array_dim_rank_type, + gfc_get_cfi_desc_rank (cfi)); gfc_add_modify (&block, gfc_conv_descriptor_rank (gfc_desc), rank); } else if (!GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (gfc_desc))) /* In that case, the CFI rank and the declared rank can differ. */ - rank = gfc_get_cfi_desc_rank (cfi); + rank = fold_convert_loc (input_location, gfc_array_dim_rank_type, + gfc_get_cfi_desc_rank (cfi)); else - rank = build_int_cst (signed_char_type_node, sym->as->rank); + rank = build_int_cst (gfc_array_dim_rank_type, sym->as->rank); /* With bind(C), the standard requires that both Fortran callers and callees handle noncontiguous arrays passed to an dummy with 'contiguous' attribute @@ -7656,7 +7658,7 @@ gfc_conv_cfi_to_gfc (stmtblock_t *init, stmtblock_t *finally, /* for (i = 1; i < rank; ++i) cond &&= dim[i].sm != (dv->dim[i - 1].sm * dv->dim[i - 1].extent) */ - idx = gfc_create_var (TREE_TYPE (rank), "idx"); + idx = gfc_create_var (gfc_array_dim_rank_type, "idx"); stmtblock_t loop_body; gfc_init_block (&loop_body); tmp = fold_build2_loc (input_location, MINUS_EXPR, TREE_TYPE (idx), @@ -7706,7 +7708,7 @@ gfc_conv_cfi_to_gfc (stmtblock_t *init, stmtblock_t *finally, { shift = 0; tmpidx = idx - for (dim = 0; dim < rank; ++dim) + for (d = 0; d < rank; ++d) { shift += (tmpidx % extent[d]) * sm[d] tmpidx = tmpidx / extend[d] @@ -7721,7 +7723,7 @@ gfc_conv_cfi_to_gfc (stmtblock_t *init, stmtblock_t *finally, gfc_add_modify (&loop_body, tmpidx, idx); stmtblock_t inner_loop; gfc_init_block (&inner_loop); - tree dim = gfc_create_var (TREE_TYPE (rank), "dim"); + tree dim = gfc_create_var (gfc_array_dim_rank_type, "dim"); /* shift += (tmpidx % extent[d]) * sm[d] */ tmp = fold_build2_loc (input_location, TRUNC_MOD_EXPR, size_type_node, tmpidx, @@ -7739,7 +7741,7 @@ gfc_conv_cfi_to_gfc (stmtblock_t *init, stmtblock_t *finally, gfc_add_modify (&inner_loop, tmpidx, fold_build2_loc (input_location, TRUNC_DIV_EXPR, size_type_node, tmpidx, tmp)); - gfc_simple_for_loop (&loop_body, dim, build_zero_cst (TREE_TYPE (rank)), + gfc_simple_for_loop (&loop_body, dim, build_zero_cst (TREE_TYPE (dim)), rank, LT_EXPR, build_int_cst (TREE_TYPE (dim), 1), gfc_finish_block (&inner_loop)); /* Assign. */ @@ -7824,7 +7826,7 @@ gfc_conv_cfi_to_gfc (stmtblock_t *init, stmtblock_t *finally, } /* Loop: for (i = 0; i < rank; ++i). */ - idx = gfc_create_var (TREE_TYPE (rank), "idx"); + idx = gfc_create_var (gfc_array_dim_rank_type, "idx"); /* Loop body. */ stmtblock_t loop_body; @@ -7943,7 +7945,7 @@ done: { shift = 0; tmpidx = idx - for (dim = 0; dim < rank; ++dim) + for (d = 0; d < rank; ++d) { shift += (tmpidx % extent[d]) * sm[d] tmpidx = tmpidx / extend[d] @@ -7960,7 +7962,7 @@ done: gfc_add_modify (&loop_body, tmpidx, idx); stmtblock_t inner_loop; gfc_init_block (&inner_loop); - tree dim = gfc_create_var (TREE_TYPE (rank), "dim"); + tree dim = gfc_create_var (gfc_array_dim_rank_type, "dim"); /* shift += (tmpidx % extent[d]) * sm[d] */ tmp = fold_convert (size_type_node, gfc_get_cfi_dim_extent (cfi, dim)); @@ -7980,7 +7982,7 @@ done: fold_build2_loc (input_location, TRUNC_DIV_EXPR, size_type_node, tmpidx, tmp)); gfc_simple_for_loop (&loop_body, dim, - build_zero_cst (TREE_TYPE (rank)), rank, LT_EXPR, + build_zero_cst (TREE_TYPE (dim)), rank, LT_EXPR, build_int_cst (TREE_TYPE (dim), 1), gfc_finish_block (&inner_loop)); /* Assign. */ @@ -8049,7 +8051,7 @@ done: gfc_init_block (&block2); /* Loop: for (i = 0; i < rank; ++i). */ - idx = gfc_create_var (TREE_TYPE (rank), "idx"); + idx = gfc_create_var (gfc_array_dim_rank_type, "idx"); /* Loop body. */ gfc_init_block (&loop_body); diff --git a/gcc/fortran/trans-descriptor.cc b/gcc/fortran/trans-descriptor.cc index fe2fe0059929..79c6439c08fa 100644 --- a/gcc/fortran/trans-descriptor.cc +++ b/gcc/fortran/trans-descriptor.cc @@ -159,7 +159,7 @@ gfc_conv_descriptor_rank (tree desc) dtype = gfc_conv_descriptor_dtype (desc); tmp = gfc_advance_chain (TYPE_FIELDS (TREE_TYPE (dtype)), GFC_DTYPE_RANK); gcc_assert (tmp != NULL_TREE - && TREE_TYPE (tmp) == signed_char_type_node); + && TREE_TYPE (tmp) == gfc_array_dim_rank_type); return fold_build3_loc (input_location, COMPONENT_REF, TREE_TYPE (tmp), dtype, tmp, NULL_TREE); } diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc index 4027c867c694..6d63af108456 100644 --- a/gcc/fortran/trans-expr.cc +++ b/gcc/fortran/trans-expr.cc @@ -3405,10 +3405,11 @@ gfc_conv_variable (gfc_se * se, gfc_expr * expr) tree dim, lower, upper, cond; char *msg; - dim = fold_convert (signed_char_type_node, + dim = fold_convert (gfc_array_dim_rank_type, gfc_conv_descriptor_rank (se->expr)); - dim = fold_build2_loc (input_location, MINUS_EXPR, signed_char_type_node, - dim, build_int_cst (signed_char_type_node, 1)); + dim = fold_build2_loc (input_location, MINUS_EXPR, + gfc_array_dim_rank_type, dim, + build_one_cst (gfc_array_dim_rank_type)); lower = gfc_conv_descriptor_lbound_get (se->expr, dim); upper = gfc_conv_descriptor_ubound_get (se->expr, dim); @@ -6277,11 +6278,13 @@ gfc_conv_gfc_desc_to_cfi_desc (gfc_se *parmse, gfc_expr *e, gfc_symbol *fsym) gfc_add_modify (&block, tmp, build_int_cst (TREE_TYPE (tmp), CFI_VERSION)); if (e->rank < 0) - rank = fold_convert (signed_char_type_node, gfc_conv_descriptor_rank (gfc)); + rank = fold_convert (gfc_array_dim_rank_type, + gfc_conv_descriptor_rank (gfc)); else - rank = build_int_cst (signed_char_type_node, e->rank); + rank = build_int_cst (gfc_array_dim_rank_type, e->rank); tmp = gfc_get_cfi_desc_rank (cfi); - gfc_add_modify (&block, tmp, rank); + gfc_add_modify (&block, tmp, + fold_convert (TREE_TYPE (tmp), rank)); int itype = CFI_type_other; if (e->ts.f90_type == BT_VOID) itype = (e->ts.u.derived->intmod_sym_id == ISOCBINDING_FUNPTR @@ -6491,7 +6494,7 @@ gfc_conv_gfc_desc_to_cfi_desc (gfc_se *parmse, gfc_expr *e, gfc_symbol *fsym) if (e->rank != 0) { /* Loop: for (i = 0; i < rank; ++i). */ - tree idx = gfc_create_var (TREE_TYPE (rank), "idx"); + tree idx = gfc_create_var (gfc_array_dim_rank_type, "idx"); /* Loop body. */ stmtblock_t loop_body; gfc_init_block (&loop_body); @@ -6600,7 +6603,7 @@ done: /* Calculate offset + set lbound, ubound and stride. */ gfc_conv_descriptor_offset_set (&block2, gfc, gfc_index_zero_node); /* Loop: for (i = 0; i < rank; ++i). */ - tree idx = gfc_create_var (TREE_TYPE (rank), "idx"); + tree idx = gfc_create_var (gfc_array_dim_rank_type, "idx"); /* Loop body. */ stmtblock_t loop_body; gfc_init_block (&loop_body); diff --git a/gcc/fortran/trans-intrinsic.cc b/gcc/fortran/trans-intrinsic.cc index 83f25fe0f96f..98471c442aa6 100644 --- a/gcc/fortran/trans-intrinsic.cc +++ b/gcc/fortran/trans-intrinsic.cc @@ -1878,8 +1878,10 @@ trans_this_image (gfc_se * se, gfc_expr *expr) dim_arg = se->loop->loopvar[0]; dim_arg = fold_build2_loc (input_location, PLUS_EXPR, - gfc_array_index_type, dim_arg, + TREE_TYPE (dim_arg), dim_arg, build_int_cst (TREE_TYPE (dim_arg), 1)); + dim_arg = fold_convert_loc (input_location, gfc_array_dim_rank_type, + dim_arg); gfc_advance_se_ss_chain (se); } else @@ -1888,7 +1890,7 @@ trans_this_image (gfc_se * se, gfc_expr *expr) gcc_assert (expr->value.function.actual->next->expr); gfc_init_se (&argse, NULL); gfc_conv_expr_type (&argse, expr->value.function.actual->next->expr, - gfc_array_index_type); + gfc_array_dim_rank_type); gfc_add_block_to_block (&se->pre, &argse.pre); dim_arg = argse.expr; @@ -1909,7 +1911,9 @@ trans_this_image (gfc_se * se, gfc_expr *expr) build_int_cst (TREE_TYPE (dim_arg), 1)); tmp = gfc_rank_cst[GFC_TYPE_ARRAY_CORANK (TREE_TYPE (desc))]; tmp = fold_build2_loc (input_location, GT_EXPR, logical_type_node, - dim_arg, tmp); + dim_arg, + fold_convert_loc (input_location, + TREE_TYPE (dim_arg), tmp)); cond = fold_build2_loc (input_location, TRUTH_ORIF_EXPR, logical_type_node, cond, tmp); gfc_trans_runtime_check (true, false, cond, &se->pre, &expr->where, @@ -1962,23 +1966,25 @@ trans_this_image (gfc_se * se, gfc_expr *expr) m = gfc_create_var (type, NULL); ml = gfc_create_var (type, NULL); - loop_var = gfc_create_var (integer_type_node, NULL); - min_var = gfc_create_var (integer_type_node, NULL); + loop_var = gfc_create_var (gfc_array_dim_rank_type, NULL); + min_var = gfc_create_var (gfc_array_dim_rank_type, NULL); /* m = this_image () - 1. */ gfc_add_modify (&se->pre, m, tmp); /* min_var = min (rank + corank-2, rank + dim_arg - 1). */ - tmp = fold_build2_loc (input_location, PLUS_EXPR, integer_type_node, - fold_convert (integer_type_node, dim_arg), - build_int_cst (integer_type_node, rank - 1)); - tmp = fold_build2_loc (input_location, MIN_EXPR, integer_type_node, - build_int_cst (integer_type_node, rank + corank - 2), + tmp = fold_build2_loc (input_location, PLUS_EXPR, signed_char_type_node, + fold_convert_loc (input_location, + signed_char_type_node, dim_arg), + build_int_cst (signed_char_type_node, rank - 1)); + tmp = fold_convert_loc (input_location, gfc_array_dim_rank_type, tmp); + tmp = fold_build2_loc (input_location, MIN_EXPR, gfc_array_dim_rank_type, + build_int_cst (gfc_array_dim_rank_type, rank + corank - 2), tmp); gfc_add_modify (&se->pre, min_var, tmp); /* i = rank. */ - tmp = build_int_cst (integer_type_node, rank); + tmp = build_int_cst (TREE_TYPE (loop_var), rank); gfc_add_modify (&se->pre, loop_var, tmp); exit_label = gfc_build_label_decl (NULL_TREE); @@ -2011,9 +2017,9 @@ trans_this_image (gfc_se * se, gfc_expr *expr) /* Increment loop variable: i++. */ gfc_add_modify (&loop, loop_var, - fold_build2_loc (input_location, PLUS_EXPR, integer_type_node, + fold_build2_loc (input_location, PLUS_EXPR, TREE_TYPE (loop_var), loop_var, - integer_one_node)); + build_one_cst (TREE_TYPE (loop_var)))); /* Making the loop... actually loop! */ tmp = gfc_finish_block (&loop); @@ -2032,7 +2038,7 @@ trans_this_image (gfc_se * se, gfc_expr *expr) lbound = gfc_conv_descriptor_lbound_get (desc, fold_build2_loc (input_location, PLUS_EXPR, - gfc_array_index_type, dim_arg, + TREE_TYPE (dim_arg), dim_arg, build_int_cst (TREE_TYPE (dim_arg), rank-1))); lbound = fold_convert (type, lbound); @@ -2436,19 +2442,21 @@ gfc_conv_intrinsic_bound (gfc_se * se, gfc_expr * expr, enum gfc_isym_id op) bound = fold_build2_loc (input_location, MINUS_EXPR, gfc_array_index_type, bound, se->loop->from[0]); + bound = fold_convert_loc (input_location, gfc_array_dim_rank_type, + bound); } else { /* use the passed argument. */ gcc_assert (arg2->expr); gfc_init_se (&argse, NULL); - gfc_conv_expr_type (&argse, arg2->expr, gfc_array_index_type); + gfc_conv_expr_type (&argse, arg2->expr, gfc_array_dim_rank_type); gfc_add_block_to_block (&se->pre, &argse.pre); bound = argse.expr; /* Convert from one based to zero based. */ bound = fold_build2_loc (input_location, MINUS_EXPR, - gfc_array_index_type, bound, - gfc_index_one_node); + gfc_array_dim_rank_type, bound, + gfc_rank_cst[1]); } /* TODO: don't re-evaluate the descriptor on each iteration. */ @@ -2487,7 +2495,9 @@ gfc_conv_intrinsic_bound (gfc_se * se, gfc_expr * expr, enum gfc_isym_id op) else tmp = gfc_rank_cst[GFC_TYPE_ARRAY_RANK (TREE_TYPE (desc))]; tmp = fold_build2_loc (input_location, GE_EXPR, logical_type_node, - bound, fold_convert(TREE_TYPE (bound), tmp)); + bound, + fold_convert_loc (input_location, + TREE_TYPE (bound), tmp)); cond = fold_build2_loc (input_location, TRUTH_ORIF_EXPR, logical_type_node, cond, tmp); gfc_trans_runtime_check (true, false, cond, &se->pre, &expr->where, @@ -2577,10 +2587,11 @@ gfc_conv_intrinsic_bound (gfc_se * se, gfc_expr * expr, enum gfc_isym_id op) if (op != GFC_ISYM_LBOUND && assumed_rank_lb_one) { tree minus_one = build_int_cst (gfc_array_index_type, -1); - tree rank = fold_convert (gfc_array_index_type, + tree rank = fold_convert (gfc_array_dim_rank_type, gfc_conv_descriptor_rank (desc)); - rank = fold_build2_loc (input_location, PLUS_EXPR, - gfc_array_index_type, rank, minus_one); + rank = fold_build2_loc (input_location, MINUS_EXPR, + gfc_array_dim_rank_type, rank, + gfc_rank_cst[1]); /* Fix the expression to stop it from becoming even more complicated. */ @@ -2655,13 +2666,17 @@ conv_intrinsic_cobound (gfc_se * se, gfc_expr * expr) gcc_assert (se->loop->dimen == 1); gcc_assert (se->ss->info->expr == expr); - bound = se->loop->loopvar[0]; - bound = fold_build2_loc (input_location, PLUS_EXPR, gfc_array_index_type, - bound, gfc_rank_cst[arg->expr->rank]); + bound = fold_convert_loc (input_location, gfc_array_dim_rank_type, + se->loop->loopvar[0]); + tree rank = gfc_rank_cst[arg->expr->rank]; + bound = fold_build2_loc (input_location, PLUS_EXPR, + gfc_array_dim_rank_type, bound, + fold_convert_loc (input_location, + TREE_TYPE (bound), rank)); gfc_advance_se_ss_chain (se); } else if (expr->value.function.isym->id == GFC_ISYM_COSHAPE) - bound = gfc_index_zero_node; + bound = gfc_rank_cst[1]; else { gcc_assert (arg2->expr); @@ -2684,9 +2699,11 @@ conv_intrinsic_cobound (gfc_se * se, gfc_expr * expr) bound = gfc_evaluate_now (bound, &se->pre); cond = fold_build2_loc (input_location, LT_EXPR, logical_type_node, bound, build_int_cst (TREE_TYPE (bound), 1)); - tmp = gfc_rank_cst[GFC_TYPE_ARRAY_CORANK (TREE_TYPE (desc))]; + tree rank = gfc_rank_cst[GFC_TYPE_ARRAY_CORANK (TREE_TYPE (desc))]; tmp = fold_build2_loc (input_location, GT_EXPR, logical_type_node, - bound, tmp); + bound, + fold_convert_loc (input_location, + TREE_TYPE (bound), rank)); cond = fold_build2_loc (input_location, TRUTH_ORIF_EXPR, logical_type_node, cond, tmp); gfc_trans_runtime_check (true, false, cond, &se->pre, &expr->where, @@ -2699,14 +2716,19 @@ conv_intrinsic_cobound (gfc_se * se, gfc_expr * expr) { case 0: bound = fold_build2_loc (input_location, MINUS_EXPR, - gfc_array_index_type, bound, - gfc_index_one_node); + gfc_array_dim_rank_type, bound, + gfc_rank_cst[1]); case 1: break; default: - bound = fold_build2_loc (input_location, PLUS_EXPR, - gfc_array_index_type, bound, - gfc_rank_cst[arg->expr->rank - 1]); + { + tree rank = gfc_rank_cst[arg->expr->rank - 1]; + bound = fold_build2_loc (input_location, PLUS_EXPR, + gfc_array_dim_rank_type, bound, + fold_convert_loc (input_location, + TREE_TYPE (bound), + rank)); + } } } diff --git a/gcc/fortran/trans-openmp.cc b/gcc/fortran/trans-openmp.cc index eb0012714970..339f0c99cb70 100644 --- a/gcc/fortran/trans-openmp.cc +++ b/gcc/fortran/trans-openmp.cc @@ -2123,17 +2123,18 @@ gfc_omp_get_array_size (location_t loc, tree desc, gimple_seq *seq) tree extent = build_decl (loc, VAR_DECL, create_tmp_var_name ("extent"), gfc_array_index_type); tree idx = build_decl (loc, VAR_DECL, create_tmp_var_name ("idx"), - signed_char_type_node); + gfc_array_dim_rank_type); - tree begin = build_zero_cst (signed_char_type_node); + tree begin = build_zero_cst (gfc_array_dim_rank_type); tree end; if (GFC_TYPE_ARRAY_AKIND (TREE_TYPE (desc)) == GFC_ARRAY_ASSUMED_SHAPE_CONT || GFC_TYPE_ARRAY_AKIND (TREE_TYPE (desc)) == GFC_ARRAY_ASSUMED_SHAPE) - end = gfc_conv_descriptor_rank (desc); + end = fold_convert (gfc_array_dim_rank_type, + gfc_conv_descriptor_rank (desc)); else - end = build_int_cst (signed_char_type_node, + end = build_int_cst (gfc_array_dim_rank_type, GFC_TYPE_ARRAY_RANK (TREE_TYPE (desc))); - tree step = build_int_cst (signed_char_type_node, 1); + tree step = build_int_cst (gfc_array_dim_rank_type, 1); /* size = 0 for (idx = 0; idx < rank; idx++) diff --git a/gcc/fortran/trans-types.cc b/gcc/fortran/trans-types.cc index bb33cddbfa07..ea4395c67dd7 100644 --- a/gcc/fortran/trans-types.cc +++ b/gcc/fortran/trans-types.cc @@ -55,6 +55,7 @@ along with GCC; see the file COPYING3. If not see /* array of structs so we don't have to worry about xmalloc or free */ CInteropKind_t c_interop_kinds_table[ISOCBINDING_NUMBER]; +tree gfc_array_dim_rank_type; tree gfc_array_index_type; tree gfc_array_range_type; tree gfc_character1_type_node; @@ -164,7 +165,7 @@ tree get_dtype_type_node (void) suppress_warning (field); field = gfc_add_field_to_struct_1 (dtype_node, get_identifier ("rank"), - signed_char_type_node, &dtype_chain); + gfc_array_dim_rank_type, &dtype_chain); suppress_warning (field); field = gfc_add_field_to_struct_1 (dtype_node, get_identifier ("type"), @@ -1226,6 +1227,12 @@ gfc_init_types (void) gfc_charlen_int_kind = get_int_kind_from_node (size_type_node); gfc_charlen_type_node = gfc_get_int_type (gfc_charlen_int_kind); + gfc_array_dim_rank_type + = build_range_type (signed_char_type_node, + build_zero_cst (signed_char_type_node), + build_int_cst (signed_char_type_node, + GFC_MAX_DIMENSIONS)); + /* Fortran kind number of size_type_node (size_t). This is used for the _size member in vtables. */ gfc_size_kind = get_int_kind_from_node (size_type_node); diff --git a/gcc/fortran/trans-types.h b/gcc/fortran/trans-types.h index 94fa6761e902..a2169e436c8b 100644 --- a/gcc/fortran/trans-types.h +++ b/gcc/fortran/trans-types.h @@ -52,6 +52,9 @@ extern GTY(()) tree logical_false_node; It must be the same as the corresponding definition in gfortran.h. */ extern GTY(()) tree gfc_charlen_type_node; +/* An integral type with bounds [0, GFC_MAX_DIMENSIONS] suitable to hold an + array rank, or an array dimension index. */ +extern GTY(()) tree gfc_array_dim_rank_type; /* The following flags give us information on the correspondence of real (and complex) kinds with C floating-point types long double
