From: Mikael Morin <[email protected]>
Regression tested on powerpc64le-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.
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.
---
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 a3c4c5ab0ae..1254eae8ea1 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 2243cf9da13..9c323f64f1e 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 9e8dd46e273..1c8560c4b5a 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 fae9bd49671..ba17a50d462 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 30ac2c5d46e..a676152328b 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 ab46c46e856..5f5463fd516 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 fd82336bbfb..f1d2a9b5b57 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),
--
2.51.0
