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

https://gcc.gnu.org/g:4334e13cb7d2881c8fd84c35f22dd0785ca27ec9

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

    fortran: array descriptor: Add token to scalar descriptor init [PR122521]
    
    TODO: tester
    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 a6b5a610ad7d..3c832d2c56a0 100644
--- a/gcc/fortran/trans-descriptor.cc
+++ b/gcc/fortran/trans-descriptor.cc
@@ -848,11 +848,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);