https://gcc.gnu.org/g:f9ea6b91e9834cadd1db75189ce23a559938f8e3
commit f9ea6b91e9834cadd1db75189ce23a559938f8e3 Author: Mikael Morin <[email protected]> Date: Sat Jun 28 23:09:22 2025 +0200 fortran: array descriptor: Add accessors for the dtype field 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. gcc/fortran/ChangeLog: * trans-descriptor.cc (gfc_conv_descriptor_dtype): Make static and rename ... (conv_descriptor_dtype): ... to this. (gfc_conv_descriptor_rank gfc_conv_descriptor_version, gfc_conv_descriptor_elem_len, gfc_conv_descriptor_attribute, gfc_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_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. Diff: --- gcc/fortran/trans-array.cc | 97 +++++++++++++++++------------------------ gcc/fortran/trans-decl.cc | 5 ++- gcc/fortran/trans-descriptor.cc | 37 +++++++++++++--- gcc/fortran/trans-descriptor.h | 3 +- gcc/fortran/trans-expr.cc | 34 +++++++-------- gcc/fortran/trans-intrinsic.cc | 4 +- gcc/fortran/trans-stmt.cc | 5 +-- 7 files changed, 94 insertions(+), 91 deletions(-) diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc index a3c4c5ab0ae3..1254eae8ea18 100644 --- a/gcc/fortran/trans-array.cc +++ b/gcc/fortran/trans-array.cc @@ -1250,9 +1250,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); @@ -1272,8 +1272,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; @@ -5879,8 +5879,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 @@ -5901,23 +5901,18 @@ 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) 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; @@ -8301,7 +8296,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) @@ -8311,11 +8305,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; @@ -8912,8 +8906,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 tmp2 = gfc_conv_descriptor_dtype_get (se->expr); + gfc_conv_descriptor_dtype_set (&block, arr, tmp2); gfc_conv_descriptor_rank_set (&block, arr, 1); gfc_conv_descriptor_span_set (&block, arr, gfc_conv_descriptor_span_get (arr)); @@ -9073,9 +9067,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); old_field = gfc_conv_descriptor_offset_get (old_desc); gfc_conv_descriptor_offset_set (&se->pre, new_desc, old_field); @@ -9774,8 +9767,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); @@ -9965,8 +9958,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); @@ -10129,8 +10122,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 tmp2 = gfc_get_dtype (TREE_TYPE (comp)); + gfc_conv_descriptor_dtype_set (&fnblock, comp, tmp2); tmp = fold_build3_loc (input_location, COMPONENT_REF, ctype, decl, cdecl, NULL_TREE); token = gfc_conv_descriptor_token (tmp); @@ -10543,8 +10536,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) { @@ -11613,27 +11606,26 @@ 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)); + tree tmp = gfc_get_dtype_rank_type (expr1->rank,type); + gfc_conv_descriptor_dtype_set (&fblock, desc, tmp); } 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)); + tree tmp = gfc_get_dtype_rank_type (expr2->rank,type); + gfc_conv_descriptor_dtype_set (&fblock, desc, tmp); + /* Set the _len field as well... */ if (UNLIMITED_POLY (expr1)) { @@ -11668,10 +11660,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>]. */ @@ -11785,10 +11775,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) @@ -11824,7 +11812,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; @@ -11852,11 +11839,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; @@ -12003,12 +11988,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 2243cf9da13e..9c323f64f1e6 100644 --- a/gcc/fortran/trans-decl.cc +++ b/gcc/fortran/trans-decl.cc @@ -7324,8 +7324,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 9e8dd46e2735..1c8560c4b5a9 100644 --- a/gcc/fortran/trans-descriptor.cc +++ b/gcc/fortran/trans-descriptor.cc @@ -135,14 +135,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 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 value of the dtype field of the array descriptor DESC. */ + +tree +gfc_conv_descriptor_dtype_get (tree desc) +{ + return conv_descriptor_dtype (desc); +} + +/* Add code to BLOCK setting to VALUE 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) { @@ -173,7 +196,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) == signed_char_type_node); @@ -217,7 +240,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); @@ -253,7 +276,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 @@ -289,7 +312,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 @@ -307,7 +330,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 fae9bd49671d..ba17a50d4621 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 30ac2c5d46e0..a676152328b8 100644 --- a/gcc/fortran/trans-expr.cc +++ b/gcc/fortran/trans-expr.cc @@ -126,8 +126,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)); @@ -793,8 +793,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. */ tmp = gfc_get_descriptor_dimension (lhs_desc); @@ -919,8 +919,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)); if (optional) parmse->expr = build3_loc (input_location, COND_EXPR, TREE_TYPE (parmse->expr), @@ -1329,8 +1329,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))) @@ -6050,12 +6050,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)); @@ -11333,9 +11330,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) @@ -11968,11 +11964,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 ab46c46e8562..5f5463fd5165 100644 --- a/gcc/fortran/trans-intrinsic.cc +++ b/gcc/fortran/trans-intrinsic.cc @@ -10119,8 +10119,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 fd82336bbfb1..f1d2a9b5b571 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 tmp = gfc_get_dtype (TREE_TYPE (sym->backend_decl)); + gfc_conv_descriptor_dtype_set (&se.pre, sym->backend_decl, tmp); } gfc_add_init_cleanup (block, gfc_finish_block (&se.pre),
