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

[Mikael Morin via Gcc-cvs]

https://gcc.gnu.org/g:708eb59b45197553bcfcd8b178fda6716421614e

commit 708eb59b45197553bcfcd8b178fda6716421614e
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 99c53fab755a..92a0ccdb3588 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 dd8c306b3b32..9568d8f821ab 100644
--- a/gcc/fortran/trans-types.cc
+++ b/gcc/fortran/trans-types.cc
@@ -1860,6 +1860,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);
@@ -1889,6 +1890,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);
         }
@@ -2004,13 +2007,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;
     }