https://gcc.gnu.org/g:1eff555014c646b5d40b4dff1b077fa13e307b20
commit 1eff555014c646b5d40b4dff1b077fa13e307b20
Author: Mikael Morin <mik...@gcc.gnu.org>
Date: Wed Jul 23 09:44:49 2025 +0200
Renseignement token dans gcf_set_descriptor_from_scalar
Correction renseignement token
Diff:
---
gcc/fortran/trans-descriptor.cc | 10 ++++++----
gcc/fortran/trans-descriptor.h | 2 +-
gcc/fortran/trans-expr.cc | 16 +++++++++++-----
3 files changed, 18 insertions(+), 10 deletions(-)
diff --git a/gcc/fortran/trans-descriptor.cc b/gcc/fortran/trans-descriptor.cc
index d5821e406a7e..a46278107fa8 100644
--- a/gcc/fortran/trans-descriptor.cc
+++ b/gcc/fortran/trans-descriptor.cc
@@ -1053,11 +1053,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 (TREE_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 (TREE_TYPE (scalar),
+ gfc_expr_attr (scalar_expr));
gfc_conv_descriptor_dtype_set (block, descr,
gfc_get_dtype (type));
if (cond_presence)
diff --git a/gcc/fortran/trans-descriptor.h b/gcc/fortran/trans-descriptor.h
index 06c429165bc0..25d9d06a2143 100644
--- a/gcc/fortran/trans-descriptor.h
+++ b/gcc/fortran/trans-descriptor.h
@@ -105,6 +105,6 @@ void gfc_init_descriptor_variable (stmtblock_t *block,
gfc_symbol *sym, tree des
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 dda2c10cbe2f..909803f837f5 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -806,6 +806,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);
@@ -822,12 +823,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)
@@ -893,8 +899,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);
