[gcc(refs/users/mikael/heads/refactor_descriptor_v206.01)] Renseignement span

https://gcc.gnu.org/g:004891d499f62d4407f987c0f27bfc7cffce2bf8

commit 004891d499f62d4407f987c0f27bfc7cffce2bf8
Author: Mikael Morin <[email protected]>
Date:   Fri Aug 21 21:59:42 2026 +0200

    Renseignement span

Diff:
---
 gcc/fortran/trans-descriptor.cc | 79 +++++++++++++++++++++++------------------
 1 file changed, 45 insertions(+), 34 deletions(-)

diff --git a/gcc/fortran/trans-descriptor.cc b/gcc/fortran/trans-descriptor.cc
index 02a4187f2305..7f1ee347e457 100644
--- a/gcc/fortran/trans-descriptor.cc
+++ b/gcc/fortran/trans-descriptor.cc
@@ -917,44 +917,52 @@ is_class_container_type (tree type, tree *class_type = nullptr)
 }
 
 
-/* Return true if scalar EXPR is a polymorphic reference; otherwise return
-   false.  If CLASS_TYPE isn't nullptr, set its target to the class container
-   type in the true case, and leave it unmodified in the false case.  */
+/* Return true if EXPR is a polymorphic reference; otherwise return false.  If
+   CLASS_REF isn't nullptr, set its target to a reference to the class container
+   in the true case, and leave it unmodified in the false case.  */
 
 static bool
-is_polymorphic_scalar_expr (tree expr, tree *class_type = nullptr)
-{
-  if (is_class_container_type (TREE_TYPE (expr), class_type))
-    return true;
-
-  /* Try to detect class->_data or class->_data.data expressions.  */
-  STRIP_NOPS (expr);
-  if (TREE_CODE (expr) == INDIRECT_REF)
-    expr = TREE_OPERAND (expr, 0);
-  STRIP_NOPS (expr);
-  if (TREE_CODE (expr) != COMPONENT_REF)
-    return false;
-
-  tree base_type = TREE_TYPE (TREE_OPERAND (expr, 0));
-  tree ctype;
-  if (is_class_container_type (base_type, &ctype))
+is_polymorphic_expr (tree expr, tree *class_ref = nullptr)
+{
+  bool seen_component = false;
+  tree e = expr;
+  while (true)
     {
-      tree field_decl = TREE_OPERAND (expr, 1);
-      tree name = DECL_NAME (field_decl);
-      if (strcmp (IDENTIFIER_POINTER (name), "_data") == 0)
+      STRIP_NOPS (e);
+      if (TREE_CODE (e) == ADDR_EXPR)
+	;
+      else if (POINTER_TYPE_P (TREE_TYPE (e))
+	       && GFC_CLASS_TYPE_P (TREE_TYPE (TREE_TYPE (e))))
 	{
-	  if (class_type != nullptr)
-	    *class_type = ctype;
+	  if (class_ref != nullptr)
+	    class_ref = build_fold_indirect_ref_loc (input_location, e);
 	  return true;
 	}
-    }
-
-  /* We can have an array descriptor for scalar coarrays.  */
-  else if (GFC_DESCRIPTOR_TYPE_P (base_type))
-    return is_polymorphic_scalar_expr (TREE_OPERAND (expr, 0),
-				       class_type);
+      else if (GFC_CLASS_TYPE_P (TREE_TYPE (e)))
+	{
+	  if (class_ref != nullptr)
+	    *class_ref = e;
+	  return true;
+	}
+      else if (TREE_CODE (e) == COMPONENT_REF)
+	{
+	  seen_component = true;
+	  tree base_obj = TREE_OPERAND (e, 0);
+	  tree field_decl = TREE_OPERAND (e, 1);
+	  tree field_name = DECL_NAME (field_decl);
+	  if (!((GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (base_obj))
+		 && strcmp (IDENTIFIER_POINTER (field_name), "data") == 0)
+		|| (GFC_CLASS_TYPE_P (TREE_TYPE (base_obj))
+		    && strcmp (IDENTIFIER_POINTER (field_name), "_data") == 0)))
+	    return false;
+	}
+      else if (!(TREE_CODE (e) == INDIRECT_REF
+		 || TREE_CODE (e) == ARRAY_REF
+		 || TREE_CODE (e) == POINTER_PLUS_EXPR))
+	return false;
 
-  return false;
+      e = TREE_OPERAND (e, 0);
+    }
 }
 
 
@@ -968,8 +976,8 @@ void
 gfc_set_descriptor_from_scalar_class (stmtblock_t *block, tree descr,
 				      tree scalar)
 {
-  tree class_type;
-  if (!is_polymorphic_scalar_expr (scalar, &class_type))
+  tree class_ref;
+  if (!is_polymorphic_expr (scalar, &class_ref))
     gcc_unreachable ();
 
   tree tmp = scalar;
@@ -977,7 +985,10 @@ gfc_set_descriptor_from_scalar_class (stmtblock_t *block, tree descr,
     tmp = gfc_class_data_get (tmp);
   gcc_assert (POINTER_TYPE_P (TREE_TYPE (tmp)));
 
-  set_descriptor_from_scalar (block, descr, class_type, tmp, NULL_TREE);
+  set_descriptor_from_scalar (block, descr, TREE_TYPE (class_ref), tmp,
+			      NULL_TREE);
+  gfc_conv_descriptor_elem_len_set (block, descr,
+				    gfc_class_vtab_size_get (class_ref));
 }