[gcc r17-2549] fortran: array descriptor: Add a setter for the token field [PR122521]

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

commit r17-2549-ga2031842428f3507c2624adbeebe57c9d926dbbf
Author: Mikael Morin <[email protected]>
Date:   Mon Jul 20 11:09:22 2026 +0200

    fortran: array descriptor: Add a setter for the token field [PR122521]
    
    Add a setter function to set the value of the token field of array
    descriptors.
    
    Contrary to the preceding patches touching the other fields, this one
    doesn't create a getter and retains direct access to the field.  Indeed,
    token is special because its address is taken and passed to library
    functions to implement coarray behaviour.
    
            PR fortran/122521
    
    gcc/fortran/ChangeLog:
    
            * trans-descriptor.cc (gfc_conv_descriptor_token_set): New function.
            * trans-descriptor.h (gfc_conv_descriptor_token_set): New
            declaration.
            * trans-array.cc (gfc_conv_expr_descriptor,
            gfc_conv_array_parameter, gfc_trans_deferred_array): Use
            gfc_conv_descriptor_token_set to set the value of the token.
            * trans-expr.cc (gfc_conv_derived_to_class,
            gfc_trans_subcomponent_assign, gfc_trans_scalar_assign): Likewise.
            * trans-intrinsic.cc (conv_intrinsic_move_alloc): Likewise.

Diff:
---
 gcc/fortran/trans-array.cc      | 12 +++++-------
 gcc/fortran/trans-descriptor.cc | 16 ++++++++++++++++
 gcc/fortran/trans-descriptor.h  |  1 +
 gcc/fortran/trans-expr.cc       | 12 +++++-------
 gcc/fortran/trans-intrinsic.cc  |  3 +--
 5 files changed, 28 insertions(+), 16 deletions(-)

diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index aa4ca1a8bc10..6d73b2370e90 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -8609,7 +8609,7 @@ gfc_conv_expr_descriptor (gfc_se *se, gfc_expr *expr)
 	      tmp = GFC_TYPE_ARRAY_CAF_TOKEN (TREE_TYPE (tmp));
 	    }
 
-	  gfc_add_modify (&loop.pre, gfc_conv_descriptor_token (parm), tmp);
+	  gfc_conv_descriptor_token_set (&loop.pre, parm, tmp);
 	}
       desc = parm;
     }
@@ -9257,7 +9257,7 @@ gfc_conv_array_parameter (gfc_se *se, gfc_expr *expr, bool g77,
 	    {
 	      /* The original descriptor may have transposed dims so we
 		 can't reuse it directly; we have to create a new one.  */
-	      tree old_field, new_field;
+	      tree old_field;
 	      tree old_desc = tmp;
 	      tree new_desc = gfc_create_var (TREE_TYPE (old_desc), "arg_desc");
 
@@ -9375,8 +9375,8 @@ gfc_conv_array_parameter (gfc_se *se, gfc_expr *expr, bool g77,
 		     == GFC_ARRAY_ALLOCATABLE)
 		{
 		  old_field = gfc_conv_descriptor_token (old_desc);
-		  new_field = gfc_conv_descriptor_token (new_desc);
-		  gfc_add_modify (&se->pre, new_field, old_field);
+		  gfc_conv_descriptor_token_set (&se->pre, new_desc,
+						 old_field);
 		}
 
 	      gfc_conv_descriptor_data_set (&se->pre, new_desc, ptr);
@@ -12447,9 +12447,7 @@ gfc_trans_deferred_array (gfc_symbol * sym, gfc_wrapped_block * block)
 	     image.  This may happen, for example, with the caf_mpi
 	     implementation.  */
 	  TREE_STATIC (descriptor) = 1;
-	  tmp = gfc_conv_descriptor_token (descriptor);
-	  gfc_add_modify (&init, tmp, fold_convert (TREE_TYPE (tmp),
-						    null_pointer_node));
+	  gfc_conv_descriptor_token_set (&init, descriptor, null_pointer_node);
 	}
     }
 
diff --git a/gcc/fortran/trans-descriptor.cc b/gcc/fortran/trans-descriptor.cc
index 61d5cf3c1894..72c8b9c5f2b1 100644
--- a/gcc/fortran/trans-descriptor.cc
+++ b/gcc/fortran/trans-descriptor.cc
@@ -424,6 +424,9 @@ conv_descriptor_dimension (tree desc, tree dim)
 }
 
 
+/* Return a reference to the coarray token field of the array descriptor
+   DESC.  */
+
 tree
 gfc_conv_descriptor_token (tree desc)
 {
@@ -435,6 +438,19 @@ gfc_conv_descriptor_token (tree desc)
   return field;
 }
 
+/* Add code to BLOCK assigning VALUE to the coarray token field of the array
+   descriptor DESC.  */
+
+void
+gfc_conv_descriptor_token_set (stmtblock_t *block, tree desc, tree value)
+{
+  location_t loc = input_location;
+  tree t = gfc_conv_descriptor_token (desc);
+  gfc_add_modify_loc (loc, block, t,
+		      fold_convert_loc (loc, TREE_TYPE (t), value));
+}
+
+
 static tree
 gfc_conv_descriptor_subfield (tree desc, tree dim, unsigned field_idx)
 {
diff --git a/gcc/fortran/trans-descriptor.h b/gcc/fortran/trans-descriptor.h
index a17d4aca9e47..081bb45ef074 100644
--- a/gcc/fortran/trans-descriptor.h
+++ b/gcc/fortran/trans-descriptor.h
@@ -51,6 +51,7 @@ void gfc_conv_descriptor_span_set (stmtblock_t *, tree, tree);
 void gfc_conv_descriptor_stride_set (stmtblock_t *, tree, tree, tree);
 void gfc_conv_descriptor_lbound_set (stmtblock_t *, tree, tree, tree);
 void gfc_conv_descriptor_ubound_set (stmtblock_t *, tree, tree, tree);
+void gfc_conv_descriptor_token_set (stmtblock_t *block, tree desc, tree value);
 
 /* Build expressions for accessing components of an array descriptor.  */
 void gfc_get_descriptor_offsets_for_info (const_tree, tree *, tree *, tree *,
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index f1a9ea220c49..df029bfd1140 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -894,7 +894,7 @@ gfc_conv_derived_to_class (gfc_se *parmse, gfc_expr *e, gfc_symbol *fsym,
       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_add_modify (&parmse->pre, gfc_conv_descriptor_token (ctree), token);
+      gfc_conv_descriptor_token_set (&parmse->pre, ctree, token);
     }
 
   if (optional)
@@ -10137,8 +10137,7 @@ gfc_trans_subcomponent_assign (tree dest, gfc_component * cm,
 	{
 	  gfc_conv_descriptor_data_set (&block, dest, null_pointer_node);
 	  if (cm->attr.codimension && flag_coarray == GFC_FCOARRAY_LIB)
-	    gfc_add_modify (&block, gfc_conv_descriptor_token (dest),
-			    null_pointer_node);
+	    gfc_conv_descriptor_token_set (&block, dest, null_pointer_node);
 	}
       else if (cm->attr.allocatable || cm->attr.pdt_array)
 	{
@@ -11980,10 +11979,9 @@ gfc_trans_scalar_assign (gfc_se *lse, gfc_se *rse, gfc_typespec ts,
 	{
 	  if (flag_coarray == GFC_FCOARRAY_LIB && assoc_assign)
 	    {
-	      gfc_add_modify (&block, gfc_conv_descriptor_token (lse->expr),
-			      TYPE_LANG_SPECIFIC (
-				TREE_TYPE (TREE_TYPE (rse->expr)))
-				->caf_token);
+	      tree rtype = TREE_TYPE (TREE_TYPE (rse->expr));
+	      tree rtoken = TYPE_LANG_SPECIFIC (rtype)->caf_token;
+	      gfc_conv_descriptor_token_set (&block, lse->expr, rtoken);
 	    }
 	  if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (lse->expr)))
 	    lse->expr = gfc_conv_array_data (lse->expr);
diff --git a/gcc/fortran/trans-intrinsic.cc b/gcc/fortran/trans-intrinsic.cc
index 2c0af0c41fc6..bb0499ad7b3c 100644
--- a/gcc/fortran/trans-intrinsic.cc
+++ b/gcc/fortran/trans-intrinsic.cc
@@ -13607,8 +13607,7 @@ conv_intrinsic_move_alloc (gfc_code *code)
     {
       /* Copy the array descriptor data has overwritten the to-token and cleared
 	 from.data.  Now also clear the from.token.  */
-      gfc_add_modify (&block, gfc_conv_descriptor_token (from_se.expr),
-		      null_pointer_node);
+      gfc_conv_descriptor_token_set (&block, from_se.expr, null_pointer_node);
     }
 
   if (to_expr->ts.type == BT_CHARACTER && to_expr->ts.deferred)