[gcc(refs/users/mikael/heads/refactor_descriptor_v206.01)] fortran: array descriptor: Unwrap class descriptor element type [PR122521]

https://gcc.gnu.org/g:6cd7a3c23b4068943b3013b437a95f4d92371157

commit 6cd7a3c23b4068943b3013b437a95f4d92371157
Author: Mikael Morin <[email protected]>
Date:   Tue Aug 18 12:39:32 2026 +0200

    fortran: array descriptor: Unwrap class descriptor element type [PR122521]
    
    FAIL: unlimited_polymorphic_{1,32}, intent_out_19, associate_66
    
    -- >8 --
    
    In the scalar polymorphic case, use the class descriptor data pointer type
    as element type to initialize the scalar descriptor.
    
    Before this change, it was the class descriptor type itself that was used as
    element type.  It caused the element size field to be initialized with a
    wrong value.  I couldn't find a testcase where that value had an observable
    effect though.
    
    The use of the data pointer type makes it possible to have void that comes
    out as element type.  That's what is obtained in the unlimited polymorphic
    case: the data pointer type is void*, and the pointer type is unwrapped to
    get the value type.  This causes the dtype construction to trip on an assert
    because it's not prepared for a void type, as there's no size it can guess
    from it.  This is fixed by skipping the element length initialization if the
    input type is void.
    
            PR fortran/122521
    
    gcc/fortran/ChangeLog:
    
            * trans-descriptor.cc (gfc_build_dtype_constructor): Accept NULL
            size argument.  Don't build any initialization of the elem_len field
            if size is NULL.
            (gfc_set_descriptor_from_scalar_class): Use the data pointer type as
            element type.
            * trans-types.cc (gfc_get_dtype_rank_type): Clear the size by
            default.  Don't set it if the input type is void.
    
    Sauvegarde récupération type déclaré à partir de classe
    
    Correction régression intent_out_19, associate_66, unlimited_polymorphic_{1,32}

Diff:
---
 gcc/fortran/trans-descriptor.cc | 18 +++++++++--------
 gcc/fortran/trans-types.cc      | 45 +++++++++++++++++++++++++++++++++++++----
 2 files changed, 51 insertions(+), 12 deletions(-)

diff --git a/gcc/fortran/trans-descriptor.cc b/gcc/fortran/trans-descriptor.cc
index 340da26d29a2..70e8e703535d 100644
--- a/gcc/fortran/trans-descriptor.cc
+++ b/gcc/fortran/trans-descriptor.cc
@@ -646,15 +646,17 @@ gfc_build_dtype_constructor (tree size, int type, int rank)
   tree field;
   vec<constructor_elt, va_gc> *v = NULL;
 
-  gcc_assert (size);
-
-  STRIP_NOPS (size);
-  size = fold_convert (size_type_node, size);
   tree dtype_type_node = get_dtype_type_node ();
-  field = gfc_advance_chain (TYPE_FIELDS (dtype_type_node),
-			     GFC_DTYPE_ELEM_LEN);
-  CONSTRUCTOR_APPEND_ELT (v, field,
-			  fold_convert (TREE_TYPE (field), size));
+  if (size)
+    {
+      STRIP_NOPS (size);
+      size = fold_convert (size_type_node, size);
+      field = gfc_advance_chain (TYPE_FIELDS (dtype_type_node),
+				 GFC_DTYPE_ELEM_LEN);
+      CONSTRUCTOR_APPEND_ELT (v, field,
+			      fold_convert (TREE_TYPE (field), size));
+    }
+
   field = gfc_advance_chain (TYPE_FIELDS (dtype_type_node),
 			     GFC_DTYPE_VERSION);
   CONSTRUCTOR_APPEND_ELT (v, field,
diff --git a/gcc/fortran/trans-types.cc b/gcc/fortran/trans-types.cc
index 50c5f0304ddf..6922f40fbf95 100644
--- a/gcc/fortran/trans-types.cc
+++ b/gcc/fortran/trans-types.cc
@@ -1698,6 +1698,34 @@ gfc_get_desc_dim_type (void)
 }
 
 
+/* Return the declared type of any data accessible through a class container
+   of type CLASS_TYPE.  In other words, given class(foo) return foo.  */
+   
+tree
+gfc_class_declared_type (tree class_type)
+{
+  gcc_assert (GFC_CLASS_TYPE_P (class_type));
+  tree data_field = TYPE_FIELDS (class_type);
+  gcc_checking_assert (TREE_CODE (data_field) == FIELD_DECL
+		       && DECL_NAME (data_field)
+		       && strcmp (IDENTIFIER_POINTER (DECL_NAME (data_field)),
+				  "_data")
+			  == 0);
+
+  tree ptr_type = TREE_TYPE (data_field);
+  if (GFC_DESCRIPTOR_TYPE_P (ptr_type))
+    ptr_type = GFC_TYPE_ARRAY_DATAPTR_TYPE (ptr_type);
+  gcc_assert (POINTER_TYPE_P (ptr_type));
+
+  tree element_type = TREE_TYPE (ptr_type);
+  if (TREE_CODE (element_type) == ARRAY_TYPE
+      && !TYPE_STRING_FLAG (element_type))
+    element_type = TREE_TYPE (element_type);
+
+  return element_type;
+}
+
+
 /* Return the DTYPE for an array.  This describes the type and type parameters
    of the array.  */
 /* TODO: Only call this when the value is actually used, and make all the
@@ -1707,7 +1735,6 @@ tree
 gfc_get_dtype_rank_type (int rank, tree etype)
 {
   tree ptype;
-  tree size;
   int n;
 
   ptype = etype;
@@ -1749,7 +1776,10 @@ gfc_get_dtype_rank_type (int rank, tree etype)
 
     case RECORD_TYPE:
       if (GFC_CLASS_TYPE_P (etype))
-	n = BT_CLASS;
+	{
+	  n = BT_CLASS;
+	  etype = gfc_class_declared_type (etype);
+	}
       else
 	n = BT_DERIVED;
       break;
@@ -1765,6 +1795,7 @@ gfc_get_dtype_rank_type (int rank, tree etype)
       gcc_unreachable ();
     }
 
+  tree size = NULL_TREE;
   switch (n)
     {
     case BT_CHARACTER:
@@ -1772,9 +1803,15 @@ gfc_get_dtype_rank_type (int rank, tree etype)
       size = gfc_get_character_len_in_bytes (ptype);
       break;
     case BT_VOID:
-      gcc_assert (TREE_CODE (ptype) == POINTER_TYPE);
-      size = size_in_bytes (ptype);
+      if (TREE_CODE (ptype) == POINTER_TYPE)
+	size = size_in_bytes (ptype);
       break;
+    case BT_CLASS:
+      if (VOID_TYPE_P (etype))
+	break;
+      /* For classes, the element length isn't a known constant, we set it to
+         the declared type length instead if possible.  */
+      /* Fall through.  */
     default:
       size = size_in_bytes (etype);
       break;