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

https://gcc.gnu.org/g:45768335208274cdd1010a8da430a59690e39a19

commit 45768335208274cdd1010a8da430a59690e39a19
Author: Mikael Morin <[email protected]>
Date:   Wed Aug 19 14:21:58 2026 +0200

    Sauvegarde
    
    Correction supplémentaire class_optional_2 PASS
    
    Sauvegarde
    
    Correction ICE
    
    Correction ICE
    
    Correction ICE
    
    Correction segfault
    
    Correction segfault
    
    Revert partiel "Sauvegarde"
    
    This reverts commit 87ef53599ab8a9cf251ea6b07e6d00104110c5fc.
    
    Simplification is_polymorphic_scalar_expr

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

diff --git a/gcc/fortran/trans-descriptor.cc b/gcc/fortran/trans-descriptor.cc
index 7a75b718f321..383322dbb8b2 100644
--- a/gcc/fortran/trans-descriptor.cc
+++ b/gcc/fortran/trans-descriptor.cc
@@ -919,6 +919,47 @@ 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.  */
+
+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))
+    {
+      tree field_decl = TREE_OPERAND (expr, 1);
+      tree name = DECL_NAME (field_decl);
+      if (strcmp (IDENTIFIER_POINTER (name), "_data") == 0)
+	{
+	  if (class_type != nullptr)
+	    *class_type = ctype;
+	  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);
+
+  return false;
+}
+
+
 /* Add code to BLOCK initializing the scalar descriptor DESCR, so that it
    represents the same data as the middle-end scalar class descriptor SCALAR
    corresponding to the front-end scalar polymorphic expression SCALAR_EXPR.
@@ -929,12 +970,11 @@ void
 gfc_set_descriptor_from_scalar_class (stmtblock_t *block, tree descr,
 				      tree scalar)
 {
-  tree scalar_type = TREE_TYPE (scalar);
-  tree etype = POINTER_TYPE_P (scalar_type)
-	       ? TREE_TYPE (scalar_type)
-	       : scalar_type;
+  tree class_type;
+  if (!is_polymorphic_scalar_expr (scalar, &class_type))
+    gcc_unreachable ();
   gfc_conv_descriptor_dtype_set (block, descr,
-				 gfc_get_dtype_rank_type (0, etype));
+				 gfc_get_dtype_rank_type (0, class_type));
   tree tmp = scalar;
   if (is_class_container_type (TREE_TYPE (tmp)))
     tmp = gfc_class_data_get (tmp);