[gcc(refs/users/mikael/heads/refactor_descriptor_v206.01)] fortran: array descriptor: Add token init to descriptor init [PR122521]

https://gcc.gnu.org/g:4abf42a25508930bf5f256d050409285551c3d63

commit 4abf42a25508930bf5f256d050409285551c3d63
Author: Mikael Morin <[email protected]>
Date:   Mon Aug 10 22:20:25 2026 +0200

    fortran: array descriptor: Add token init to descriptor init [PR122521]
    
    This one may be a bit controversial as its make the code rather more
    complex than simpler.  The purpose of this is to have all the descriptor
    initialization done in a single place.
    
    -- >8 --
    
    The function gfc_conv_derived_to_class has code to initialize the coarray
    token associated to the variable, and it is separated from the rest of
    the descriptor initialization.  Add coarray token initialization to
    the scalar descriptor initialization function, and skip it in
    gfc_conv_derived_to_class if the function is called.
    
            PR fortran/122521
    
    gcc/fortran/ChangeLog:
    
            * trans-descriptor.cc (gfc_set_descriptor_from_scalar): Add
            coarray token argument.  Initialize the descriptor coarray token
            with the new argument if non-null.
            * trans-descriptor.h (gfc_set_descriptor_from_scalar): Update
            prototype.
            * trans-expr.cc (gfc_conv_derived_to_class): Move the coarray token
            variable to the outer level and clear it by default.  Pass it as
            argument to the function gfc_set_descriptor_from_scalar.  Skip the
            descriptor coarray token initialization if the function is called.

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 00306e73f218..5c8cf4ee07f5 100644
--- a/gcc/fortran/trans-descriptor.cc
+++ b/gcc/fortran/trans-descriptor.cc
@@ -847,11 +847,13 @@ gfc_create_null_actual_descriptor (stmtblock_t *block, gfc_typespec *ts,
 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 2ca4e40b4c52..2154411602da 100644
--- a/gcc/fortran/trans-descriptor.h
+++ b/gcc/fortran/trans-descriptor.h
@@ -74,7 +74,7 @@ tree gfc_create_null_actual_descriptor (stmtblock_t *, gfc_typespec *,
 					symbol_attribute, int);
 
 void gfc_set_descriptor_from_scalar (stmtblock_t *, tree, tree, gfc_expr *,
-				     tree);
+				     tree, tree);
 void gfc_set_descriptor_from_scalar (stmtblock_t *, tree, tree);
 void gfc_set_descriptor_from_scalar_class (stmtblock_t *, tree, tree, gfc_expr *);
 
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);