https://gcc.gnu.org/g:f58af2eecc319030c685e56c31c14877e15e3b16
commit f58af2eecc319030c685e56c31c14877e15e3b16
Author: Mikael Morin <mik...@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
