[gcc(refs/users/mikael/heads/refactor_descriptor_v206.01)] Renseignement token dans gcf_set_descriptor_from_scalar

Mikael Morin via Gcc-cvs <[email protected]> Thu, 6 Aug 2026 12:13:16 +0000 (GMT)
Newsgroups gmane.comp.gcc.cvs
Message-ID <[email protected]>
https://gcc.gnu.org/g:f1fa9fb263bb4f6bf2e140b57cc4c3113153cd5b

commit f1fa9fb263bb4f6bf2e140b57cc4c3113153cd5b
Author: Mikael Morin <[email protected]>
Date:   Thu Aug 6 12:10:28 2026 +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 c608d9d5f4cb..5b3e1e8f527e 100644
--- a/gcc/fortran/trans-descriptor.cc
+++ b/gcc/fortran/trans-descriptor.cc
@@ -1010,11 +1010,13 @@ gfc_grow_array (stmtblock_t * pblock, tree desc, tree extra)
 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));
   gfc_copy_coarray_desc_part (block, descr, scalar);
diff --git a/gcc/fortran/trans-descriptor.h b/gcc/fortran/trans-descriptor.h
index a06e313b09b1..2cc0c7f13eaa 100644
--- a/gcc/fortran/trans-descriptor.h
+++ b/gcc/fortran/trans-descriptor.h
@@ -88,6 +88,6 @@ void gfc_copy_coarray_desc_part (stmtblock_t *, tree, tree);
 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 e9085efb57e7..f0dd56119bde 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -802,6 +802,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);
@@ -818,12 +819,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)
@@ -889,8 +895,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);