re PR fortran/19777 (-fbounds-check catches non-existent bounds violation)

	PR fortran/19777

	* trans-array.c (gfc_conv_array_ref): Perform out-of-bounds
	checking for assumed-size arrrays for all but the last dimension.

	* gfortran.dg/bounds_check_2.f: Add new check for multidimensional
	arrays.

From-SVN: r114210

4 files changed, 34 insertions, 5 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 6d3e17a..e559805 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,5 +1,11 @@
 2006-05-29  Francois-Xavier Coudert  <coudert@clipper.ens.fr>
 
+	PR fortran/19777
+	* trans-array.c (gfc_conv_array_ref): Perform out-of-bounds
+	checking for assumed-size arrrays for all but the last dimension.
+
+2006-05-29  Francois-Xavier Coudert  <coudert@clipper.ens.fr>
+
 	* invoke.texi: Change -fpackderived into -fpack-derived.
 
 2006-05-29  Kazu Hirata  <kazu@codesourcery.com>
diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c
index 737beef..7dfba2a 100644
--- a/gcc/fortran/trans-array.c
+++ b/gcc/fortran/trans-array.c
@@ -1783,7 +1783,7 @@ gfc_trans_array_bound_check (gfc_se * se, tree descriptor, tree index, int n)
   cond = fold_build2 (GT_EXPR, boolean_type_node, index, tmp);
   fault = fold_build2 (TRUTH_OR_EXPR, boolean_type_node, fault, cond);
 
-  gfc_trans_runtime_check (fault, gfc_strconst_fault, &se->pre);
+  gfc_trans_runtime_check (fault, gfc_msg_fault, &se->pre);
 
   return index;
 }
@@ -1948,7 +1948,8 @@ gfc_conv_array_ref (gfc_se * se, gfc_array_ref * ar)
       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)
+      if (flag_bounds_check &&
+	  (ar->as->type != AS_ASSUMED_SIZE  || n < ar->dimen - 1))
 	{
 	  /* Check array bounds.  */
 	  tree cond;
@@ -1978,7 +1979,7 @@ gfc_conv_array_ref (gfc_se * se, gfc_array_ref * ar)
     }
 
   if (flag_bounds_check)
-    gfc_trans_runtime_check (fault, gfc_strconst_fault, &se->pre);
+    gfc_trans_runtime_check (fault, gfc_msg_fault, &se->pre);
 
   tmp = gfc_conv_array_offset (se->expr);
   if (!integer_zerop (tmp))
@@ -2519,7 +2520,7 @@ gfc_conv_ss_startstride (gfc_loopinfo * loop)
 		size[n] = gfc_evaluate_now (tmp, &block);
 	    }
 	}
-      gfc_trans_runtime_check (fault, gfc_strconst_bounds, &block);
+      gfc_trans_runtime_check (fault, gfc_msg_bounds, &block);
 
       tmp = gfc_finish_block (&block);
       gfc_add_expr_to_block (&loop->pre, tmp);
@@ -3714,7 +3715,7 @@ gfc_trans_dummy_array_bias (gfc_symbol * sym, tree tmpdesc, tree body)
               stride2 = build2 (MINUS_EXPR, gfc_array_index_type,
 			       dubound, dlbound);
               tmp = fold_build2 (NE_EXPR, gfc_array_index_type, tmp, stride2);
-	      gfc_trans_runtime_check (tmp, gfc_strconst_bounds, &block);
+	      gfc_trans_runtime_check (tmp, gfc_msg_bounds, &block);
 	    }
 	}
       else
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 1c4e187..90818dd 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,9 @@
+2006-05-29  Francois-Xavier Coudert  <coudert@clipper.ens.fr>
+
+	PR fortran/19777
+	* gfortran.dg/bounds_check_2.f: Add new check for multidimensional
+	arrays.
+
 2006-05-29  Volker Reichelt  <reichelt@igpm.rwth-aachen.de>
 
 	PR c++/27713
diff --git a/gcc/testsuite/gfortran.dg/bounds_check_2.f b/gcc/testsuite/gfortran.dg/bounds_check_2.f
index 0160723..671f7f2 100644
--- a/gcc/testsuite/gfortran.dg/bounds_check_2.f
+++ b/gcc/testsuite/gfortran.dg/bounds_check_2.f
@@ -5,9 +5,12 @@
       integer          npts
       parameter        (npts=10)
       double precision v(npts)
+      double precision w(npts,npts,npts)
       external         init1
+      external         init2
 
       call init1 (npts, v)
+      call init2 (npts, w)
       end
 
       subroutine init1 (npts, v)
@@ -21,3 +24,16 @@
          v(i) = 0
  10   continue
       end
+
+      subroutine init2 (npts, w)
+      implicit none
+      integer          npts
+      double precision w(npts,npts,*)
+
+      integer          i
+
+      do 20 i = 1, npts
+         w(i,1,1) = 0
+         w(1,npts,i) = 0
+ 20   continue
+      end