[gcc(refs/users/mikael/heads/refactor_descriptor_v08)] Renseignement token dans gcf_set_descriptor_from_scalar

[Mikael Morin]

https://gcc.gnu.org/g:ff179b8a8ff6839473b6a7e57f6acc74ebe9f755

commit ff179b8a8ff6839473b6a7e57f6acc74ebe9f755
Author: Mikael Morin <mikael@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 253d6638f2ed..87ddf839a931 100644
--- a/gcc/fortran/trans-descriptor.cc
+++ b/gcc/fortran/trans-descriptor.cc
@@ -955,11 +955,13 @@ gfc_set_descriptor_from_scalar_class (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 79db264c91c1..9284320f0ba1 100644
--- a/gcc/fortran/trans-descriptor.h
+++ b/gcc/fortran/trans-descriptor.h
@@ -103,6 +103,6 @@ void gfc_init_descriptor_variable (stmtblock_t *block, gfc_symbol *sym, tree des
 void gfc_set_descriptor_from_scalar_class (stmtblock_t *, tree, tree, gfc_expr *);
 void gfc_set_descriptor_from_scalar (stmtblock_t *, tree, tree);
 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 a72af35fa298..7bb2f01f7366 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);