From d16b57dfef9dc93375b7606b6c36eece4ac877e4 Mon Sep 17 00:00:00 2001 From: Francois-Xavier Coudert Date: Thu, 6 Jul 2006 22:37:36 +0200 Subject: [PATCH] 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 --- gcc/fortran/ChangeLog | 8 ++++++++ gcc/fortran/trans-array.c | 21 +++++++++++--------- gcc/testsuite/ChangeLog | 5 +++++ gcc/testsuite/gfortran.dg/bounds_check_4.f90 | 18 +++++++++++++++++ 4 files changed, 43 insertions(+), 9 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/bounds_check_4.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 38be155b6d1..cf92deaf7ca 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,11 @@ +2006-07-06 Francois-Xavier Coudert + + 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 PR fortran/27874 diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index 01c78d40496..274ccdbe533 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 60e18a3e7b3..272acc98a1b 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2006-07-06 Francois-Xavier Coudert + + PR fortran/28129 + * gfortran.dg/bounds_check_4.f90: New test. + 2006-07-05 Richard Guenther 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 00000000000..9ce2298f239 --- /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