https://gcc.gnu.org/g:4ae577108f8666a29a71b6f2253c9f42d1ea76bc
commit 4ae577108f8666a29a71b6f2253c9f42d1ea76bc Author: Mikael Morin <[email protected]> Date: Sun Jun 29 14:07:23 2025 +0200 fortran: array descriptor: Add accessors for the rank field Regression tested on powerpc64le-unknown-linux-gnu. OK for master? -- >8 -- Add accessor functions to get or set the value of the rank field of array descriptors, and remove from the public API the function giving direct acces to the field. gcc/fortran/ChangeLog: * trans-descriptor.cc (gfc_conv_descriptor_rank): Make static and rename ... (conv_descriptor_rank): ... to this. (gfc_conv_descriptor_rank_get, gfc_conv_descriptor_rank_set): New functions. * trans-descriptor.h (gfc_conv_descriptor_rank): Remove declaration. (gfc_conv_descriptor_rank_get, gfc_conv_descriptor_rank_set): New declarations. * trans-array.cc (gfc_trans_create_temp_array, gfc_conv_ss_startstride, gfc_tree_array_size, gfc_conv_array_parameter, gfc_full_array_size, duplicate_allocatable_coarray): Use gfc_conv_descriptor_rank_get to get the value of the rank field, and gfc_conv_descriptor_rank_set to set it. * trans-decl.cc (gfc_conv_cfi_to_gfc): Likewise. * trans-expr.cc (gfc_conv_derived_to_class, gfc_conv_variable, gfc_conv_gfc_desc_to_cfi_desc, conv_null_actual, gfc_trans_structure_assign): Likewise. * trans-intrinsic.cc (gfc_conv_intrinsic_rank, gfc_conv_intrinsic_bound, gfc_conv_intrinsic_sizeof, gfc_conv_associated): Likewise. * trans-openmp.cc (gfc_omp_get_array_size): Likewise. * trans-stmt.cc (gfc_trans_select_rank_cases): Likewise. Export gfc_conv_descriptor_rank Diff: --- gcc/fortran/trans-array.cc | 20 ++++++++------------ gcc/fortran/trans-decl.cc | 2 +- gcc/fortran/trans-descriptor.cc | 29 +++++++++++++++++++++++++++++ gcc/fortran/trans-descriptor.h | 3 +++ gcc/fortran/trans-expr.cc | 26 ++++++++------------------ gcc/fortran/trans-intrinsic.cc | 10 +++++----- gcc/fortran/trans-openmp.cc | 2 +- gcc/fortran/trans-stmt.cc | 2 +- 8 files changed, 56 insertions(+), 38 deletions(-) diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc index 9da52263b446..b62deb6fe106 100644 --- a/gcc/fortran/trans-array.cc +++ b/gcc/fortran/trans-array.cc @@ -1257,9 +1257,7 @@ gfc_trans_create_temp_array (stmtblock_t * pre, stmtblock_t * post, gfc_ss * ss, gfc_add_modify (pre, tmp, dtype); /* These transformational functions change the rank. */ - tmp = gfc_conv_descriptor_rank (desc); - gfc_add_modify (pre, tmp, - build_int_cst (TREE_TYPE (tmp), ss->loop->dimen)); + gfc_conv_descriptor_rank_set (pre, desc, ss->loop->dimen); fcn_ss->info->class_container = NULL_TREE; } @@ -4970,7 +4968,7 @@ done: && (gfc_option.allow_std & GFC_STD_F202Y))) gcc_assert (se.pre.head == NULL_TREE && se.post.head == NULL_TREE); - rank = gfc_conv_descriptor_rank (se.expr); + rank = gfc_conv_descriptor_rank_get (se.expr); tmp = fold_build2_loc (input_location, MINUS_EXPR, gfc_array_index_type, fold_convert (gfc_array_index_type, @@ -8588,7 +8586,7 @@ gfc_tree_array_size (stmtblock_t *block, tree desc, gfc_expr *expr, tree dim) 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, - gfc_conv_descriptor_rank (desc)); + gfc_conv_descriptor_rank_get (desc)); else rank = build_int_cst (signed_char_type_node, expr->rank); @@ -8741,7 +8739,7 @@ gfc_resize_assumed_rank_dim_field (gfc_se *se, stmtblock_t *block, tree desc) gfc_conv_descriptor_offset_get (se->expr)); gfc_add_modify (block, gfc_conv_descriptor_dtype (desc), gfc_conv_descriptor_dtype (se->expr)); - rank = fold_convert (size_type_node, gfc_conv_descriptor_rank (se->expr)); + rank = fold_convert (size_type_node, gfc_conv_descriptor_rank_get (se->expr)); dim_field = gfc_get_descriptor_dimension (se->expr); dim_size = TYPE_SIZE_UNIT (TREE_TYPE (TREE_TYPE (dim_field))); copy_size = fold_build2_loc (input_location, MULT_EXPR, @@ -9021,8 +9019,7 @@ gfc_conv_array_parameter (gfc_se *se, gfc_expr *expr, bool g77, gfc_conv_descriptor_stride_get (se->expr, gfc_index_zero_node)); gfc_add_modify (&block, gfc_conv_descriptor_dtype (arr), gfc_conv_descriptor_dtype (se->expr)); - gfc_add_modify (&block, gfc_conv_descriptor_rank (arr), - build_int_cst (signed_char_type_node, 1)); + gfc_conv_descriptor_rank_set (&block, arr, 1); gfc_conv_descriptor_span_set (&block, arr, gfc_conv_descriptor_span_get (arr)); gfc_conv_descriptor_offset_set (&block, arr, gfc_index_zero_node); @@ -9236,7 +9233,7 @@ gfc_conv_array_parameter (gfc_se *se, gfc_expr *expr, bool g77, gfc_simple_for_loop (&se->pre, idx, build_int_cst (TREE_TYPE (idx), 0), - gfc_conv_descriptor_rank (old_desc), + gfc_conv_descriptor_rank_get (old_desc), LT_EXPR, build_int_cst (TREE_TYPE (idx), 1), gfc_finish_block (&loop_body)); @@ -9377,7 +9374,7 @@ gfc_full_array_size (stmtblock_t *block, tree decl, int rank) tree nelems; tree tmp; if (rank < 0) - idx = gfc_conv_descriptor_rank (decl); + idx = gfc_conv_descriptor_rank_get (decl); else idx = gfc_rank_cst[rank - 1]; nelems = gfc_conv_descriptor_ubound_get (decl, idx); @@ -9587,8 +9584,7 @@ duplicate_allocatable_coarray (tree dest, tree dest_tok, tree src, tree type, else { /* Set the rank or uninitialized memory access may be reported. */ - tmp = gfc_conv_descriptor_rank (dest); - gfc_add_modify (&globalblock, tmp, build_int_cst (TREE_TYPE (tmp), rank)); + gfc_conv_descriptor_rank_set (&globalblock, dest, rank); if (rank) nelems = gfc_full_array_size (&globalblock, src, rank); diff --git a/gcc/fortran/trans-decl.cc b/gcc/fortran/trans-decl.cc index 63d76749ea3b..05654121a7a8 100644 --- a/gcc/fortran/trans-decl.cc +++ b/gcc/fortran/trans-decl.cc @@ -7603,7 +7603,7 @@ gfc_conv_cfi_to_gfc (stmtblock_t *init, stmtblock_t *finally, { /* Set gfc->dtype.rank, if assumed-rank. */ rank = gfc_get_cfi_desc_rank (cfi); - gfc_add_modify (&block, gfc_conv_descriptor_rank (gfc_desc), rank); + gfc_conv_descriptor_rank_set (&block, 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. */ diff --git a/gcc/fortran/trans-descriptor.cc b/gcc/fortran/trans-descriptor.cc index c02a3fd5282a..8eb5d0f0a392 100644 --- a/gcc/fortran/trans-descriptor.cc +++ b/gcc/fortran/trans-descriptor.cc @@ -150,6 +150,8 @@ gfc_conv_descriptor_span_set (stmtblock_t *block, tree desc, tree value) } +/* Return a reference to the rank of array descriptor DESC. */ + tree gfc_conv_descriptor_rank (tree desc) { @@ -164,6 +166,33 @@ gfc_conv_descriptor_rank (tree desc) dtype, tmp, NULL_TREE); } +/* Return the rank of the array descriptor DESC. */ + +tree +gfc_conv_descriptor_rank_get (tree desc) +{ + return gfc_conv_descriptor_rank (desc); +} + +/* Add code to BLOCK setting to VALUE the rank of the array descriptor DESC. */ + +void +gfc_conv_descriptor_rank_set (stmtblock_t *block, tree desc, tree value) +{ + location_t loc = input_location; + tree t = gfc_conv_descriptor_rank (desc); + gfc_add_modify_loc (loc, block, t, + fold_convert_loc (loc, TREE_TYPE (t), value)); +} + +/* Add code to BLOCK setting to VALUE the rank of the array descriptor DESC. */ + +void +gfc_conv_descriptor_rank_set (stmtblock_t *block, tree desc, int value) +{ + gfc_conv_descriptor_rank_set (block, desc, gfc_rank_cst[value]); +} + /* Return a reference to descriptor DESC's format version. */ diff --git a/gcc/fortran/trans-descriptor.h b/gcc/fortran/trans-descriptor.h index ec60d7cb656b..f62c020211b3 100644 --- a/gcc/fortran/trans-descriptor.h +++ b/gcc/fortran/trans-descriptor.h @@ -32,6 +32,7 @@ tree gfc_conv_descriptor_data_get (tree); tree gfc_conv_descriptor_offset_get (tree); tree gfc_conv_descriptor_elem_len_get (tree); tree gfc_conv_descriptor_version_get (tree); +tree gfc_conv_descriptor_rank_get (tree); tree gfc_conv_descriptor_span_get (tree); tree gfc_conv_descriptor_stride_get (tree, tree); @@ -42,6 +43,8 @@ void gfc_conv_descriptor_data_set (stmtblock_t *, tree, tree); void gfc_conv_descriptor_offset_set (stmtblock_t *, tree, tree); void gfc_conv_descriptor_elem_len_set (stmtblock_t *, tree, tree); void gfc_conv_descriptor_version_set (stmtblock_t *, tree, tree); +void gfc_conv_descriptor_rank_set (stmtblock_t *, tree, tree); +void gfc_conv_descriptor_rank_set (stmtblock_t *, tree, int); void gfc_conv_descriptor_span_set (stmtblock_t *, tree, tree); void gfc_conv_descriptor_stride_set (stmtblock_t *, tree, tree, tree); void gfc_conv_descriptor_lbound_set (stmtblock_t *, tree, tree, tree); diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc index 92a37fc5b3ab..7c3567137d8c 100644 --- a/gcc/fortran/trans-expr.cc +++ b/gcc/fortran/trans-expr.cc @@ -1047,7 +1047,7 @@ gfc_conv_derived_to_class (gfc_se *parmse, gfc_expr *e, gfc_symbol *fsym, gfc_conv_descriptor_dtype (*derived_array), gfc_conv_descriptor_dtype (parmse->expr)); rank = fold_convert (size_type_node, - gfc_conv_descriptor_rank (parmse->expr)); + gfc_conv_descriptor_rank_get (parmse->expr)); dim_field = gfc_get_descriptor_dimension (parmse->expr); dim_size = TYPE_SIZE_UNIT (TREE_TYPE (TREE_TYPE (dim_field))); copy_size = fold_build2_loc (input_location, MULT_EXPR, @@ -3406,7 +3406,7 @@ gfc_conv_variable (gfc_se * se, gfc_expr * expr) char *msg; dim = fold_convert (signed_char_type_node, - gfc_conv_descriptor_rank (se->expr)); + gfc_conv_descriptor_rank_get (se->expr)); dim = fold_build2_loc (input_location, MINUS_EXPR, signed_char_type_node, dim, build_int_cst (signed_char_type_node, 1)); lower = gfc_conv_descriptor_lbound_get (se->expr, dim); @@ -6257,7 +6257,8 @@ 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 (signed_char_type_node, + gfc_conv_descriptor_rank_get (gfc)); else rank = build_int_cst (signed_char_type_node, e->rank); tmp = gfc_get_cfi_desc_rank (cfi); @@ -6860,12 +6861,9 @@ conv_null_actual (gfc_se * parmse, gfc_expr * e, gfc_symbol * fsym) correct rank. */ if (fsym->as && fsym->as->type == AS_ASSUMED_RANK) { - tree rank; tree tmp = parmse->expr; tmp = gfc_conv_scalar_to_descriptor (parmse, tmp, fsym->attr); - rank = gfc_conv_descriptor_rank (tmp); - gfc_add_modify (&parmse->pre, rank, - build_int_cst (TREE_TYPE (rank), e->rank)); + gfc_conv_descriptor_rank_set (&parmse->pre, tmp, e->rank); parmse->expr = gfc_build_addr_expr (NULL_TREE, tmp); } else @@ -6915,13 +6913,10 @@ conv_null_actual (gfc_se * parmse, gfc_expr * e, gfc_symbol * fsym) For an assumed-rank dummy we provide a descriptor that passes the correct rank. */ { - tree rank; tree tmp = parmse->expr; tmp = gfc_conv_scalar_to_descriptor (parmse, tmp, gfc_expr_attr (e)); - rank = gfc_conv_descriptor_rank (tmp); - gfc_add_modify (&parmse->pre, rank, - build_int_cst (TREE_TYPE (rank), e->rank)); + gfc_conv_descriptor_rank_set (&parmse->pre, tmp, e->rank); gfc_conv_descriptor_data_set (&parmse->pre, tmp, null_pointer_node); parmse->expr = gfc_build_addr_expr (NULL_TREE, tmp); } @@ -6938,11 +6933,7 @@ conv_null_actual (gfc_se * parmse, gfc_expr * e, gfc_symbol * fsym) tmp = gfc_conv_scalar_to_descriptor (parmse, tmp, fsym->attr); dummy_rank = fsym->as ? fsym->as->rank : 0; if (dummy_rank > 0) - { - tree rank = gfc_conv_descriptor_rank (tmp); - gfc_add_modify (&parmse->pre, rank, - build_int_cst (TREE_TYPE (rank), dummy_rank)); - } + gfc_conv_descriptor_rank_set (&parmse->pre, tmp, dummy_rank); gfc_conv_descriptor_data_set (&parmse->pre, tmp, null_pointer_node); parmse->expr = gfc_build_addr_expr (NULL_TREE, tmp); } @@ -10444,8 +10435,7 @@ gfc_trans_structure_assign (tree dest, gfc_expr * expr, bool init, bool coarray) rank = 1; size = build_zero_cst (size_type_node); desc = field; - gfc_add_modify (&block, gfc_conv_descriptor_rank (desc), - build_int_cst (signed_char_type_node, rank)); + gfc_conv_descriptor_rank_set (&block, desc, rank); } else { diff --git a/gcc/fortran/trans-intrinsic.cc b/gcc/fortran/trans-intrinsic.cc index a5c6e716304e..3d586fe8cf7e 100644 --- a/gcc/fortran/trans-intrinsic.cc +++ b/gcc/fortran/trans-intrinsic.cc @@ -2296,7 +2296,7 @@ gfc_conv_intrinsic_rank (gfc_se *se, gfc_expr *expr) gfc_add_block_to_block (&se->pre, &argse.pre); gfc_add_block_to_block (&se->post, &argse.post); - se->expr = gfc_conv_descriptor_rank (argse.expr); + se->expr = gfc_conv_descriptor_rank_get (argse.expr); se->expr = fold_convert (gfc_get_int_type (gfc_default_integer_kind), se->expr); } @@ -2485,7 +2485,7 @@ gfc_conv_intrinsic_bound (gfc_se * se, gfc_expr * expr, enum gfc_isym_id op) cond = fold_build2_loc (input_location, LT_EXPR, logical_type_node, bound, build_int_cst (TREE_TYPE (bound), 0)); if (as && as->type == AS_ASSUMED_RANK) - tmp = gfc_conv_descriptor_rank (desc); + tmp = gfc_conv_descriptor_rank_get (desc); else tmp = gfc_rank_cst[GFC_TYPE_ARRAY_RANK (TREE_TYPE (desc))]; tmp = fold_build2_loc (input_location, GE_EXPR, logical_type_node, @@ -2580,7 +2580,7 @@ gfc_conv_intrinsic_bound (gfc_se * se, gfc_expr * expr, enum gfc_isym_id op) { tree minus_one = build_int_cst (gfc_array_index_type, -1); tree rank = fold_convert (gfc_array_index_type, - gfc_conv_descriptor_rank (desc)); + gfc_conv_descriptor_rank_get (desc)); rank = fold_build2_loc (input_location, PLUS_EXPR, gfc_array_index_type, rank, minus_one); @@ -8476,7 +8476,7 @@ gfc_conv_intrinsic_sizeof (gfc_se *se, gfc_expr *expr) stmtblock_t body; tmp = fold_convert (gfc_array_index_type, - gfc_conv_descriptor_rank (argse.expr)); + gfc_conv_descriptor_rank_get (argse.expr)); loop_var = gfc_create_var (gfc_array_index_type, "i"); gfc_add_modify (&argse.pre, loop_var, gfc_index_zero_node); exit_label = gfc_build_label_decl (NULL_TREE); @@ -9288,7 +9288,7 @@ gfc_conv_associated (gfc_se *se, gfc_expr *expr) gfc_conv_expr_lhs (&arg1se, arg1->expr); if (arg1->expr->rank == -1) { - tmp = gfc_conv_descriptor_rank (arg1se.expr); + tmp = gfc_conv_descriptor_rank_get (arg1se.expr); tmp = fold_build2_loc (input_location, MINUS_EXPR, TREE_TYPE (tmp), tmp, build_int_cst (TREE_TYPE (tmp), 1)); diff --git a/gcc/fortran/trans-openmp.cc b/gcc/fortran/trans-openmp.cc index e663895ff7f5..f209a7b8d2b9 100644 --- a/gcc/fortran/trans-openmp.cc +++ b/gcc/fortran/trans-openmp.cc @@ -2129,7 +2129,7 @@ gfc_omp_get_array_size (location_t loc, tree desc, gimple_seq *seq) 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 = gfc_conv_descriptor_rank_get (desc); else end = build_int_cst (signed_char_type_node, GFC_TYPE_ARRAY_RANK (TREE_TYPE (desc))); diff --git a/gcc/fortran/trans-stmt.cc b/gcc/fortran/trans-stmt.cc index 6f50ae610c7c..58c31226cacd 100644 --- a/gcc/fortran/trans-stmt.cc +++ b/gcc/fortran/trans-stmt.cc @@ -3974,7 +3974,7 @@ gfc_trans_select_rank_cases (gfc_code * code) /* Calculate the switch expression. */ gfc_init_se (&se, NULL); gfc_conv_expr_descriptor (&se, code->expr1); - rank = gfc_conv_descriptor_rank (se.expr); + rank = gfc_conv_descriptor_rank_get (se.expr); rank = gfc_evaluate_now (rank, &block); symbol_attribute attr = gfc_expr_attr (code->expr1); if (!attr.pointer && !attr.allocatable)
