[gcc(refs/users/mikael/heads/refactor_descriptor_v05)] Correction régression associate_target_5

[Mikael Morin]

https://gcc.gnu.org/g:0b82f23024b41a8775e2ec90ed1ecaf24e8b96a2

commit 0b82f23024b41a8775e2ec90ed1ecaf24e8b96a2
Author: Mikael Morin <mikael@gcc.gnu.org>
Date:   Wed Jun 4 17:25:14 2025 +0200

    Correction régression associate_target_5

Diff:
---
 gcc/fortran/trans-array.cc      | 33 ++++++++++++++++++++++++++++++++-
 gcc/fortran/trans-descriptor.cc | 13 +++++++++++--
 gcc/fortran/trans-descriptor.h  |  2 +-
 3 files changed, 44 insertions(+), 4 deletions(-)

diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index bc902c5a89fb..43b5ec7339d2 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -7862,9 +7862,40 @@ gfc_conv_expr_descriptor (gfc_se *se, gfc_expr *expr)
 			  gfc_get_array_span (desc, expr)));
 	}
 
+      tree elem_len = NULL_TREE;
+      if (subref_array_target)
+	{
+	  /* In case of subreferences, don't pick element size from the original
+	     descriptor.  */
+	  if (expr->ts.type == BT_CLASS)
+	    {
+	      tree class_container = ss->info->class_container;
+	      tree vptr = gfc_class_vptr_get (class_container);
+	      elem_len = gfc_vptr_size_get (vptr);
+	    }
+	  else if (expr->ts.type == BT_CHARACTER)
+	    {
+	      tree slen = ss->info->string_length;
+	      slen = fold_convert_loc (input_location, gfc_array_index_type,
+				       slen);
+	      tree kind = build_int_cst (gfc_array_index_type,
+					 expr->ts.kind);
+	      elem_len = fold_build2_loc (input_location, MULT_EXPR,
+					  gfc_array_index_type, slen, kind);
+	    }
+	  else 
+	    {
+	      tree elem_type = gfc_get_element_type (TREE_TYPE (parm));
+	      elem_len = TYPE_SIZE_UNIT (elem_type);
+	    }
+
+	  elem_len = fold_convert_loc (input_location, gfc_array_index_type,
+				       elem_len);
+	}
+
       gfc_set_descriptor (&loop.pre, parm, desc, expr, loop.dimen, codim,
 			  ss, info, loop.from, loop.to, !se->data_not_needed,
-			  subref_array_target, !se->direct_byref);
+			  subref_array_target, !se->direct_byref, elem_len);
 
       desc = parm;
     }
diff --git a/gcc/fortran/trans-descriptor.cc b/gcc/fortran/trans-descriptor.cc
index 23e1cd09a8e9..acbdceac77db 100644
--- a/gcc/fortran/trans-descriptor.cc
+++ b/gcc/fortran/trans-descriptor.cc
@@ -3064,13 +3064,19 @@ gfc_set_descriptor (stmtblock_t *block, tree dest, tree src, gfc_expr *src_expr,
 		    int rank, int corank, gfc_ss *ss, gfc_array_info *info,
 		    tree lowers[GFC_MAX_DIMENSIONS],
 		    tree uppers[GFC_MAX_DIMENSIONS], bool data_needed,
-		    bool subref, bool update_spacing_in_type)
+		    bool subref, bool update_spacing_in_type,
+		    tree elem_len)
 {
   int ndim = info->ref ? info->ref->u.ar.dimen : rank;
 
   /* Set the span field.  */
   tree tmp = NULL_TREE;
-  if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (src)))
+  if (subref)
+    {
+      gcc_assert (elem_len != NULL_TREE);
+      tmp = elem_len;
+    }
+  else if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (src)))
     tmp = gfc_conv_descriptor_span_get (src);
   else
     tmp = gfc_get_array_span (src, src_expr);
@@ -3101,6 +3107,9 @@ gfc_set_descriptor (stmtblock_t *block, tree dest, tree src, gfc_expr *src_expr,
     dtype = get_descriptor_dtype (src, &rank);
   gfc_conv_descriptor_dtype_set (block, dest, dtype);
 
+  if (subref)
+    gfc_conv_descriptor_elem_len_set (block, dest, elem_len);
+
   /* The 1st element in the section.  */
   tree base = gfc_index_zero_node;
 
diff --git a/gcc/fortran/trans-descriptor.h b/gcc/fortran/trans-descriptor.h
index 37dd4ea68243..7285157466b9 100644
--- a/gcc/fortran/trans-descriptor.h
+++ b/gcc/fortran/trans-descriptor.h
@@ -91,7 +91,7 @@ void gfc_set_temporary_descriptor (stmtblock_t *, tree, tree, tree, tree,
 
 void gfc_set_descriptor (stmtblock_t *, tree, tree, gfc_expr *, int, int,
 			 gfc_ss *, gfc_array_info *, tree [GFC_MAX_DIMENSIONS],
-			 tree [GFC_MAX_DIMENSIONS], bool, bool, bool);
+			 tree [GFC_MAX_DIMENSIONS], bool, bool, bool, tree);
 
 tree gfc_descr_init_count (tree, int, int, gfc_expr **, gfc_expr **,
 			   stmtblock_t *, stmtblock_t *, tree *, tree,