[gcc r12-3432] Fortran - out of bounds in array constructor with implied do loop

[gcc r12-3432] Fortran - out of bounds in array constructor with implied do loop

[Harald Anlauf]

https://gcc.gnu.org/g:5fe0865ab788bdc387b284a3ad57e5a95a767b18

commit r12-3432-g5fe0865ab788bdc387b284a3ad57e5a95a767b18
Author: Harald Anlauf <anlauf@gmx.de>
Date:   Thu Sep 9 21:34:01 2021 +0200

    Fortran - out of bounds in array constructor with implied do loop
    
    gcc/fortran/ChangeLog:
    
            PR fortran/98490
            * trans-expr.c (gfc_conv_substring): Do not generate substring
            bounds check for implied do loop index variable before it actually
            becomes defined.
    
    gcc/testsuite/ChangeLog:
    
            PR fortran/98490
            * gfortran.dg/bounds_check_23.f90: New test.

Diff:
---
 gcc/fortran/trans-expr.c                      |  4 +++-
 gcc/testsuite/gfortran.dg/bounds_check_23.f90 | 18 ++++++++++++++++++
 2 files changed, 21 insertions(+), 1 deletion(-)

diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index c4291cce079..18d665192f0 100644
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -2630,7 +2630,9 @@ gfc_conv_substring (gfc_se * se, gfc_ref * ref, int kind,
   if (!CONSTANT_CLASS_P (tmp) && !DECL_P (tmp))
     end.expr = gfc_evaluate_now (end.expr, &se->pre);
 
-  if (gfc_option.rtcheck & GFC_RTCHECK_BOUNDS)
+  if ((gfc_option.rtcheck & GFC_RTCHECK_BOUNDS)
+      && (ref->u.ss.start->symtree
+	  && !ref->u.ss.start->symtree->n.sym->attr.implied_index))
     {
       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
new file mode 100644
index 00000000000..8de90c77c01
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/bounds_check_23.f90
@@ -0,0 +1,18 @@
+! { dg-do run }
+! { dg-options "-fcheck=bounds -fdump-tree-original" }
+! PR fortran/98490 - out of bounds in array constructor with implied do loop
+
+program test
+  implicit none
+  call sub('Lorem ipsum')
+contains
+  subroutine sub( text )
+    character(len=*), intent(in)  :: text
+    character(len=1), allocatable :: c(:)
+    integer :: i
+    c = [ ( text(i:i), i = 1, len(text) ) ]
+    if (c(1) /= 'L') stop 1
+  end subroutine sub
+end program test
+
+! { dg-final { scan-tree-dump-times "Substring out of bounds:" 2 "original" } }