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

https://gcc.gnu.org/g:5755c367779072589c7b5911227bbd4c903c27f7

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

    fortran: array descriptor: Add token to scalar 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.
    Fortran-tested on aarch64-unknown-linux-gnu.  OK for mainline?
    
    -- >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 | 16 ++++++++++------
 gcc/fortran/trans-descriptor.h  |  2 +-
 gcc/fortran/trans-expr.cc       | 16 +++++++++++-----
 3 files changed, 22 insertions(+), 12 deletions(-)

diff --git a/gcc/fortran/trans-descriptor.cc b/gcc/fortran/trans-descriptor.cc
index 340da26d29a2..900d912e3a9e 100644
--- a/gcc/fortran/trans-descriptor.cc
+++ b/gcc/fortran/trans-descriptor.cc
@@ -850,17 +850,21 @@ gfc_create_null_actual_descriptor (stmtblock_t *block, gfc_typespec *ts,
    corresponding to the front-end scalar expression SCALAR_EXPR.  If
    COND_PRESENCE is set make the value assigned to the data field either SCALAR
    or nullptr depending on COND_PRESENCE; otherwise SCALAR unconditionally.
-   This is used to implement the argument association between the actual
-   argument SCALAR_EXPR and an assumed-rank dummy argument.  */
+   If CAF_TOKEN is set and the -fcoarray=lib compiler argument was present, set
+   the token field of the descriptor to CAF_TOKEN.  This is used to implement
+   the argument association between the actual argument SCALAR_EXPR and an
+   assumed-rank dummy argument.  */
 
 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 3d12e119dd09..7338cf2b97ff 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);