https://gcc.gnu.org/g:95cb0dd4cd51e62909945a0ee7109ad47abe065b
commit 95cb0dd4cd51e62909945a0ee7109ad47abe065b
Author: Mikael Morin <mik...@gcc.gnu.org>
Date: Wed Jul 23 09:44:49 2025 +0200
Renseignement token dans gcf_set_descriptor_from_scalar
Diff:
---
gcc/fortran/trans-descriptor.cc | 11 +++++++----
gcc/fortran/trans-descriptor.h | 2 +-
gcc/fortran/trans-expr.cc | 16 +++++++++++-----
3 files changed, 19 insertions(+), 10 deletions(-)
diff --git a/gcc/fortran/trans-descriptor.cc b/gcc/fortran/trans-descriptor.cc
index a9469c639ae4..22e5cbed8a65 100644
--- a/gcc/fortran/trans-descriptor.cc
+++ b/gcc/fortran/trans-descriptor.cc
@@ -1886,11 +1886,13 @@ gfc_set_descriptor_from_scalar (stmtblock_t *block,
tree descr,
void
gfc_set_descriptor_from_scalar (stmtblock_t *block, tree descr,
tree scalar, gfc_expr *scalar_expr,
- tree cond_presence)
+ tree cond_presence, tree caf_token)
{
- tree type;
- type = gfc_get_scalar_to_descriptor_type (scalar,
- gfc_expr_attr (scalar_expr));
+ if (flag_coarray == GFC_FCOARRAY_LIB && caf_token)
+ gfc_conv_descriptor_token_set (block, descr, caf_token);
+
+ tree type = gfc_get_scalar_to_descriptor_type (scalar,
+ gfc_expr_attr (scalar_expr));
gfc_conv_descriptor_dtype_set (block, descr,
gfc_get_dtype (type));
if (cond_presence)
@@ -1917,5 +1919,6 @@ gfc_set_descriptor_from_scalar (stmtblock_t *block, tree
descr, tree scalar)
gfc_conv_descriptor_data_set (block, descr, scalar);
gfc_conv_descriptor_span_set (block, descr,
gfc_conv_descriptor_elem_len_get (descr));
+
}
diff --git a/gcc/fortran/trans-descriptor.h b/gcc/fortran/trans-descriptor.h
index 7e6e2871bc5e..b586b9679877 100644
--- a/gcc/fortran/trans-descriptor.h
+++ b/gcc/fortran/trans-descriptor.h
@@ -130,6 +130,6 @@ void gfc_set_gfc_from_cfi (stmtblock_t *, stmtblock_t *,
tree, tree, tree,
void gfc_set_descriptor_from_scalar (stmtblock_t *, tree, tree);
void gfc_set_descriptor_from_scalar (stmtblock_t *, tree, tree, gfc_expr *);
void gfc_set_descriptor_from_scalar (stmtblock_t *, tree, tree, gfc_expr *,
- tree);
+ tree, tree);
#endif /* GFC_TRANS_DESCRIPTOR_H */
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index bbe68d18c7b3..0b603aef0c26 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -854,6 +854,7 @@ gfc_conv_derived_to_class (gfc_se *parmse, gfc_expr *e,
gfc_symbol *fsym,
tree var;
tree tmp;
tree packed = NULL_TREE;
+ tree caf_token = NULL_TREE;
/* The derived type needs to be converted to a temporary CLASS object. */
tmp = gfc_typenode_for_spec (&fsym->ts);
@@ -870,12 +871,17 @@ gfc_conv_derived_to_class (gfc_se *parmse, gfc_expr *e,
gfc_symbol *fsym,
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_conv_descriptor_token_set (&parmse->pre, ctree, token);
+ gfc_get_caf_token_offset (parmse, &caf_token, nullptr, tmp, NULL_TREE,
e);
+ /* Update the token here, unless it's done elsewhere like in
+ gfc_set_descriptor_from_scalar. */
+ 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_conv_descriptor_token_set (&parmse->pre, ctree, caf_token);
}
if (optional)
@@ -941,8 +947,8 @@ gfc_conv_derived_to_class (gfc_se *parmse, gfc_expr *e,
gfc_symbol *fsym,
/* Scalar to an assumed-rank array. */
if (fsym->ts.u.derived->components->as)
- gfc_set_descriptor_from_scalar (&parmse->pre, ctree,
- parmse->expr, e, cond_optional);
+ gfc_set_descriptor_from_scalar (&parmse->pre, ctree, parmse->expr,
+ e, cond_optional, caf_token);
else
{
tmp = fold_convert (TREE_TYPE (ctree), parmse->expr);
