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" } 
}

Reply via email to