[gcc(refs/users/mikael/heads/refactor_descriptor_v05)] Correction régressions array_reference_3

[Mikael Morin]

https://gcc.gnu.org/g:f58af2eecc319030c685e56c31c14877e15e3b16

commit f58af2eecc319030c685e56c31c14877e15e3b16
Author: Mikael Morin <mikael@gcc.gnu.org>
Date:   Wed May 28 18:56:02 2025 +0200

    Correction régressions array_reference_3

Diff:
---
 gcc/fortran/trans-array.cc                      | 82 +++++++++++++++++--------
 gcc/testsuite/gfortran.dg/array_reference_3.f90 |  4 +-
 2 files changed, 59 insertions(+), 27 deletions(-)

diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index 0109f135cfbe..127cc0cd0951 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -3590,6 +3590,59 @@ build_array_ref (tree array, tree offset, bool use_array_ref)
 }
 
 
+static bool
+array_section_parent_ref_is_contiguous (gfc_expr *expr, gfc_array_ref *ar)
+{
+  if (expr == nullptr || ar == nullptr)
+    return false;
+
+  gfc_symbol *root_sym = expr->symtree->n.sym;
+  bt last_type = root_sym->ts.type;
+  bool last_is_allocatable = root_sym->attr.allocatable;
+  bool last_is_contiguous = root_sym->attr.contiguous;
+  for (gfc_ref *ref = expr->ref; ref; ref = ref->next)
+    {
+      if (ref->type == REF_ARRAY && &ref->u.ar == ar)
+	break;
+
+      if (ref->type != REF_COMPONENT)
+	continue;
+
+      if (last_type == BT_CLASS
+	  && strcmp (ref->u.c.component->name, "_data") == 0)
+	continue;
+
+      last_type = ref->u.c.component->ts.type;
+      last_is_allocatable = ref->u.c.component->attr.allocatable;
+      last_is_contiguous = ref->u.c.component->attr.contiguous;
+    }
+
+  if (!(last_type == BT_CLASS || last_type == BT_CHARACTER)
+      && (last_is_allocatable || last_is_contiguous))
+    return true;
+
+  return false;
+}
+
+
+static bool
+array_section_parent_ref_is_contiguous (gfc_expr *expr, gfc_ref *array_ref)
+{
+  if (array_ref == nullptr)
+    return false;
+
+  return array_section_parent_ref_is_contiguous (expr, &array_ref->u.ar);
+}
+
+
+static bool
+array_section_parent_ref_is_contiguous (gfc_ss *ss)
+{
+  return array_section_parent_ref_is_contiguous (ss->info->expr,
+						 ss->info->data.array.ref);
+}
+
+
 tree
 build_array_ref_dim (gfc_ss *ss, tree index, tree lbound, tree spacing,
 		     bool tmp_array = false)
@@ -3603,6 +3656,8 @@ build_array_ref_dim (gfc_ss *ss, tree index, tree lbound, tree spacing,
 			     || ss_type == GFC_SS_CONSTRUCTOR
 			     || ss_type == GFC_SS_INTRINSIC
 			     || tmp_array
+			     || (ss_type == GFC_SS_SECTION
+				 && array_section_parent_ref_is_contiguous (ss))
 			     || non_negative_strides_array_p (info->descriptor);
   return gfc_build_array_ref (base, index, non_negative_stride, lbound,
 			      spacing);
@@ -3667,9 +3722,6 @@ add_to_offset (tree *cst_offset, tree *offset, tree t)
 bool
 array_ref_safe_p (gfc_expr *expr, gfc_array_ref *ar, tree array, tree *elt_size)
 {
-  if (!non_negative_strides_array_p (array))
-    return false;
-
   STRIP_NOPS (array);
   if (TREE_CODE (array) == COMPONENT_REF)
     {
@@ -3682,29 +3734,9 @@ array_ref_safe_p (gfc_expr *expr, gfc_array_ref *ar, tree array, tree *elt_size)
 	return false;
     }
 
-  gfc_symbol *root_sym = expr->symtree->n.sym;
-  bt last_type = root_sym->ts.type;
-  bool last_is_allocatable = root_sym->attr.allocatable;
-  for (gfc_ref *ref = expr->ref; ref; ref = ref->next)
-    {
-      if (ref->type == REF_ARRAY && &ref->u.ar == ar)
-	break;
-
-      if (ref->type != REF_COMPONENT)
-	continue;
-
-      if (last_type == BT_CLASS
-	  && strcmp (ref->u.c.component->name, "_data") == 0)
-	continue;
-
-      last_type = ref->u.c.component->ts.type;
-      last_is_allocatable = ref->u.c.component->attr.allocatable;
-    }
-
-  if (!(last_type == BT_CLASS || last_type == BT_CHARACTER)
-      && last_is_allocatable)
+  if (array_section_parent_ref_is_contiguous (expr, ar))
     ;
-  else if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (array)))
+  else if (!non_negative_strides_array_p (array))
     return false;
 
   tree elt_type = gfc_get_element_type (TREE_TYPE (array));
diff --git a/gcc/testsuite/gfortran.dg/array_reference_3.f90 b/gcc/testsuite/gfortran.dg/array_reference_3.f90
index e1e2f0f9afa1..a7a5c03561a9 100644
--- a/gcc/testsuite/gfortran.dg/array_reference_3.f90
+++ b/gcc/testsuite/gfortran.dg/array_reference_3.f90
@@ -178,7 +178,7 @@ contains
     call casces(x)
     if (any(x /= (/ 0, 0, 0, 24, 0, 0, 0, 0 /))) stop 24
     ! Contiguous assumed shape arrays are referenced with array indexing.
-    ! { dg-final { scan-tree-dump-times "\\(\\*assumed_shape_cont_x.\\d+\\)\\\[stride.\\d+ \\* 4 \\+ offset.\\d+\\\] = 24;" 1 "original" } }
+    ! { dg-final { scan-tree-dump-times {\(\*assumed_shape_cont_x.\d+\)\[offset.\d+ /\[ex\] 4 \+ spacing\.\d+\](?:{lb: 0 sz: 4})? = 24;} 1 "original" } }
   end subroutine check_assumed_shape_cont_elem
   subroutine cascss(assumed_shape_cont_y)
     integer, dimension(:), contiguous :: assumed_shape_cont_y
@@ -189,7 +189,7 @@ contains
     call cascss(y)
     if (any(y /= 25)) stop 25
     ! Contiguous assumed shape arrays are referenced with array indexing.
-    ! { dg-final { scan-tree-dump-times "\\(\\*assumed_shape_cont_y.\\d+\\)\\\[S.\\d+ \\* D.\\d+ \\+ D.\\d+\\\] = 25;" 1 "original" } }
+    ! { dg-final { scan-tree-dump-times {\(\*assumed_shape_cont_y.\d+\)\[S.\d+\](?:{lb: [01] sz: (?:\(sizetype\) )?D\.\d+})? = 25;} 1 "original" } }
   end subroutine check_assumed_shape_cont_scalarized
 end program p