https://gcc.gnu.org/g:467f55e0bcb1fe13d2f18c37433dc22b24ad1048

commit 467f55e0bcb1fe13d2f18c37433dc22b24ad1048
Author: Mikael Morin <mik...@gcc.gnu.org>
Date:   Sun Sep 14 13:43:25 2025 +0200

    Correction régression pdt_31
    
    Correction régression transfer_class_5
    
    Correction régression class_dummy_11.f90

Diff:
---
 gcc/fortran/trans-descriptor.cc | 25 ++++++++++++++++++++++++-
 libgfortran/libgfortran.h       |  2 +-
 2 files changed, 25 insertions(+), 2 deletions(-)

diff --git a/gcc/fortran/trans-descriptor.cc b/gcc/fortran/trans-descriptor.cc
index 55e2798234b4..3fa03c5fc234 100644
--- a/gcc/fortran/trans-descriptor.cc
+++ b/gcc/fortran/trans-descriptor.cc
@@ -1606,6 +1606,9 @@ gfc_copy_descriptor (stmtblock_t *block, tree dest, tree 
src, bool lhs_type)
   gfc_conv_descriptor_dtype_set (block, dest,
                                 gfc_conv_descriptor_dtype_get (src));
 
+  gfc_conv_descriptor_span_set (block, dest,
+                               gfc_conv_descriptor_span_get (src));
+
   /* Assign the dimension as range-ref.  */
   tree tmp = gfc_get_descriptor_dimension (dest);
   tree tmp2 = gfc_get_descriptor_dimension (src);
@@ -1802,7 +1805,25 @@ gfc_set_descriptor (stmtblock_t *block, tree dest, tree 
src, gfc_expr *src_expr,
   /* Set the dtype.  */
   tree dtype;
   if (unlimited_polymorphic)
-    dtype = gfc_get_dtype (TREE_TYPE (src), &rank);
+    {
+      if (UNLIMITED_POLY (src_expr))
+       {
+         tree tmp2 = src;
+         if (TREE_CODE (tmp2) == INDIRECT_REF
+             && DECL_P (TREE_OPERAND (tmp2, 0)))
+           tmp2 = TREE_OPERAND (tmp2, 0);
+         if (DECL_P (tmp2)
+             && DECL_LANG_SPECIFIC (tmp2)
+             && GFC_DECL_SAVED_DESCRIPTOR (tmp2))
+           tmp2 = GFC_DECL_SAVED_DESCRIPTOR (tmp2);
+         tmp2 = gfc_class_data_get (tmp2);
+         if (POINTER_TYPE_P (TREE_TYPE (tmp2)))
+           tmp2 = build_fold_indirect_ref_loc (input_location, tmp2);
+         dtype = gfc_conv_descriptor_dtype_get (tmp2);
+       }
+      else
+       dtype = gfc_get_dtype (TREE_TYPE (src), &rank);
+    }
   else if (src_expr->ts.type == BT_ASSUMED)
     {
       tree tmp2 = src;
@@ -2635,6 +2656,8 @@ gfc_set_pdt_array_descriptor (stmtblock_t *block, tree 
descr,
   gfc_conv_descriptor_dtype_set (block, descr,
                                 gfc_get_dtype (TREE_TYPE (descr)));
 
+  gfc_conv_descriptor_span_set (block, descr, elt_size);
+
   size = fold_build2_loc (input_location, MULT_EXPR,
                          gfc_array_index_type, size, elt_size);
   size = gfc_evaluate_now (size, block);
diff --git a/libgfortran/libgfortran.h b/libgfortran/libgfortran.h
index 5cdd564ab0e6..5937cac4c365 100644
--- a/libgfortran/libgfortran.h
+++ b/libgfortran/libgfortran.h
@@ -485,7 +485,7 @@ typedef GFC_FULL_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS, 
GFC_INTEGER_4) gfc_full_a
 
 #define GFC_DESCRIPTOR_STRIDE(desc,i) ((desc)->dim[i]._stride)
 #define GFC_DESCRIPTOR_STRIDE_BYTES(desc,i) \
-  (GFC_DESCRIPTOR_STRIDE(desc,i) * GFC_DESCRIPTOR_SIZE(desc))
+  (GFC_DESCRIPTOR_STRIDE(desc,i) * GFC_DESCRIPTOR_SPAN(desc))
 
 /* Macros to get both the size and the type with a single masking operation  */

Reply via email to