re PR fortran/28129 (gfortran -fbounds-check: Shows invalid array out of bounds error)

	PR fortran/28129

	* trans-array.c (gfc_trans_array_bound_check): Add a locus
	argument, and use it in the error messages.
	(gfc_conv_array_index_offset): Donc perform bounds checking on
	the last dimension of assumed-size arrays.

	* gfortran.dg/bounds_check_4.f90: New test.

From-SVN: r115231

4 files changed, 43 insertions, 9 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 38be155..cf92dea 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,5 +1,13 @@
 2006-07-06  Francois-Xavier Coudert  <coudert@clipper.ens.fr>
 
+	PR fortran/28129
+	* trans-array.c (gfc_trans_array_bound_check): Add a locus
+	argument, and use it in the error messages.
+	(gfc_conv_array_index_offset): Donc perform bounds checking on
+	the last dimension of assumed-size arrays.
+
+2006-07-06  Francois-Xavier Coudert  <coudert@clipper.ens.fr>
+
 	PR fortran/27874
 	* trans-stmt.c (compute_inner_temp_size): Don't perform bounds
 	checking when calculating the bounds of scalarization.
diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c
index 01c78d4..274ccdb 100644
--- a/gcc/fortran/trans-array.c
+++ b/gcc/fortran/trans-array.c
@@ -1826,7 +1826,8 @@ gfc_conv_array_ubound (tree descriptor, int dim)
 /* 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;
@@ -1846,8 +1847,7 @@ gfc_trans_array_bound_check (gfc_se * se, tree descriptor, tree index, int n)
   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.  */
@@ -1859,8 +1859,7 @@ gfc_trans_array_bound_check (gfc_se * se, tree descriptor, tree index, int n)
   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;
@@ -1892,8 +1891,10 @@ gfc_conv_array_index_offset (gfc_se * se, gfc_ss_info * info, int dim, int i,
 	  /* 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:
@@ -1916,8 +1917,10 @@ gfc_conv_array_index_offset (gfc_se * se, gfc_ss_info * info, int dim, int i,
 	  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:
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 60e18a3..272acc9 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2006-07-06  Francois-Xavier Coudert  <coudert@clipper.ens.fr>
+
+	PR fortran/28129
+	* gfortran.dg/bounds_check_4.f90: New test.
+
 2006-07-05  Richard Guenther  <rguenther@suse.de>
 
 	PR target/28158
diff --git a/gcc/testsuite/gfortran.dg/bounds_check_4.f90 b/gcc/testsuite/gfortran.dg/bounds_check_4.f90
new file mode 100644
index 0000000..9ce2298
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/bounds_check_4.f90
@@ -0,0 +1,18 @@
+subroutine foo(n,x)
+  implicit none
+  integer, intent(in) :: n
+  complex(8), intent(out) :: x(n,*)
+  x(1,1) = 0.d0
+  x(n,1) = 0.d0
+  x(:,1) = 0.d0
+  x(2:,1) = 0.d0
+  x(:n-1,1) = 0.d0
+  x((/1,n/),1) = 0.d0
+end subroutine foo
+
+program test
+  implicit none
+  integer, parameter :: n = 17
+  complex(8) :: x(n,n)
+  call foo(n,x)
+end program test