Fortran: improve bounds checking for DATA with implied-do [PR35095]

gcc/fortran/ChangeLog:

	PR fortran/35095
	* data.cc (get_array_index): Add bounds-checking code and return error
	status.  Overindexing will be allowed as an extension for -std=legacy
	and generate an error in standard-conforming mode.
	(gfc_assign_data_value): Use error status from get_array_index for
	graceful error recovery.

gcc/testsuite/ChangeLog:

	PR fortran/35095
	* gfortran.dg/data_bounds_1.f90: Adjust options to disable warnings.
	* gfortran.dg/data_bounds_2.f90: New test.

diff --git a/gcc/fortran/data.cc b/gcc/fortran/data.cc
index 7c2537dd3f0a43eae51e5cf41dd3d90c2abbc2d8..0589fc3906f845c381c77657bb85c354e4676cdb 100644 (file)
--- a/gcc/fortran/data.cc
+++ b/gcc/fortran/data.cc
@@ -43,13 +43,14 @@ static void formalize_init_expr (gfc_expr *);
 
 /* Calculate the array element offset.  */
 
-static void
+static bool
 get_array_index (gfc_array_ref *ar, mpz_t *offset)
 {
   gfc_expr *e;
   int i;
   mpz_t delta;
   mpz_t tmp;
+  bool ok = true;
 
   mpz_init (tmp);
   mpz_set_si (*offset, 0);
@@ -59,13 +60,42 @@ get_array_index (gfc_array_ref *ar, mpz_t *offset)
       e = gfc_copy_expr (ar->start[i]);
       gfc_simplify_expr (e, 1);
 
-      if ((gfc_is_constant_expr (ar->as->lower[i]) == 0)
-         || (gfc_is_constant_expr (ar->as->upper[i]) == 0)
-         || (gfc_is_constant_expr (e) == 0))
-       gfc_error ("non-constant array in DATA statement %L", &ar->where);
+      if (!gfc_is_constant_expr (ar->as->lower[i])
+         || !gfc_is_constant_expr (ar->as->upper[i])
+         || !gfc_is_constant_expr (e))
+       {
+         gfc_error ("non-constant array in DATA statement %L", &ar->where);
+         ok = false;
+         break;
+       }
 
       mpz_set (tmp, e->value.integer);
       gfc_free_expr (e);
+
+      /* Overindexing is only allowed as a legacy extension.  */
+      if (mpz_cmp (tmp, ar->as->lower[i]->value.integer) < 0
+         && !gfc_notify_std (GFC_STD_LEGACY,
+                             "Subscript at %L below array lower bound "
+                             "(%ld < %ld) in dimension %d", &ar->c_where[i],
+                             mpz_get_si (tmp),
+                             mpz_get_si (ar->as->lower[i]->value.integer),
+                             i+1))
+       {
+         ok = false;
+         break;
+       }
+      if (mpz_cmp (tmp, ar->as->upper[i]->value.integer) > 0
+         && !gfc_notify_std (GFC_STD_LEGACY,
+                             "Subscript at %L above array upper bound "
+                             "(%ld > %ld) in dimension %d", &ar->c_where[i],
+                             mpz_get_si (tmp),
+                             mpz_get_si (ar->as->upper[i]->value.integer),
+                             i+1))
+       {
+         ok = false;
+         break;
+       }
+
       mpz_sub (tmp, tmp, ar->as->lower[i]->value.integer);
       mpz_mul (tmp, tmp, delta);
       mpz_add (*offset, tmp, *offset);
@@ -77,6 +107,8 @@ get_array_index (gfc_array_ref *ar, mpz_t *offset)
     }
   mpz_clear (delta);
   mpz_clear (tmp);
+
+  return ok;
 }
 
 /* Find if there is a constructor which component is equal to COM.
@@ -298,7 +330,10 @@ gfc_assign_data_value (gfc_expr *lvalue, gfc_expr *rvalue, mpz_t index,
            }
 
          if (ref->u.ar.type == AR_ELEMENT)
-           get_array_index (&ref->u.ar, &offset);
+           {
+             if (!get_array_index (&ref->u.ar, &offset))
+               goto abort;
+           }
          else
            mpz_set (offset, index);
 

diff --git a/gcc/testsuite/gfortran.dg/data_bounds_1.f90 b/gcc/testsuite/gfortran.dg/data_bounds_1.f90
index 24cdc7c98156d1beed73b425bf55fd4f6b510106..1e6321a28840cdf48becb816608ec1008cd988a4 100644 (file)
--- a/gcc/testsuite/gfortran.dg/data_bounds_1.f90
+++ b/gcc/testsuite/gfortran.dg/data_bounds_1.f90
@@ -1,5 +1,5 @@
 ! { dg-do compile }
-! { dg-options "-std=gnu" }
+! { dg-options "-std=gnu -w" }
 ! Checks the fix for PR32315, in which the bounds checks below were not being done.
 !
 ! Contributed by Tobias Burnus <burnus@gcc.gnu.org>

diff --git a/gcc/testsuite/gfortran.dg/data_bounds_2.f90 b/gcc/testsuite/gfortran.dg/data_bounds_2.f90
new file mode 100644 (file)
index 0000000..1aa9fd4
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/data_bounds_2.f90
@@ -0,0 +1,9 @@
+! { dg-do compile }
+! { dg-options "-std=f2018" }
+! PR fortran/35095 - Improve bounds checking for DATA with implied-do
+
+program chkdata
+  character(len=2), dimension(2,2) :: str
+  data (str(i,1),i=1,3) / 'A','B','C' / ! { dg-error "above array upper bound" }
+  data (str(j,2),j=0,2) / 'A','B','C' / ! { dg-error "below array lower bound" }
+end program chkdata