[gfortran,patch] Fix bounds checking

["François-Xavier Coudert" <fxcoudert at gmail dot com>]

:ADDPATCH fortran:

Attached patch fixes PR fortran/28129, a case where bounds-checking
was performed on assumed-size array. I fixed it by the same check as
we already did for PR fortran/19777. I took this opportunity to add
the precise locus into this bounds-checking message.

Bootstrapped and regested on i686-linux both with and without
-fbounds-check. It will come with a testcase from the PR and a few
extra checks. OK for mainline and 4.1?

PS: after that, I'll only one more bounds-checking issue to fix (PR 27874).

FX
Index: trans-array.c
===================================================================
--- trans-array.c	(revision 115174)
+++ trans-array.c	(working copy)
@@ -1812,7 +1812,8 @@
 /* Generate code to perform an array index bound check.  */
 
 static tree
-gfc_trans_array_bound_check (gfc_se * se, tree descriptor, tree index, int n)
+gfc_trans_array_bound_check (gfc_se * se, tree descriptor, tree index, int n,
+			     locus * where)
 {
   tree fault;
   tree tmp;
@@ -1832,8 +1833,7 @@
   else
     asprintf (&msg, "%s, lower bound of dimension %d exceeded",
 	      gfc_msg_fault, n+1);
-  gfc_trans_runtime_check (fault, msg, &se->pre,
-			   (se->ss ? &se->ss->expr->where : NULL));
+  gfc_trans_runtime_check (fault, msg, &se->pre, where);
   gfc_free (msg);
 
   /* Check upper bound.  */
@@ -1845,8 +1845,7 @@
   else
     asprintf (&msg, "%s, upper bound of dimension %d exceeded",
 	      gfc_msg_fault, n+1);
-  gfc_trans_runtime_check (fault, msg, &se->pre,
-			   (se->ss ? &se->ss->expr->where : NULL));
+  gfc_trans_runtime_check (fault, msg, &se->pre, where);
   gfc_free (msg);
 
   return index;
@@ -1878,8 +1877,10 @@
 	  /* We've already translated this value outside the loop.  */
 	  index = info->subscript[dim]->data.scalar.expr;
 
-	  index =
-	    gfc_trans_array_bound_check (se, info->descriptor, index, dim);
+	  if ((ar->as->type != AS_ASSUMED_SIZE && !ar->as->cp_was_assumed)
+	      || dim < ar->dimen - 1)
+	    index = gfc_trans_array_bound_check (se, info->descriptor,
+						 index, dim, &ar->where);
 	  break;
 
 	case DIMEN_VECTOR:
@@ -1902,8 +1903,10 @@
 	  index = gfc_evaluate_now (index, &se->pre);
 
 	  /* Do any bounds checking on the final info->descriptor index.  */
-	  index = gfc_trans_array_bound_check (se, info->descriptor,
-					       index, dim);
+	  if ((ar->as->type != AS_ASSUMED_SIZE && !ar->as->cp_was_assumed)
+	      || dim < ar->dimen - 1)
+	    index = gfc_trans_array_bound_check (se, info->descriptor,
+						 index, dim, &ar->where);
 	  break;
 
 	case DIMEN_RANGE:

Attachment: pr28129.ChangeLog
Description: Binary data