https://gcc.gnu.org/g:4cf0bfc9ea46cdcd4372780dd4f11b630c10f2dc

commit 4cf0bfc9ea46cdcd4372780dd4f11b630c10f2dc
Author: Mikael Morin <mik...@gcc.gnu.org>
Date:   Sat Apr 19 14:53:51 2025 +0200

    Correction régression dependency_60.f90

Diff:
---
 gcc/fortran/trans-array.cc      |  4 +++-
 gcc/fortran/trans-descriptor.cc | 25 +++++++++++++++++++++++++
 2 files changed, 28 insertions(+), 1 deletion(-)

diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index d0a205fef90b..75802c9a0b02 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -2836,7 +2836,9 @@ gfc_add_loop_ss_code (gfc_loopinfo * loop, gfc_ss * ss, 
bool subscript,
          trans_array_constructor (ss, where);
          {
            gcc_assert (info->shape != nullptr || ss->dimen == 1);
-           tree type = gfc_typenode_for_spec (&ss_info->expr->ts);
+           tree type = gfc_typenode_for_spec (ss_info->expr->ts.type == 
BT_CLASS
+                                              ? &CLASS_DATA (ss_info->expr)->ts
+                                              : &ss_info->expr->ts);
            if (ss_info->expr->ts.type == BT_CHARACTER
                && ss_info->expr->ts.u.cl->length
                && ss_info->expr->ts.u.cl->length->expr_type == EXPR_CONSTANT)
diff --git a/gcc/fortran/trans-descriptor.cc b/gcc/fortran/trans-descriptor.cc
index 3ae5a2a2dea3..cb2dd86f6522 100644
--- a/gcc/fortran/trans-descriptor.cc
+++ b/gcc/fortran/trans-descriptor.cc
@@ -3879,12 +3879,37 @@ gfc_grow_array (stmtblock_t * pblock, tree desc, tree 
extra)
 
   /* Calculate the new array size.  */
   size = TYPE_SIZE_UNIT (gfc_get_element_type (TREE_TYPE (desc)));
+  gcc_assert (integer_zerop (GFC_TYPE_ARRAY_LBOUND (TREE_TYPE (desc), 0)));
   tmp = fold_build2_loc (input_location, PLUS_EXPR, gfc_array_index_type,
                         ubound, gfc_index_one_node);
   arg1 = fold_build2_loc (input_location, MULT_EXPR, size_type_node,
                          fold_convert (size_type_node, tmp),
                          fold_convert (size_type_node, size));
 
+  /* Reset array type upper bound if known.  */
+  tree dataptr_type = GFC_TYPE_ARRAY_DATAPTR_TYPE (TREE_TYPE (desc));
+  gcc_assert (TREE_CODE (dataptr_type) == POINTER_TYPE);
+  tree array_type = TREE_TYPE (dataptr_type);
+  gcc_assert (TREE_CODE (array_type) == ARRAY_TYPE);
+  tree index_type = TYPE_DOMAIN (array_type);
+  if (index_type != NULL_TREE
+      && (TYPE_MAX_VALUE (index_type) != NULL_TREE
+         || TYPE_SIZE (array_type) != NULL_TREE
+         || TYPE_SIZE_UNIT (array_type) != NULL_TREE))
+    {
+      tree fixed_index_type = build_distinct_type_copy (index_type);
+      TYPE_MAX_VALUE (fixed_index_type) = NULL_TREE;
+
+      tree fixed_array_type = build_distinct_type_copy (array_type);
+      TYPE_DOMAIN (fixed_array_type) = fixed_index_type;
+      TYPE_SIZE (fixed_array_type) = NULL_TREE;
+      TYPE_SIZE_UNIT (fixed_array_type) = NULL_TREE;
+      layout_type (fixed_array_type);
+
+      tree fixed_ptr_type = build_pointer_type (fixed_array_type);
+      GFC_TYPE_ARRAY_DATAPTR_TYPE (TREE_TYPE (desc)) = fixed_ptr_type;
+    }
+
   /* Call the realloc() function.  */
   tmp = gfc_call_realloc (pblock, arg0, arg1);
   gfc_conv_descriptor_data_set (pblock, desc, tmp);

Reply via email to