[gcc(refs/users/mikael/heads/refactor_descriptor_v05)] Correction régression guality/arg1

[Mikael Morin via Gcc-cvs]

https://gcc.gnu.org/g:14453f7d652df951b06c1e5959501c7a3c3c5fc7

commit 14453f7d652df951b06c1e5959501c7a3c3c5fc7
Author: Mikael Morin <mik...@gcc.gnu.org>
Date:   Mon May 5 17:03:44 2025 +0200

    Correction régression guality/arg1

Diff:
---
 gcc/fortran/trans-decl.cc  |  9 +++++++--
 gcc/fortran/trans-types.cc | 17 ++++++++++++++++-
 2 files changed, 23 insertions(+), 3 deletions(-)

diff --git a/gcc/fortran/trans-decl.cc b/gcc/fortran/trans-decl.cc
index 5807818a3ae6..b23be5937e7a 100644
--- a/gcc/fortran/trans-decl.cc
+++ b/gcc/fortran/trans-decl.cc
@@ -1264,10 +1264,15 @@ gfc_build_qualified_array (tree decl, gfc_symbol * sym)
     {
       tree size, range;
 
+      tree lower = TYPE_MIN_VALUE (TYPE_DOMAIN (type));
+      if (lower == NULL_TREE)
+       lower = gfc_index_zero_node;
+
       size = fold_build2_loc (input_location, MINUS_EXPR, gfc_array_index_type,
                              GFC_TYPE_ARRAY_SIZE (type), gfc_index_one_node);
-      range = build_range_type (gfc_array_index_type, gfc_index_zero_node,
-                               size);
+      size = fold_build2_loc (input_location, PLUS_EXPR, gfc_array_index_type,
+                             size, lower);
+      range = build_range_type (gfc_array_index_type, lower, size);
       TYPE_DOMAIN (type) = range;
       layout_type (type);
     }
diff --git a/gcc/fortran/trans-types.cc b/gcc/fortran/trans-types.cc
index 8af17d16406a..08a3ee37e6e9 100644
--- a/gcc/fortran/trans-types.cc
+++ b/gcc/fortran/trans-types.cc
@@ -1863,6 +1863,7 @@ gfc_get_nodesc_array_type (tree etype, gfc_array_spec * 
as, gfc_packed packed,
   mpz_t stride;
   mpz_t spc;
   mpz_t delta;
+  mpz_t *lbound0 = nullptr;
   gfc_expr *expr;
 
   mpz_init_set_ui (offset, 0);
@@ -1892,6 +1893,8 @@ gfc_get_nodesc_array_type (tree etype, gfc_array_spec * 
as, gfc_packed packed,
       expr = as->lower[n];
       if (expr && expr->expr_type == EXPR_CONSTANT)
         {
+         if (n == 0)
+           lbound0 = &expr->value.integer;
           tmp = gfc_conv_mpz_to_tree (expr->value.integer,
                                      gfc_index_integer_kind);
         }
@@ -2007,13 +2010,25 @@ gfc_get_nodesc_array_type (tree etype, gfc_array_spec * 
as, gfc_packed packed,
          mpz_t size;
          mpz_init (size);
          mpz_sub_ui (size, stride, 1);
+         if (as->rank == 1 && lbound0)
+           mpz_add (size, size, *lbound0);
+         else if (as->rank == 1 && as->lower[0] == nullptr)
+           mpz_add_ui (size, size, 1);
          max_idx = gfc_conv_mpz_to_tree (size, gfc_index_integer_kind);
        }
       else
        max_idx = NULL_TREE;
 
+      tree lower;
+      if (as->rank == 1 && lbound0)
+       lower = gfc_conv_mpz_to_tree (*lbound0, gfc_index_integer_kind);
+      else if (as->rank == 1 && as && as->lower[0] == nullptr)
+       lower = gfc_index_one_node;
+      else
+       lower = gfc_index_zero_node;
+
       TYPE_DOMAIN (type) = build_range_type (gfc_array_index_type,
-                                            gfc_index_zero_node, max_idx);
+                                            lower, max_idx);
       TREE_TYPE (type) = etype;
     }