[gcc(refs/users/mikael/heads/refactor_descriptor_v08)] Suppression gfc_conv_descriptor_dtype compil' OK
Mikael Morin
mikael@gcc.gnu.org
Wed Sep 17 16:44:14 GMT 2025
https://gcc.gnu.org/g:92a5839ef2d3b1a6f275d3f5a87fb25d542f35d0
commit 92a5839ef2d3b1a6f275d3f5a87fb25d542f35d0
Author: Mikael Morin <mikael@gcc.gnu.org>
Date: Sat Jun 28 23:09:22 2025 +0200
Suppression gfc_conv_descriptor_dtype compil' OK
Suppression non_lvalue dtype_get
Ajout location descriptor_dtype_set
Suppression variable inutilisée
Suppression retour à la ligne inutile dtype_set
Diff:
---
gcc/fortran/trans-array.cc | 98 +++++++++++++++++------------------------
gcc/fortran/trans-decl.cc | 6 ++-
gcc/fortran/trans-descriptor.cc | 30 ++++++++++---
gcc/fortran/trans-descriptor.h | 4 +-
gcc/fortran/trans-expr.cc | 36 +++++++--------
gcc/fortran/trans-intrinsic.cc | 11 ++---
gcc/fortran/trans-stmt.cc | 5 +--
7 files changed, 92 insertions(+), 98 deletions(-)
diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index b99e12a506dd..0ffe4fda6c81 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -1180,9 +1180,10 @@ 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. */
tmp = gfc_conv_descriptor_rank (desc);
@@ -1204,8 +1205,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;
@@ -5895,8 +5896,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
@@ -5917,14 +5918,12 @@ 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)
@@ -5934,10 +5933,7 @@ gfc_array_init_size (tree descriptor, int rank, int corank, tree * poffset,
fold_convert (TREE_TYPE (tmp), 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;
@@ -8320,7 +8316,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)
@@ -8330,11 +8325,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;
@@ -8918,8 +8913,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_add_modify (&block, gfc_conv_descriptor_rank (arr),
build_int_cst (signed_char_type_node, 1));
gfc_conv_descriptor_span_set (&block, arr,
@@ -9071,9 +9066,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);
@@ -9773,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);
@@ -9964,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);
@@ -10128,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);
@@ -10532,8 +10526,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)
{
@@ -11580,27 +11574,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))
{
@@ -11635,10 +11628,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>]. */
@@ -11752,10 +11743,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)
@@ -11791,7 +11780,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;
@@ -11819,11 +11807,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;
@@ -11970,12 +11956,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 1c8b33c27755..556e52502b88 100644
--- a/gcc/fortran/trans-decl.cc
+++ b/gcc/fortran/trans-decl.cc
@@ -42,6 +42,7 @@ along with GCC; see the file COPYING3. If not see
#include "trans-types.h"
#include "trans-array.h"
#include "trans-const.h"
+#include "trans-descriptor.h"
/* Only for gfc_trans_code. Shouldn't need to include this. */
#include "trans-stmt.h"
#include "trans-descriptor.h"
@@ -7265,8 +7266,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 e898f2a8d406..255b243d9360 100644
--- a/gcc/fortran/trans-descriptor.cc
+++ b/gcc/fortran/trans-descriptor.cc
@@ -237,14 +237,30 @@ gfc_conv_descriptor_offset_set (stmtblock_t *block, tree desc, tree value)
}
-tree
-gfc_conv_descriptor_dtype (tree desc)
+static tree
+get_descriptor_dtype (tree desc)
{
tree field = gfc_get_descriptor_field (desc, DTYPE_FIELD);
gcc_assert (TREE_TYPE (field) == get_dtype_type_node ());
return field;
}
+tree
+gfc_conv_descriptor_dtype_get (tree desc)
+{
+ return get_descriptor_dtype (desc);
+}
+
+void
+gfc_conv_descriptor_dtype_set (stmtblock_t *block, tree desc, tree value)
+{
+ location_t loc = input_location;
+ tree t = get_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)
{
@@ -273,7 +289,7 @@ gfc_conv_descriptor_rank (tree desc)
tree tmp;
tree dtype;
- dtype = gfc_conv_descriptor_dtype (desc);
+ dtype = get_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);
@@ -288,7 +304,7 @@ gfc_conv_descriptor_version (tree desc)
tree tmp;
tree dtype;
- dtype = gfc_conv_descriptor_dtype (desc);
+ dtype = get_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);
@@ -305,7 +321,7 @@ gfc_conv_descriptor_elem_len (tree desc)
tree tmp;
tree dtype;
- dtype = gfc_conv_descriptor_dtype (desc);
+ dtype = get_descriptor_dtype (desc);
tmp = gfc_advance_chain (TYPE_FIELDS (TREE_TYPE (dtype)),
GFC_DTYPE_ELEM_LEN);
gcc_assert (tmp != NULL_TREE
@@ -321,7 +337,7 @@ gfc_conv_descriptor_attribute (tree desc)
tree tmp;
tree dtype;
- dtype = gfc_conv_descriptor_dtype (desc);
+ dtype = get_descriptor_dtype (desc);
tmp = gfc_advance_chain (TYPE_FIELDS (TREE_TYPE (dtype)),
GFC_DTYPE_ATTRIBUTE);
gcc_assert (tmp!= NULL_TREE
@@ -336,7 +352,7 @@ gfc_conv_descriptor_type (tree desc)
tree tmp;
tree dtype;
- dtype = gfc_conv_descriptor_dtype (desc);
+ dtype = get_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 36365ff32ae0..108d15bec7ec 100644
--- a/gcc/fortran/trans-descriptor.h
+++ b/gcc/fortran/trans-descriptor.h
@@ -48,7 +48,6 @@ tree gfc_get_cfi_dim_extent (tree desc, tree idx);
tree gfc_get_cfi_dim_sm (tree desc, tree idx);
-tree gfc_conv_descriptor_dtype (tree desc);
tree gfc_conv_descriptor_rank (tree desc);
tree gfc_conv_descriptor_version (tree desc);
tree gfc_conv_descriptor_elem_len (tree desc);
@@ -60,14 +59,17 @@ tree gfc_conv_descriptor_token (tree desc);
tree gfc_conv_descriptor_data_get (tree desc);
tree gfc_conv_descriptor_offset_get (tree desc);
+tree gfc_conv_descriptor_dtype_get (tree desc);
tree gfc_conv_descriptor_span_get (tree desc);
tree gfc_conv_descriptor_stride_get (tree desc, tree dim);
tree gfc_conv_descriptor_lbound_get (tree desc, tree dim);
tree gfc_conv_descriptor_ubound_get (tree desc, tree dim);
+void gfc_conv_descriptor_data_set (stmtblock_t *block, tree desc, tree value);
void gfc_conv_descriptor_data_set (stmtblock_t *block, tree desc, tree value);
void gfc_conv_descriptor_offset_set (stmtblock_t *block, tree desc, tree value);
+void gfc_conv_descriptor_dtype_set (stmtblock_t *block, tree desc, tree value);
void gfc_conv_descriptor_span_set (stmtblock_t *block, tree desc, tree value);
void gfc_conv_descriptor_stride_set (stmtblock_t *block, tree desc, tree dim, tree value);
void gfc_conv_descriptor_lbound_set (stmtblock_t *block, tree desc, tree dim, tree value);
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index d50a6a0f9921..02581f6fdb82 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 (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)))
@@ -5986,12 +5986,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));
@@ -11276,14 +11273,13 @@ gfc_trans_pointer_assignment (gfc_expr * expr1, gfc_expr * expr2)
converted in rse and now have to build the correct LHS
descriptor for it. */
- tree dtype, data, span;
+ tree data, span;
tree offs, stride;
tree lbound, ubound;
/* Set dtype. */
- 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)));
/* Copy data pointer. */
data = gfc_conv_descriptor_data_get (rse.expr);
@@ -11873,11 +11869,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 78ebfc029e3e..3060e0f0f9e5 100644
--- a/gcc/fortran/trans-intrinsic.cc
+++ b/gcc/fortran/trans-intrinsic.cc
@@ -8212,7 +8212,6 @@ gfc_conv_intrinsic_sizeof (gfc_se *se, gfc_expr *expr)
tree lower;
tree upper;
tree byte_size;
- tree field;
int n;
gfc_init_se (&argse, NULL);
@@ -8236,11 +8235,7 @@ gfc_conv_intrinsic_sizeof (gfc_se *se, gfc_expr *expr)
if (POINTER_TYPE_P (TREE_TYPE (tmp)))
tmp = build_fold_indirect_ref_loc (input_location, tmp);
- tmp = gfc_conv_descriptor_dtype (tmp);
- field = gfc_advance_chain (TYPE_FIELDS (get_dtype_type_node ()),
- GFC_DTYPE_ELEM_LEN);
- tmp = fold_build3_loc (input_location, COMPONENT_REF, TREE_TYPE (field),
- tmp, field, NULL_TREE);
+ tmp = gfc_conv_descriptor_elem_len (tmp);
byte_size = fold_convert (gfc_array_index_type, tmp);
}
@@ -9979,8 +9974,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 eef867e05e10..3f7c3c0955c1 100644
--- a/gcc/fortran/trans-stmt.cc
+++ b/gcc/fortran/trans-stmt.cc
@@ -2247,9 +2247,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),
More information about the Gcc-cvs
mailing list