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

Mikael Morin mikael@gcc.gnu.org
Fri Jun 13 15:02:08 GMT 2025


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

commit 14453f7d652df951b06c1e5959501c7a3c3c5fc7
Author: Mikael Morin <mikael@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;
     }


More information about the Gcc-cvs mailing list