This is the mail archive of the gcc-patches@gcc.gnu.org mailing list for the GCC project.


Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]
Other format: [Raw text]

[gfortran,patch] Bounds-checking for lower bound of last dimension of assumed-size array


Hi all,

This is probably these few days' series of patches that I submitted to
clear the backlog of patches and bits accumulated in my trees during
these last months. I'll be working next on clearing the backlog for
reviews (so that you can review my patches!). I'm aware of two
unreviewed patches by Paul (for PR31692 and PR31630), but if you have
unreviewed patches that aren't on my radar, don't be afraid to send me
a private ping-ing mail!


This patch fixes PR31627, where we don't check at runtime (with -fbounds-check) that the lower bound of the last dimension of an assumed-size array is not exceeded. In fact, as far as checking goes, the last dimension of assumed-size arrays was completely ignored. This patch enables checking for the lower bound, while still not checking the upper bound (which, by definition, is not known).

Bootstrapped && regtested on i686-linux, both without and with
-fbounds-check (no failure introduced by the patch, when running with
-fbounds-check[1]). OK for mainline?

FX



[1] I noticed three unrelated failures when running the testsuite with
-fbounds-check (for der_io.f90, pr19928-2.f90 and pr25603.f). I will
soon submit bug reports for those.

:ADDPATCH fortran:

2007-05-07 Francois-Xavier Coudert <fxcoudert@gcc.gnu.org>

       PR fortran/31627
       * trans-array.c (gfc_trans_array_bound_check): Take extra argument to
       indicate whether we should check the upper bound in that dimension.
       (gfc_conv_array_index_offset): Check only the lower bound of the
       last dimension for assumed-size arrays.
       (gfc_conv_array_ref): Likewise.
       (gfc_conv_ss_startstride): Likewise.


2007-05-07 Francois-Xavier Coudert <fxcoudert@gcc.gnu.org>


       PR fortran/31627
       * gfortran.dg/bounds_check_7.f90: New test.
Index: trans-array.c
===================================================================
--- trans-array.c	(revision 124285)
+++ trans-array.c	(working copy)
@@ -1994,7 +1994,7 @@ gfc_conv_array_ubound (tree descriptor, 
 
 static tree
 gfc_trans_array_bound_check (gfc_se * se, tree descriptor, tree index, int n,
-			     locus * where)
+			     locus * where, bool check_upper)
 {
   tree fault;
   tree tmp;
@@ -2047,16 +2047,19 @@ gfc_trans_array_bound_check (gfc_se * se
   gfc_free (msg);
 
   /* Check upper bound.  */
-  tmp = gfc_conv_array_ubound (descriptor, n);
-  fault = fold_build2 (GT_EXPR, boolean_type_node, index, tmp);
-  if (name)
-    asprintf (&msg, "%s for array '%s', upper bound of dimension %d exceeded",
-	      gfc_msg_fault, name, n+1);
-  else
-    asprintf (&msg, "%s, upper bound of dimension %d exceeded",
-	      gfc_msg_fault, n+1);
-  gfc_trans_runtime_check (fault, msg, &se->pre, where);
-  gfc_free (msg);
+  if (check_upper)
+    {
+      tmp = gfc_conv_array_ubound (descriptor, n);
+      fault = fold_build2 (GT_EXPR, boolean_type_node, index, tmp);
+      if (name)
+	asprintf (&msg, "%s for array '%s', upper bound of dimension %d "
+			" exceeded", gfc_msg_fault, name, n+1);
+      else
+	asprintf (&msg, "%s, upper bound of dimension %d exceeded",
+		  gfc_msg_fault, n+1);
+      gfc_trans_runtime_check (fault, msg, &se->pre, where);
+      gfc_free (msg);
+    }
 
   return index;
 }
@@ -2090,7 +2093,9 @@ gfc_conv_array_index_offset (gfc_se * se
 	  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);
+			index, dim, &ar->where,
+			(ar->as->type != AS_ASSUMED_SIZE
+			 && !ar->as->cp_was_assumed) || dim < ar->dimen - 1);
 	  break;
 
 	case DIMEN_VECTOR:
@@ -2116,7 +2121,9 @@ gfc_conv_array_index_offset (gfc_se * se
 	  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);
+			index, dim, &ar->where,
+			(ar->as->type != AS_ASSUMED_SIZE
+			 && !ar->as->cp_was_assumed) || dim < ar->dimen - 1);
 	  break;
 
 	case DIMEN_RANGE:
@@ -2227,14 +2234,13 @@ gfc_conv_array_ref (gfc_se * se, gfc_arr
       gfc_conv_expr_type (&indexse, ar->start[n], gfc_array_index_type);
       gfc_add_block_to_block (&se->pre, &indexse.pre);
 
-      if (flag_bounds_check &&
-	  ((ar->as->type != AS_ASSUMED_SIZE && !ar->as->cp_was_assumed)
-	   || n < ar->dimen - 1))
+      if (flag_bounds_check)
 	{
 	  /* Check array bounds.  */
 	  tree cond;
 	  char *msg;
 
+	  /* Lower bound.  */
 	  tmp = gfc_conv_array_lbound (se->expr, n);
 	  cond = fold_build2 (LT_EXPR, boolean_type_node, 
 			      indexse.expr, tmp);
@@ -2244,14 +2250,20 @@ gfc_conv_array_ref (gfc_se * se, gfc_arr
 	  gfc_trans_runtime_check (cond, msg, &se->pre, where);
 	  gfc_free (msg);
 
-	  tmp = gfc_conv_array_ubound (se->expr, n);
-	  cond = fold_build2 (GT_EXPR, boolean_type_node, 
-			      indexse.expr, tmp);
-	  asprintf (&msg, "%s for array '%s', "
-	            "upper bound of dimension %d exceeded", gfc_msg_fault,
-		    sym->name, n+1);
-	  gfc_trans_runtime_check (cond, msg, &se->pre, where);
-	  gfc_free (msg);
+	  /* Upper bound, but not for the last dimension of assumed-size
+	     arrays.  */
+	  if (n < ar->dimen - 1
+	      || (ar->as->type != AS_ASSUMED_SIZE && !ar->as->cp_was_assumed))
+	    {
+	      tmp = gfc_conv_array_ubound (se->expr, n);
+	      cond = fold_build2 (GT_EXPR, boolean_type_node, 
+				  indexse.expr, tmp);
+	      asprintf (&msg, "%s for array '%s', "
+			"upper bound of dimension %d exceeded", gfc_msg_fault,
+			sym->name, n+1);
+	      gfc_trans_runtime_check (cond, msg, &se->pre, where);
+	      gfc_free (msg);
+	    }
 	}
 
       /* Multiply the index by the stride.  */
@@ -2786,22 +2798,18 @@ gfc_conv_ss_startstride (gfc_loopinfo * 
 	     dimensions are checked later.  */
 	  for (n = 0; n < loop->dimen; n++)
 	    {
+	      bool check_upper;
+
 	      dim = info->dim[n];
 	      if (info->ref->u.ar.dimen_type[dim] != DIMEN_RANGE)
 		continue;
+
 	      if (n == info->ref->u.ar.dimen - 1
 		  && (info->ref->u.ar.as->type == AS_ASSUMED_SIZE
 		      || info->ref->u.ar.as->cp_was_assumed))
-		continue;
-
-	      desc = ss->data.info.descriptor;
-
-	      /* This is the run-time equivalent of resolve.c's
-	         check_dimension().  The logical is more readable there
-	         than it is here, with all the trees.  */
-	      lbound = gfc_conv_array_lbound (desc, dim);
-	      ubound = gfc_conv_array_ubound (desc, dim);
-	      end = info->end[n];
+		check_upper = false;
+	      else
+		check_upper = true;
 
 	      /* Zero stride is not allowed.  */
 	      tmp = fold_build2 (EQ_EXPR, boolean_type_node, info->stride[n],
@@ -2812,6 +2820,18 @@ gfc_conv_ss_startstride (gfc_loopinfo * 
 	      gfc_trans_runtime_check (tmp, msg, &block, &ss->expr->where);
 	      gfc_free (msg);
 
+	      desc = ss->data.info.descriptor;
+
+	      /* This is the run-time equivalent of resolve.c's
+	         check_dimension().  The logical is more readable there
+	         than it is here, with all the trees.  */
+	      lbound = gfc_conv_array_lbound (desc, dim);
+	      end = info->end[n];
+	      if (check_upper)
+		ubound = gfc_conv_array_ubound (desc, dim);
+	      else
+		ubound = NULL;
+
 	      /* non_zerosized is true when the selected range is not
 	         empty.  */
 	      stride_pos = fold_build2 (GT_EXPR, boolean_type_node,
@@ -2842,15 +2862,18 @@ gfc_conv_ss_startstride (gfc_loopinfo * 
 	      gfc_trans_runtime_check (tmp, msg, &block, &ss->expr->where);
 	      gfc_free (msg);
 
-	      tmp = fold_build2 (GT_EXPR, boolean_type_node, info->start[n],
-				 ubound);
-	      tmp = fold_build2 (TRUTH_AND_EXPR, boolean_type_node,
-				 non_zerosized, tmp);
-	      asprintf (&msg, "%s, upper bound of dimension %d of array '%s'"
-			" exceeded", gfc_msg_fault, info->dim[n]+1,
-			ss->expr->symtree->name);
-	      gfc_trans_runtime_check (tmp, msg, &block, &ss->expr->where);
-	      gfc_free (msg);
+	      if (check_upper)
+		{
+		  tmp = fold_build2 (GT_EXPR, boolean_type_node,
+				     info->start[n], ubound);
+		  tmp = fold_build2 (TRUTH_AND_EXPR, boolean_type_node,
+				     non_zerosized, tmp);
+	          asprintf (&msg, "%s, upper bound of dimension %d of array "
+			    "'%s' exceeded", gfc_msg_fault, info->dim[n]+1,
+			    ss->expr->symtree->name);
+		  gfc_trans_runtime_check (tmp, msg, &block, &ss->expr->where);
+		  gfc_free (msg);
+		}
 
 	      /* Compute the last element of the range, which is not
 		 necessarily "end" (think 0:5:3, which doesn't contain 5)
@@ -2871,14 +2894,17 @@ gfc_conv_ss_startstride (gfc_loopinfo * 
 	      gfc_trans_runtime_check (tmp, msg, &block, &ss->expr->where);
 	      gfc_free (msg);
 
-	      tmp = fold_build2 (GT_EXPR, boolean_type_node, tmp2, ubound);
-	      tmp = fold_build2 (TRUTH_AND_EXPR, boolean_type_node,
-				 non_zerosized, tmp);
-	      asprintf (&msg, "%s, upper bound of dimension %d of array '%s'"
-			" exceeded", gfc_msg_fault, info->dim[n]+1,
-			ss->expr->symtree->name);
-	      gfc_trans_runtime_check (tmp, msg, &block, &ss->expr->where);
-	      gfc_free (msg);
+	      if (check_upper)
+		{
+		  tmp = fold_build2 (GT_EXPR, boolean_type_node, tmp2, ubound);
+		  tmp = fold_build2 (TRUTH_AND_EXPR, boolean_type_node,
+				     non_zerosized, tmp);
+		  asprintf (&msg, "%s, upper bound of dimension %d of array "
+			    "'%s' exceeded", gfc_msg_fault, info->dim[n]+1,
+			    ss->expr->symtree->name);
+		  gfc_trans_runtime_check (tmp, msg, &block, &ss->expr->where);
+		  gfc_free (msg);
+		}
 
 	      /* Check the section sizes match.  */
 	      tmp = fold_build2 (MINUS_EXPR, gfc_array_index_type, end,
Index: gcc/testsuite/gfortran.dg/bounds_check_7.f90
===================================================================
--- gcc/testsuite/gfortran.dg/bounds_check_7.f90	(revision 0)
+++ gcc/testsuite/gfortran.dg/bounds_check_7.f90	(revision 0)
@@ -0,0 +1,15 @@
+! { dg-do run }
+! { dg-options "-fbounds-check" }
+! { dg-shouldfail "Array reference out of bounds" }
+! PR fortran/31627
+subroutine foo(a)
+  integer a(*), i
+  i = 0
+  a(i) = 42 ! {
+end subroutine foo
+
+program test
+  integer x(42)
+  call foo(x)
+end program test
+! { dg-output "Array reference out of bounds .* lower bound of dimension 1 exceeded" }

Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]