[gcc(refs/users/mikael/heads/refactor_descriptor_v01)] Correction assertion même type

[Mikael Morin via Gcc-cvs]

https://gcc.gnu.org/g:5035a9adb9d74b2e1a8cd9cbc2a4d307017114ab

commit 5035a9adb9d74b2e1a8cd9cbc2a4d307017114ab
Author: Mikael Morin <mik...@gcc.gnu.org>
Date:   Thu Dec 19 15:19:50 2024 +0100

    Correction assertion même type

Diff:
---
 gcc/fortran/trans-expr.cc | 34 +++++++++++++++++++++++++++++++---
 1 file changed, 31 insertions(+), 3 deletions(-)

diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index 2aed5a02e17f..003754cdad6f 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -828,9 +828,27 @@ gfc_get_vptr_from_expr (tree expr)
   return NULL_TREE;
 }
 
+
+static int
+descriptor_rank (tree descriptor)
+{
+  tree dim = gfc_get_descriptor_dimension (descriptor);
+  tree dim_type = TREE_TYPE (dim);
+  gcc_assert (TREE_CODE (dim_type) == ARRAY_TYPE);
+  tree idx_type = TYPE_DOMAIN (dim_type);
+  gcc_assert (TREE_CODE (idx_type) == INTEGER_TYPE);
+  gcc_assert (integer_zerop (TYPE_MIN_VALUE (idx_type)));
+  tree idx_max = TYPE_MAX_VALUE (idx_type);
+  if (idx_max == NULL_TREE)
+    return GFC_MAX_DIMENSIONS;
+  wide_int max = wi::to_wide (idx_max);
+  return max.to_shwi () + 1;
+}
+
+
 void
 gfc_class_array_data_assign (stmtblock_t *block, tree lhs_desc, tree rhs_desc,
-                            bool lhs_type)
+                            bool)
 {
   tree tmp, tmp2, type;
 
@@ -846,8 +864,18 @@ gfc_class_array_data_assign (stmtblock_t *block, tree 
lhs_desc, tree rhs_desc,
   tmp = gfc_get_descriptor_dimension (lhs_desc);
   tmp2 = gfc_get_descriptor_dimension (rhs_desc);
 
-  gcc_assert (TREE_TYPE (tmp) == TREE_TYPE (tmp2));
-  type = lhs_type ? TREE_TYPE (tmp) : TREE_TYPE (tmp2);
+  int rank = descriptor_rank (lhs_desc);
+  int rank2 = descriptor_rank (rhs_desc);
+  if (rank == GFC_MAX_DIMENSIONS && rank2 != GFC_MAX_DIMENSIONS)
+    type = TREE_TYPE (tmp2);
+  else if (rank2 == GFC_MAX_DIMENSIONS && rank != GFC_MAX_DIMENSIONS)
+    type = TREE_TYPE (tmp);
+  else
+    {
+      gcc_assert (TREE_TYPE (tmp) == TREE_TYPE (tmp2));
+      type = TREE_TYPE (tmp);
+    }
+
   tmp = build4_loc (input_location, ARRAY_RANGE_REF, type, tmp,
                    gfc_index_zero_node, NULL_TREE, NULL_TREE);
   tmp2 = build4_loc (input_location, ARRAY_RANGE_REF, type, tmp2,