[PATCH 06/12] fortran: array descriptor: Add accessors for the dtype field [PR122521]
Mikael Morin <[email protected]> Sat, 11 Jul 2026 16:46:33 +0200
| Newsgroups | gmane.comp.gcc.patches,gmane.comp.gcc.fortran |
|---|---|
| Message-ID | <[email protected]> |
From: Mikael Morin <[email protected]> Regression tested on aarch64-unknown-linux-gnu. OK for master? -- >8 -- Use accessor functions to get or set the dtype field of array descriptors and remove from the public API the function giving direct acces to the field. PR fortran/122521 gcc/fortran/ChangeLog: * trans-descriptor.cc (gfc_conv_descriptor_dtype): Make static and rename ... (conv_descriptor_dtype): ... to this. (conv_descriptor_rank conv_descriptor_version, conv_descriptor_elem_len, gfc_conv_descriptor_attribute, conv_descriptor_type): Update callers. (gfc_conv_descriptor_dtype_get, gfc_conv_descriptor_dtype_set): New functions. * trans-descriptor.h (gfc_conv_descriptor_dtype): Remove declaration. (gfc_conv_descriptor_dtype_get, gfc_conv_descriptor_dtype_set): New declarations. * trans-array.cc (gfc_trans_create_temp_array, gfc_array_init_size, gfc_conv_expr_descriptor, gfc_resize_assumed_rank_dim_field, gfc_conv_array_parameter, structure_alloc_comps, gfc_alloc_allocatable_for_assignment, gfc_trans_class_array, gfc_trans_deferred_array): Use gfc_conv_descriptor_dtype_get to get the value of the dtype field and gfc_conv_descriptor_dtype_set to update it. * trans-decl.cc (gfc_conv_cfi_to_gfc): Likewise. * trans-expr.cc (gfc_conv_scalar_to_descriptor, gfc_class_array_data_assign, gfc_conv_derived_to_class, gfc_conv_class_to_class, set_dtype_for_unallocated, gfc_trans_pointer_assignment, fcncall_realloc_result): Likewise. * trans-intrinsic.cc (conv_isocbinding_subroutine): Likewise. * trans-stmt.cc (trans_associate_var): Likewise. --- gcc/fortran/trans-array.cc | 106 ++++++++++++++------------------ gcc/fortran/trans-decl.cc | 5 +- gcc/fortran/trans-descriptor.cc | 37 ++++++++--- gcc/fortran/trans-descriptor.h | 3 +- gcc/fortran/trans-expr.cc | 40 ++++++------ gcc/fortran/trans-intrinsic.cc | 4 +- gcc/fortran/trans-stmt.cc | 5 +- 7 files changed, 102 insertions(+), 98 deletions(-) diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc index a9140f7967b..aa4ca1a8bc1 100644 --- a/gcc/fortran/trans-array.cc +++ b/gcc/fortran/trans-array.cc @@ -1252,9 +1252,9 @@ gfc_trans_create_temp_array (stmtblock_t * pre, stmtblock_t * post, gfc_ss * ss, if (rank_changer) { /* Take the dtype from the class expression. */ - dtype = gfc_conv_descriptor_dtype (gfc_class_data_get (class_expr)); - tmp = gfc_conv_descriptor_dtype (desc); - gfc_add_modify (pre, tmp, dtype); + tree class_descr = gfc_class_data_get (class_expr); + dtype = gfc_conv_descriptor_dtype_get (class_descr); + gfc_conv_descriptor_dtype_set (pre, desc, dtype); /* These transformational functions change the rank. */ gfc_conv_descriptor_rank_set (pre, desc, ss->loop->dimen); @@ -1274,8 +1274,8 @@ gfc_trans_create_temp_array (stmtblock_t * pre, stmtblock_t * post, gfc_ss * ss, else { /* Fill in the array dtype. */ - tmp = gfc_conv_descriptor_dtype (desc); - gfc_add_modify (pre, tmp, gfc_get_dtype (TREE_TYPE (desc))); + gfc_conv_descriptor_dtype_set (pre, desc, + gfc_get_dtype (TREE_TYPE (desc))); } info->descriptor = desc; @@ -6033,8 +6033,8 @@ gfc_array_init_size (tree descriptor, int rank, int corank, tree * poffset, && VAR_P (expr->ts.u.cl->backend_decl)) { type = gfc_typenode_for_spec (&expr->ts); - tmp = gfc_conv_descriptor_dtype (descriptor); - gfc_add_modify (pblock, tmp, gfc_get_dtype_rank_type (rank, type)); + gfc_conv_descriptor_dtype_set (pblock, descriptor, + gfc_get_dtype_rank_type (rank, type)); } else if (expr->ts.type == BT_CHARACTER && expr->ts.deferred @@ -6055,27 +6055,21 @@ gfc_array_init_size (tree descriptor, int rank, int corank, tree * poffset, TREE_OPERAND (descriptor, 0), tmp, NULL_TREE); tmp = fold_convert (gfc_charlen_type_node, tmp); type = gfc_get_character_type_len (expr->ts.kind, tmp); - tmp = gfc_conv_descriptor_dtype (descriptor); - gfc_add_modify (pblock, tmp, gfc_get_dtype_rank_type (rank, type)); + gfc_conv_descriptor_dtype_set (pblock, descriptor, + gfc_get_dtype_rank_type (rank, type)); } else if (expr3_desc && GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (expr3_desc))) - { - tmp = gfc_conv_descriptor_dtype (descriptor); - gfc_add_modify (pblock, tmp, gfc_conv_descriptor_dtype (expr3_desc)); - } + gfc_conv_descriptor_dtype_set (pblock, descriptor, + gfc_conv_descriptor_dtype_get (expr3_desc)); else if (expr->ts.type == BT_CLASS && !explicit_ts && expr3 && expr3->ts.type != BT_CLASS && expr3_elem_size != NULL_TREE && expr3_desc == NULL_TREE) { - tmp = gfc_conv_descriptor_dtype (descriptor); - gfc_add_modify (pblock, tmp, gfc_get_dtype (type)); + gfc_conv_descriptor_dtype_set (pblock, descriptor, gfc_get_dtype (type)); gfc_conv_descriptor_elem_len_set (pblock, descriptor, expr3_elem_size); } else - { - tmp = gfc_conv_descriptor_dtype (descriptor); - gfc_add_modify (pblock, tmp, gfc_get_dtype (type)); - } + gfc_conv_descriptor_dtype_set (pblock, descriptor, gfc_get_dtype (type)); or_expr = logical_false_node; @@ -8469,7 +8463,6 @@ gfc_conv_expr_descriptor (gfc_se *se, gfc_expr *expr) the offsets because all elements are within the array data. */ /* Set the dtype. */ - tmp = gfc_conv_descriptor_dtype (parm); if (se->unlimited_polymorphic) dtype = gfc_get_dtype (TREE_TYPE (desc), &loop.dimen); else if (expr->ts.type == BT_ASSUMED) @@ -8479,11 +8472,11 @@ gfc_conv_expr_descriptor (gfc_se *se, gfc_expr *expr) tmp2 = GFC_DECL_SAVED_DESCRIPTOR (tmp2); if (POINTER_TYPE_P (TREE_TYPE (tmp2))) tmp2 = build_fold_indirect_ref_loc (input_location, tmp2); - dtype = gfc_conv_descriptor_dtype (tmp2); + dtype = gfc_conv_descriptor_dtype_get (tmp2); } else dtype = gfc_get_dtype (parmtype); - gfc_add_modify (&loop.pre, tmp, dtype); + gfc_conv_descriptor_dtype_set (&loop.pre, parm, dtype); /* The 1st element in the section. */ base = gfc_index_zero_node; @@ -8829,8 +8822,8 @@ gfc_resize_assumed_rank_dim_field (gfc_se *se, stmtblock_t *block, tree desc) gfc_conv_descriptor_data_get (se->expr)); gfc_conv_descriptor_offset_set (block, desc, gfc_conv_descriptor_offset_get (se->expr)); - gfc_add_modify (block, gfc_conv_descriptor_dtype (desc), - gfc_conv_descriptor_dtype (se->expr)); + gfc_conv_descriptor_dtype_set (block, desc, + gfc_conv_descriptor_dtype_get (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))); @@ -9109,8 +9102,8 @@ gfc_conv_array_parameter (gfc_se *se, gfc_expr *expr, bool g77, gfc_conv_descriptor_stride_set ( &block, arr, gfc_index_zero_node, 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)); + tree dtype_val = gfc_conv_descriptor_dtype_get (se->expr); + gfc_conv_descriptor_dtype_set (&block, arr, dtype_val); gfc_conv_descriptor_rank_set (&block, arr, 1); gfc_conv_descriptor_span_set (&block, arr, gfc_conv_descriptor_span_get (arr)); @@ -9268,9 +9261,8 @@ gfc_conv_array_parameter (gfc_se *se, gfc_expr *expr, bool g77, tree old_desc = tmp; tree new_desc = gfc_create_var (TREE_TYPE (old_desc), "arg_desc"); - old_field = gfc_conv_descriptor_dtype (old_desc); - new_field = gfc_conv_descriptor_dtype (new_desc); - gfc_add_modify (&se->pre, new_field, old_field); + old_field = gfc_conv_descriptor_dtype_get (old_desc); + gfc_conv_descriptor_dtype_set (&se->pre, new_desc, old_field); if (expr->rank == -1) { @@ -10202,8 +10194,8 @@ structure_alloc_comps (gfc_symbol * der_type, tree decl, tree dest, cdesc = gfc_create_var (cdesc, "cdesc"); DECL_ARTIFICIAL (cdesc) = 1; - gfc_add_modify (&tmpblock, gfc_conv_descriptor_dtype (cdesc), - gfc_get_dtype_rank_type (1, tmp)); + gfc_conv_descriptor_dtype_set (&tmpblock, cdesc, + gfc_get_dtype_rank_type (1, tmp)); gfc_conv_descriptor_lbound_set (&tmpblock, cdesc, gfc_index_zero_node, gfc_index_one_node); @@ -10393,8 +10385,8 @@ structure_alloc_comps (gfc_symbol * der_type, tree decl, tree dest, cdesc = gfc_create_var (cdesc, "cdesc"); DECL_ARTIFICIAL (cdesc) = 1; - gfc_add_modify (&dealloc_block, gfc_conv_descriptor_dtype (cdesc), - gfc_get_dtype_rank_type (1, tmp)); + gfc_conv_descriptor_dtype_set (&dealloc_block, cdesc, + gfc_get_dtype_rank_type (1, tmp)); gfc_conv_descriptor_lbound_set (&dealloc_block, cdesc, gfc_index_zero_node, gfc_index_one_node); @@ -10557,8 +10549,8 @@ structure_alloc_comps (gfc_symbol * der_type, tree decl, tree dest, if (c->attr.dimension) { /* Set the dtype, because caf_register needs it. */ - gfc_add_modify (&fnblock, gfc_conv_descriptor_dtype (comp), - gfc_get_dtype (TREE_TYPE (comp))); + tree dtype_val = gfc_get_dtype (TREE_TYPE (comp)); + gfc_conv_descriptor_dtype_set (&fnblock, comp, dtype_val); tmp = fold_build3_loc (input_location, COMPONENT_REF, ctype, decl, cdecl, NULL_TREE); token = gfc_conv_descriptor_token (tmp); @@ -11031,8 +11023,8 @@ structure_alloc_comps (gfc_symbol * der_type, tree decl, tree dest, size = gfc_evaluate_now (size, &fnblock); tmp = gfc_call_malloc (&fnblock, NULL, size); gfc_conv_descriptor_data_set (&fnblock, comp, tmp); - tmp = gfc_conv_descriptor_dtype (comp); - gfc_add_modify (&fnblock, tmp, gfc_get_dtype (ctype)); + gfc_conv_descriptor_dtype_set (&fnblock, comp, + gfc_get_dtype (ctype)); if (c->initializer && c->initializer->rank) { @@ -12084,27 +12076,28 @@ gfc_alloc_allocatable_for_assignment (gfc_loopinfo *loop, && expr1->ts.type == BT_CHARACTER && expr1->ts.deferred) { tree type; - tmp = gfc_conv_descriptor_dtype (desc); if (expr2->ts.u.cl->backend_decl) type = gfc_typenode_for_spec (&expr2->ts); else type = gfc_typenode_for_spec (&expr1->ts); - gfc_add_modify (&fblock, tmp, - gfc_get_dtype_rank_type (expr1->rank,type)); + gfc_conv_descriptor_dtype_set (&fblock, desc, + gfc_get_dtype_rank_type (expr1->rank, + type)); } else if (expr1->ts.type == BT_CLASS) { tree type; - tmp = gfc_conv_descriptor_dtype (desc); if (expr2->ts.type != BT_CLASS) type = gfc_typenode_for_spec (&expr2->ts); else type = gfc_get_character_type_len (1, elemsize2); - gfc_add_modify (&fblock, tmp, - gfc_get_dtype_rank_type (expr2->rank,type)); + gfc_conv_descriptor_dtype_set (&fblock, desc, + gfc_get_dtype_rank_type (expr2->rank, + type)); + /* Set the _len field as well... */ if (UNLIMITED_POLY (expr1)) { @@ -12139,10 +12132,8 @@ gfc_alloc_allocatable_for_assignment (gfc_loopinfo *loop, gfc_add_modify (&fblock, tmp, fold_convert (TREE_TYPE (tmp), tmp2)); } else if (coarray && GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (desc))) - { - gfc_add_modify (&fblock, gfc_conv_descriptor_dtype (desc), - gfc_get_dtype (TREE_TYPE (desc))); - } + gfc_conv_descriptor_dtype_set (&fblock, desc, + gfc_get_dtype (TREE_TYPE (desc))); /* Realloc expression. Note that the scalarizer uses desc.data in the array reference - (*desc.data)[<element>]. */ @@ -12256,10 +12247,8 @@ gfc_alloc_allocatable_for_assignment (gfc_loopinfo *loop, && ((expr1->ts.type == BT_CHARACTER && expr1->ts.deferred) || coarray)) && expr1->ts.type != BT_CLASS) - { - tmp = gfc_conv_descriptor_dtype (desc); - gfc_add_modify (&alloc_block, tmp, gfc_get_dtype (TREE_TYPE (desc))); - } + gfc_conv_descriptor_dtype_set (&alloc_block, desc, + gfc_get_dtype (TREE_TYPE (desc))); if ((expr1->ts.type == BT_DERIVED) && expr1->ts.u.derived->attr.alloc_comp) @@ -12295,7 +12284,6 @@ void gfc_trans_class_array (gfc_symbol * sym, gfc_wrapped_block * block) { tree type, etype; - tree tmp; tree descriptor; stmtblock_t init; int rank; @@ -12323,11 +12311,9 @@ gfc_trans_class_array (gfc_symbol * sym, gfc_wrapped_block * block) rank = CLASS_DATA (sym)->as ? (CLASS_DATA (sym)->as->rank) : (0); gcc_assert (rank>=0); - tmp = gfc_conv_descriptor_dtype (descriptor); etype = gfc_get_element_type (type); - tmp = fold_build2_loc (input_location, MODIFY_EXPR, TREE_TYPE (tmp), tmp, - gfc_get_dtype_rank_type (rank, etype)); - gfc_add_expr_to_block (&init, tmp); + gfc_conv_descriptor_dtype_set (&init, descriptor, + gfc_get_dtype_rank_type (rank, etype)); gfc_add_init_cleanup (block, gfc_finish_block (&init), NULL_TREE); input_location = loc; @@ -12474,12 +12460,10 @@ gfc_trans_deferred_array (gfc_symbol * sym, gfc_wrapped_block * block) tree etype; gcc_assert (sym->as && sym->as->rank>=0); - tmp = gfc_conv_descriptor_dtype (descriptor); etype = gfc_get_element_type (type); - tmp = fold_build2_loc (input_location, MODIFY_EXPR, - TREE_TYPE (tmp), tmp, - gfc_get_dtype_rank_type (sym->as->rank, etype)); - gfc_add_expr_to_block (&init, tmp); + gfc_conv_descriptor_dtype_set (&init, descriptor, + gfc_get_dtype_rank_type (sym->as->rank, + etype)); } input_location = loc; gfc_init_block (&cleanup); diff --git a/gcc/fortran/trans-decl.cc b/gcc/fortran/trans-decl.cc index fab4873b92c..47b28c1d003 100644 --- a/gcc/fortran/trans-decl.cc +++ b/gcc/fortran/trans-decl.cc @@ -7509,8 +7509,9 @@ gfc_conv_cfi_to_gfc (stmtblock_t *init, stmtblock_t *finally, { /* gfc->dtype = ... (from declaration, not from cfi). */ etype = gfc_get_element_type (TREE_TYPE (gfc_desc)); - gfc_add_modify (&block, gfc_conv_descriptor_dtype (gfc_desc), - gfc_get_dtype_rank_type (sym->as->rank, etype)); + gfc_conv_descriptor_dtype_set (&block, gfc_desc, + gfc_get_dtype_rank_type (sym->as->rank, + etype)); /* gfc->data = cfi->base_addr. */ gfc_conv_descriptor_data_set (&block, gfc_desc, gfc_get_cfi_desc_base_addr (cfi)); diff --git a/gcc/fortran/trans-descriptor.cc b/gcc/fortran/trans-descriptor.cc index 163916bfc27..0373fcc7a77 100644 --- a/gcc/fortran/trans-descriptor.cc +++ b/gcc/fortran/trans-descriptor.cc @@ -141,14 +141,37 @@ gfc_conv_descriptor_offset_set (stmtblock_t *block, tree desc, tree value) } -tree -gfc_conv_descriptor_dtype (tree desc) +/* Return a reference to the dtype field of the array descriptor DESC. */ + +static tree +conv_descriptor_dtype (tree desc) { tree field = gfc_get_descriptor_field (desc, DTYPE_FIELD); gcc_assert (TREE_TYPE (field) == get_dtype_type_node ()); return field; } +/* Return the dtype value of the array descriptor DESC. */ + +tree +gfc_conv_descriptor_dtype_get (tree desc) +{ + return conv_descriptor_dtype (desc); +} + +/* Add code to BLOCK assigning VALUE to the dtype field of the array descriptor + DESC. */ + +void +gfc_conv_descriptor_dtype_set (stmtblock_t *block, tree desc, tree value) +{ + location_t loc = input_location; + tree t = conv_descriptor_dtype (desc); + gfc_add_modify_loc (loc, block, t, + fold_convert_loc (loc, TREE_TYPE (t), value)); +} + + static tree gfc_conv_descriptor_span (tree desc) { @@ -179,7 +202,7 @@ conv_descriptor_rank (tree desc) tree tmp; tree dtype; - dtype = gfc_conv_descriptor_dtype (desc); + dtype = conv_descriptor_dtype (desc); tmp = gfc_advance_chain (TYPE_FIELDS (TREE_TYPE (dtype)), GFC_DTYPE_RANK); gcc_assert (tmp != NULL_TREE && TREE_TYPE (tmp) == gfc_array_dim_rank_type); @@ -226,7 +249,7 @@ conv_descriptor_version (tree desc) tree tmp; tree dtype; - dtype = gfc_conv_descriptor_dtype (desc); + dtype = conv_descriptor_dtype (desc); tmp = gfc_advance_chain (TYPE_FIELDS (TREE_TYPE (dtype)), GFC_DTYPE_VERSION); gcc_assert (tmp != NULL_TREE && TREE_TYPE (tmp) == integer_type_node); @@ -264,7 +287,7 @@ conv_descriptor_elem_len (tree desc) tree tmp; tree dtype; - dtype = gfc_conv_descriptor_dtype (desc); + dtype = conv_descriptor_dtype (desc); tmp = gfc_advance_chain (TYPE_FIELDS (TREE_TYPE (dtype)), GFC_DTYPE_ELEM_LEN); gcc_assert (tmp != NULL_TREE @@ -300,7 +323,7 @@ gfc_conv_descriptor_attribute (tree desc) tree tmp; tree dtype; - dtype = gfc_conv_descriptor_dtype (desc); + dtype = conv_descriptor_dtype (desc); tmp = gfc_advance_chain (TYPE_FIELDS (TREE_TYPE (dtype)), GFC_DTYPE_ATTRIBUTE); gcc_assert (tmp!= NULL_TREE @@ -319,7 +342,7 @@ conv_descriptor_type (tree desc) tree tmp; tree dtype; - dtype = gfc_conv_descriptor_dtype (desc); + dtype = conv_descriptor_dtype (desc); tmp = gfc_advance_chain (TYPE_FIELDS (TREE_TYPE (dtype)), GFC_DTYPE_TYPE); gcc_assert (tmp!= NULL_TREE && TREE_TYPE (tmp) == signed_char_type_node); diff --git a/gcc/fortran/trans-descriptor.h b/gcc/fortran/trans-descriptor.h index e59ed8ed7b5..27fb6c8ad79 100644 --- a/gcc/fortran/trans-descriptor.h +++ b/gcc/fortran/trans-descriptor.h @@ -20,7 +20,6 @@ along with GCC; see the file COPYING3. If not see #define GFC_TRANS_DESCRIPTOR_H -tree gfc_conv_descriptor_dtype (tree); tree gfc_conv_descriptor_attribute (tree); tree gfc_get_descriptor_dimension (tree); tree gfc_conv_descriptor_dimension (tree, tree); @@ -28,6 +27,7 @@ tree gfc_conv_descriptor_token (tree); tree gfc_conv_descriptor_data_get (tree); tree gfc_conv_descriptor_offset_get (tree); +tree gfc_conv_descriptor_dtype_get (tree); tree gfc_conv_descriptor_elem_len_get (tree); tree gfc_conv_descriptor_version_get (tree); tree gfc_conv_descriptor_rank_get (tree); @@ -40,6 +40,7 @@ tree gfc_conv_descriptor_ubound_get (tree, tree); void gfc_conv_descriptor_data_set (stmtblock_t *, tree, tree); void gfc_conv_descriptor_offset_set (stmtblock_t *, tree, tree); +void gfc_conv_descriptor_dtype_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); diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc index 30bc4559681..f1a9ea220c4 100644 --- a/gcc/fortran/trans-expr.cc +++ b/gcc/fortran/trans-expr.cc @@ -136,8 +136,8 @@ gfc_conv_scalar_to_descriptor (gfc_se *se, tree scalar, symbol_attribute attr) scalar = gfc_build_addr_expr (NULL_TREE, scalar); else if (TREE_TYPE (etype) && TREE_CODE (TREE_TYPE (etype)) == ARRAY_TYPE) etype = TREE_TYPE (etype); - gfc_add_modify (&se->pre, gfc_conv_descriptor_dtype (desc), - gfc_get_dtype_rank_type (0, etype)); + gfc_conv_descriptor_dtype_set (&se->pre, desc, + gfc_get_dtype_rank_type (0, etype)); gfc_conv_descriptor_data_set (&se->pre, desc, scalar); gfc_conv_descriptor_span_set (&se->pre, desc, gfc_conv_descriptor_elem_len_get (desc)); @@ -835,8 +835,8 @@ gfc_class_array_data_assign (stmtblock_t *block, tree lhs_desc, tree rhs_desc, gfc_conv_descriptor_offset_set (block, lhs_desc, gfc_conv_descriptor_offset_get (rhs_desc)); - gfc_add_modify (block, gfc_conv_descriptor_dtype (lhs_desc), - gfc_conv_descriptor_dtype (rhs_desc)); + gfc_conv_descriptor_dtype_set (block, lhs_desc, + gfc_conv_descriptor_dtype_get (rhs_desc)); /* Assign the dimension as range-ref. */ lhs_dim = gfc_get_descriptor_dimension (lhs_desc); @@ -964,8 +964,8 @@ gfc_conv_derived_to_class (gfc_se *parmse, gfc_expr *e, gfc_symbol *fsym, tree type; type = get_scalar_to_descriptor_type (parmse->expr, gfc_expr_attr (e)); - gfc_add_modify (&parmse->pre, gfc_conv_descriptor_dtype (ctree), - gfc_get_dtype (type)); + gfc_conv_descriptor_dtype_set (&parmse->pre, ctree, + gfc_get_dtype (type)); copy_coarray_desc_part (&parmse->pre, ctree, parmse->expr); if (optional) parmse->expr = build3_loc (input_location, COND_EXPR, @@ -1043,9 +1043,9 @@ gfc_conv_derived_to_class (gfc_se *parmse, gfc_expr *e, gfc_symbol *fsym, gfc_conv_descriptor_offset_set (&block, *derived_array, gfc_conv_descriptor_offset_get (parmse->expr)); - gfc_add_modify (&block, - gfc_conv_descriptor_dtype (*derived_array), - gfc_conv_descriptor_dtype (parmse->expr)); + tree dtype_val = gfc_conv_descriptor_dtype_get (parmse->expr); + gfc_conv_descriptor_dtype_set (&block, *derived_array, + dtype_val); rank = gfc_conv_descriptor_rank_get (parmse->expr); rank = fold_convert (size_type_node, rank); dim_field = gfc_get_descriptor_dimension (parmse->expr); @@ -1406,8 +1406,8 @@ gfc_conv_class_to_class (gfc_se *parmse, gfc_expr *e, gfc_typespec class_ts, { tree type = get_scalar_to_descriptor_type (parmse->expr, gfc_expr_attr (e)); - gfc_add_modify (&block, gfc_conv_descriptor_dtype (ctree), - gfc_get_dtype (type)); + gfc_conv_descriptor_dtype_set (&block, ctree, + gfc_get_dtype (type)); tmp = gfc_class_data_get (parmse->expr); if (!POINTER_TYPE_P (TREE_TYPE (tmp))) @@ -6169,12 +6169,9 @@ set_dtype_for_unallocated (gfc_se *parmse, gfc_expr *e) cond = fold_build2_loc (input_location, EQ_EXPR, logical_type_node, tmp, build_int_cst (TREE_TYPE (tmp), 0)); - tmp = gfc_conv_descriptor_dtype (desc); type = gfc_get_element_type (TREE_TYPE (desc)); - tmp = fold_build2_loc (input_location, MODIFY_EXPR, - TREE_TYPE (tmp), tmp, - gfc_get_dtype_rank_type (e->rank, type)); - gfc_add_expr_to_block (&block, tmp); + gfc_conv_descriptor_dtype_set (&block, desc, + gfc_get_dtype_rank_type (e->rank, type)); cond = build3_v (COND_EXPR, cond, gfc_finish_block (&block), build_empty_stmt (input_location)); @@ -11529,9 +11526,8 @@ gfc_trans_pointer_assignment (gfc_expr * expr1, gfc_expr * expr2) gcc_assert (remap->u.ar.dimen == expr1->rank); /* Always set dtype. */ - tree dtype = gfc_conv_descriptor_dtype (desc); - tmp = gfc_get_dtype (TREE_TYPE (desc)); - gfc_add_modify (&block, dtype, tmp); + gfc_conv_descriptor_dtype_set (&block, desc, + gfc_get_dtype (TREE_TYPE (desc))); /* For unlimited polymorphic LHS use elem_len from RHS. */ if (UNLIMITED_POLY (expr1) && expr2->ts.type != BT_CLASS) @@ -12203,11 +12199,11 @@ fcncall_realloc_result (gfc_se *se, int rank, tree dtype) desc = build_fold_indirect_ref_loc (input_location, desc); /* Unallocated, the descriptor does not have a dtype. */ - tmp = gfc_conv_descriptor_dtype (desc); if (dtype != NULL_TREE) - gfc_add_modify (&se->pre, tmp, dtype); + gfc_conv_descriptor_dtype_set (&se->pre, desc, dtype); else - gfc_add_modify (&se->pre, tmp, gfc_get_dtype (TREE_TYPE (desc))); + gfc_conv_descriptor_dtype_set (&se->pre, desc, + gfc_get_dtype (TREE_TYPE (desc))); res_desc = gfc_evaluate_now (desc, &se->pre); gfc_conv_descriptor_data_set (&se->pre, res_desc, null_pointer_node); diff --git a/gcc/fortran/trans-intrinsic.cc b/gcc/fortran/trans-intrinsic.cc index 566c7d0bf2a..2c0af0c41fc 100644 --- a/gcc/fortran/trans-intrinsic.cc +++ b/gcc/fortran/trans-intrinsic.cc @@ -10191,8 +10191,8 @@ conv_isocbinding_subroutine (gfc_code *code) /* Set data value, dtype, and offset. */ tmp = GFC_TYPE_ARRAY_DATAPTR_TYPE (TREE_TYPE (desc)); gfc_conv_descriptor_data_set (&block, desc, fold_convert (tmp, cptrse.expr)); - gfc_add_modify (&block, gfc_conv_descriptor_dtype (desc), - gfc_get_dtype (TREE_TYPE (desc))); + gfc_conv_descriptor_dtype_set (&block, desc, + gfc_get_dtype (TREE_TYPE (desc))); /* Start scalarization of the bounds, using the shape argument. */ diff --git a/gcc/fortran/trans-stmt.cc b/gcc/fortran/trans-stmt.cc index 15ec037cb21..5cffe356f65 100644 --- a/gcc/fortran/trans-stmt.cc +++ b/gcc/fortran/trans-stmt.cc @@ -2221,9 +2221,8 @@ trans_associate_var (gfc_symbol *sym, gfc_wrapped_block *block) { /* Recover the dtype, which has been overwritten by the assignment from an unlimited polymorphic object. */ - tmp = gfc_conv_descriptor_dtype (sym->backend_decl); - gfc_add_modify (&se.pre, tmp, - gfc_get_dtype (TREE_TYPE (sym->backend_decl))); + tree dtype_val = gfc_get_dtype (TREE_TYPE (sym->backend_decl)); + gfc_conv_descriptor_dtype_set (&se.pre, sym->backend_decl, dtype_val); } gfc_add_init_cleanup (block, gfc_finish_block (&se.pre), -- 2.53.0