https://gcc.gnu.org/g:b626ff646018c285848ad420a72a43b1fba1a751
commit b626ff646018c285848ad420a72a43b1fba1a751
Author: Mikael Morin <mik...@gcc.gnu.org>
Date: Wed Feb 5 15:12:25 2025 +0100
Renseignement token par gfc_set_descriptor_from_scalar.
Diff:
---
gcc/fortran/trans-array.cc | 27 ++++++++++++++++++++-------
gcc/fortran/trans-array.h | 2 +-
gcc/fortran/trans-expr.cc | 15 +++++++++++----
3 files changed, 32 insertions(+), 12 deletions(-)
diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index 531281049646..c09b9bdab155 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -682,6 +682,7 @@ public:
virtual bool set_span () const { return false; }
virtual bool set_token () const { return true; }
virtual tree get_data_value () const { return NULL_TREE; }
+ virtual tree get_caf_token () const { return null_pointer_node; }
virtual bt get_type_type (const gfc_typespec &) const { return BT_UNKNOWN; }
virtual tree get_length (gfc_typespec *ts) const { return get_size_info
(*ts); }
};
@@ -751,22 +752,24 @@ private:
bool initialisation;
gfc_typespec *ts;
tree value;
+ tree caf_token;
bool use_tree_type_;
bool clear_token;
tree get_elt_type () const;
public:
scalar_value(gfc_typespec &arg_ts, tree arg_value)
- : initialisation(true), ts(&arg_ts), value(arg_value), use_tree_type_
(false), clear_token(true) { }
- scalar_value(tree arg_value)
- : initialisation(true), ts(nullptr), value(arg_value), use_tree_type_
(true), clear_token(false) { }
+ : initialisation(true), ts(&arg_ts), value(arg_value), caf_token
(NULL_TREE), use_tree_type_ (false), clear_token(true) { }
+ scalar_value(tree arg_value, tree arg_caf_token)
+ : initialisation(true), ts(nullptr), value(arg_value), caf_token
(arg_caf_token), use_tree_type_ (true), clear_token(false) { }
virtual bool is_initialization () const { return initialisation; }
virtual bool initialize_data () const { return true; }
virtual tree get_data_value () const;
virtual gfc_typespec *get_type () const { return ts; }
virtual bool set_span () const { return true; }
virtual bool use_tree_type () const { return use_tree_type_; }
- virtual bool set_token () const { return clear_token; }
+ virtual bool set_token () const { return clear_token || caf_token !=
NULL_TREE; }
+ virtual tree get_caf_token () const;
virtual bt get_type_type (const gfc_typespec &) const;
virtual tree get_length (gfc_typespec *ts) const;
};
@@ -838,6 +841,16 @@ scalar_value::get_length (gfc_typespec * type_info) const
return size;
}
+tree
+scalar_value::get_caf_token () const
+{
+ if (set_token ()
+ && caf_token != NULL_TREE)
+ return caf_token;
+ else
+ return modify_info::get_caf_token ();
+}
+
static tree
build_dtype (gfc_typespec *ts, int rank, const symbol_attribute &,
@@ -933,7 +946,7 @@ get_descriptor_init (tree type, gfc_typespec *ts, int rank,
tree token_field = gfc_advance_chain (fields,
CAF_TOKEN_FIELD - (!dim_present));
tree token_value = fold_convert (TREE_TYPE (token_field),
- null_pointer_node);
+ init.get_caf_token ());
CONSTRUCTOR_APPEND_ELT (v, token_field, token_value);
}
@@ -1430,11 +1443,11 @@ gfc_set_scalar_descriptor (stmtblock_t *block, tree
descriptor,
void
gfc_set_descriptor_from_scalar (stmtblock_t *block, tree desc, tree scalar,
- symbol_attribute *attr)
+ symbol_attribute *attr, tree caf_token)
{
init_struct (block, desc,
get_descriptor_init (TREE_TYPE (desc), nullptr, 0, attr,
- scalar_value (scalar)));
+ scalar_value (scalar, caf_token)));
}
diff --git a/gcc/fortran/trans-array.h b/gcc/fortran/trans-array.h
index 97cf7f8cb41f..2dad79aa9993 100644
--- a/gcc/fortran/trans-array.h
+++ b/gcc/fortran/trans-array.h
@@ -149,7 +149,7 @@ void gfc_set_descriptor_with_shape (stmtblock_t *, tree,
tree,
gfc_expr *, locus *);
tree gfc_get_scalar_to_descriptor_type (tree scalar, symbol_attribute attr);
void gfc_set_descriptor_from_scalar (stmtblock_t *, tree, tree,
- symbol_attribute *);
+ symbol_attribute *, tree = NULL_TREE);
void gfc_copy_sequence_descriptor (stmtblock_t &, tree, tree, bool);
void gfc_set_gfc_from_cfi (stmtblock_t *, stmtblock_t *, tree, tree, tree,
gfc_symbol *, bool, bool, bool);
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index 39bd7178c3c0..13a1ec1e8fe3 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -883,14 +883,20 @@ gfc_conv_derived_to_class (gfc_se *parmse, gfc_expr *e,
gfc_symbol *fsym,
/* Now set the data field. */
ctree = gfc_class_data_get (var);
+ tree caf_token;
if (flag_coarray == GFC_FCOARRAY_LIB && CLASS_DATA (fsym)->attr.codimension)
{
- tree token;
tmp = gfc_get_tree_for_caf_expr (e);
if (POINTER_TYPE_P (TREE_TYPE (tmp)))
tmp = build_fold_indirect_ref (tmp);
- gfc_get_caf_token_offset (parmse, &token, nullptr, tmp, NULL_TREE, e);
- gfc_add_modify (&parmse->pre, gfc_conv_descriptor_token (ctree), token);
+ gfc_get_caf_token_offset (parmse, &caf_token, nullptr, tmp, NULL_TREE,
e);
+ /* gfc_set_descriptor_from scalar already updates the token,
+ don't do it twice. */
+ if ((parmse->expr && POINTER_TYPE_P (TREE_TYPE (parmse->expr)))
+ || (parmse->ss && parmse->ss->info && parmse->ss->info->useflags)
+ || e->rank != 0
+ || fsym->ts.u.derived->components->as == nullptr)
+ gfc_add_modify (&parmse->pre, gfc_conv_descriptor_token (ctree),
caf_token);
}
if (optional)
@@ -966,7 +972,8 @@ gfc_conv_derived_to_class (gfc_se *parmse, gfc_expr *e,
gfc_symbol *fsym,
null_pointer_node));
}
symbol_attribute attr = gfc_expr_attr (e);
- gfc_set_descriptor_from_scalar (&parmse->pre, ctree, tmp, &attr);
+ gfc_set_descriptor_from_scalar (&parmse->pre, ctree, tmp, &attr,
+ caf_token);
}
else
{
