https://gcc.gnu.org/g:ac8a70db59ac309daf866a65b5785e472e76d406
commit r15-7873-gac8a70db59ac309daf866a65b5785e472e76d406
Author: Harald Anlauf <anl...@gmx.de>
Date: Thu Mar 6 21:45:42 2025 +0100
Fortran: improve checking of substring bounds [PR119118]
After the fix for pr98490 no substring bounds check was generated if the
substring start was not a variable. While the purpose of that fix was to
suppress a premature check before implied-do indices were substituted, this
prevented a check if the substring start was an expression or a constant.
A better solution is to defer the check until implied-do indices have been
substituted in the start and end expressions.
PR fortran/119118
gcc/fortran/ChangeLog:
* dependency.cc (gfc_contains_implied_index_p): Helper function to
determine if an expression has a dependence on an implied-do index.
* dependency.h (gfc_contains_implied_index_p): Add prototype.
* trans-expr.cc (gfc_conv_substring): Adjust logic to not generate
substring bounds checks before implied-do indices have been
substituted.
gcc/testsuite/ChangeLog:
* gfortran.dg/bounds_check_23.f90: Generalize test.
* gfortran.dg/bounds_check_26.f90: New test.
Diff:
---
gcc/fortran/dependency.cc | 81 +++++++++++++++++++++++++++
gcc/fortran/dependency.h | 1 +
gcc/fortran/trans-expr.cc | 4 +-
gcc/testsuite/gfortran.dg/bounds_check_23.f90 | 18 +++++-
gcc/testsuite/gfortran.dg/bounds_check_26.f90 | 24 ++++++++
5 files changed, 125 insertions(+), 3 deletions(-)
diff --git a/gcc/fortran/dependency.cc b/gcc/fortran/dependency.cc
index 6b3affa60574..8354b185f347 100644
--- a/gcc/fortran/dependency.cc
+++ b/gcc/fortran/dependency.cc
@@ -1888,6 +1888,87 @@ contains_forall_index_p (gfc_expr *expr)
return false;
}
+
+/* Traverse expr, checking all EXPR_VARIABLE symbols for their
+ implied_index attribute. Return true if any variable may be
+ used as an implied-do index. It is safe to pessimistically
+ return true, and assume a dependency. */
+
+bool
+gfc_contains_implied_index_p (gfc_expr *expr)
+{
+ gfc_actual_arglist *arg;
+ gfc_constructor *c;
+ gfc_ref *ref;
+ int i;
+
+ if (!expr)
+ return false;
+
+ switch (expr->expr_type)
+ {
+ case EXPR_VARIABLE:
+ if (expr->symtree->n.sym->attr.implied_index)
+ return true;
+ break;
+
+ case EXPR_OP:
+ if (gfc_contains_implied_index_p (expr->value.op.op1)
+ || gfc_contains_implied_index_p (expr->value.op.op2))
+ return true;
+ break;
+
+ case EXPR_FUNCTION:
+ for (arg = expr->value.function.actual; arg; arg = arg->next)
+ if (gfc_contains_implied_index_p (arg->expr))
+ return true;
+ break;
+
+ case EXPR_CONSTANT:
+ case EXPR_NULL:
+ case EXPR_SUBSTRING:
+ break;
+
+ case EXPR_STRUCTURE:
+ case EXPR_ARRAY:
+ for (c = gfc_constructor_first (expr->value.constructor);
+ c; gfc_constructor_next (c))
+ if (gfc_contains_implied_index_p (c->expr))
+ return true;
+ break;
+
+ default:
+ gcc_unreachable ();
+ }
+
+ for (ref = expr->ref; ref; ref = ref->next)
+ switch (ref->type)
+ {
+ case REF_ARRAY:
+ for (i = 0; i < ref->u.ar.dimen; i++)
+ if (gfc_contains_implied_index_p (ref->u.ar.start[i])
+ || gfc_contains_implied_index_p (ref->u.ar.end[i])
+ || gfc_contains_implied_index_p (ref->u.ar.stride[i]))
+ return true;
+ break;
+
+ case REF_COMPONENT:
+ break;
+
+ case REF_SUBSTRING:
+ if (gfc_contains_implied_index_p (ref->u.ss.start)
+ || gfc_contains_implied_index_p (ref->u.ss.end))
+ return true;
+ break;
+
+ default:
+ gcc_unreachable ();
+ }
+
+ return false;
+}
+
+
/* Determines overlapping for two single element array references. */
static gfc_dependency
diff --git a/gcc/fortran/dependency.h b/gcc/fortran/dependency.h
index 3f81d406082f..2fc2e567a4cf 100644
--- a/gcc/fortran/dependency.h
+++ b/gcc/fortran/dependency.h
@@ -41,6 +41,7 @@ bool gfc_dep_resolver (gfc_ref *, gfc_ref *, gfc_reverse *,
bool identical = false);
bool gfc_are_equivalenced_arrays (gfc_expr *, gfc_expr *);
bool gfc_omp_expr_prefix_same (gfc_expr *, gfc_expr *);
+bool gfc_contains_implied_index_p (gfc_expr *);
gfc_expr * gfc_discard_nops (gfc_expr *);
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index fbe7333fd711..d965539f11e7 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -2814,8 +2814,8 @@ gfc_conv_substring (gfc_se * se, gfc_ref * ref, int kind,
end.expr = gfc_evaluate_now (end.expr, &se->pre);
if ((gfc_option.rtcheck & GFC_RTCHECK_BOUNDS)
- && (ref->u.ss.start->symtree
- && !ref->u.ss.start->symtree->n.sym->attr.implied_index))
+ && !gfc_contains_implied_index_p (ref->u.ss.start)
+ && !gfc_contains_implied_index_p (ref->u.ss.end))
{
tree nonempty = fold_build2_loc (input_location, LE_EXPR,
logical_type_node, start.expr,
diff --git a/gcc/testsuite/gfortran.dg/bounds_check_23.f90
b/gcc/testsuite/gfortran.dg/bounds_check_23.f90
index 8de90c77c010..4ef03a55efcb 100644
--- a/gcc/testsuite/gfortran.dg/bounds_check_23.f90
+++ b/gcc/testsuite/gfortran.dg/bounds_check_23.f90
@@ -5,6 +5,8 @@
program test
implicit none
call sub('Lorem ipsum')
+ call sub2('Lorem ipsum')
+ call sub3('Lorem ipsum')
contains
subroutine sub( text )
character(len=*), intent(in) :: text
@@ -13,6 +15,20 @@ contains
c = [ ( text(i:i), i = 1, len(text) ) ]
if (c(1) /= 'L') stop 1
end subroutine sub
+ subroutine sub2 (txt2)
+ character(len=*), intent(in) :: txt2
+ character(len=1), allocatable :: c(:)
+ integer :: i
+ c = [ ( txt2(i+0:i), i = 1, len(txt2) ) ]
+ if (c(1) /= 'L') stop 2
+ end subroutine sub2
+ subroutine sub3 (txt3)
+ character(len=*), intent(in) :: txt3
+ character(len=1), allocatable :: c(:)
+ integer :: i
+ c = [ ( txt3(i:i+0), i = 1, len(txt3) ) ]
+ if (c(1) /= 'L') stop 3
+ end subroutine sub3
end program test
-! { dg-final { scan-tree-dump-times "Substring out of bounds:" 2 "original" } }
+! { dg-final { scan-tree-dump-times "Substring out of bounds:" 6 "original" } }
diff --git a/gcc/testsuite/gfortran.dg/bounds_check_26.f90
b/gcc/testsuite/gfortran.dg/bounds_check_26.f90
new file mode 100644
index 000000000000..69ac9fbe2f22
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/bounds_check_26.f90
@@ -0,0 +1,24 @@
+! { dg-do compile }
+! { dg-options "-fcheck=bounds -fdump-tree-original" }
+!
+! PR fortran/119118
+
+program main
+ implicit none
+ character(10) :: str = "1234567890"
+ integer :: n = 3
+
+ print *, str(-1:-2) ! zero-length substring: OK
+
+ print *, str(-1:n) ! 2 checked bounds
+ print *, len (str(-1:n)) ! 2 checked bounds
+
+ print *, str(-n:1) ! 1 checked bound / 1 eliminated
+ print *, len (str(-n:1)) ! 1 checked bound / 1 eliminated
+
+ print *, str(-n:11) ! 2 checked bounds
+ print *, len (str(-n:11)) ! 2 checked bounds
+
+end program main
+
+! { dg-final { scan-tree-dump-times "Substring out of bounds:" 10 "original" }
}
