OpenE2K
/
gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

re PR fortran/33745 (-fbounds-check: Bogus out-of-bounds run-time error for assumed-size array) 

2007-10-14  Tobias Burnus  <burnus@net-b.de>

        PR fortran/33745
        * trans-array.c (gfc_conv_ss_startstride): Fix dimension check.
        (gfc_trans_array_bound_check, gfc_conv_array_ref,
        gfc_conv_ss_startstride): Simplify error message.
        * resolve.c (check_dimension): Fix dimension-type switch;
        improve error message.

2007-10-14  Tobias Burnus  <burnus@net-b.de>

        PR fortran/33745
        * gfortran.dg/bounds_check_11.f90: New.

From-SVN: r129302
This commit is contained in:
Tobias Burnus 2007-10-14 22:24:20 +02:00
parent 2c888488e1
commit 1954a27b0c
5 changed files with 107 additions and 37 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
gcc/fortran/ChangeLog
View File

@ -1,3 +1,12 @@
2007-10-14 Tobias Burnus <burnus@net-b.de>
PR fortran/33745
* trans-array.c (gfc_conv_ss_startstride): Fix dimension check.
(gfc_trans_array_bound_check, gfc_conv_array_ref,
gfc_conv_ss_startstride): Simplify error message.
* resolve.c (check_dimension): Fix dimension-type switch;
improve error message.
2007-10-13 Tobias Schlüter <tobi@gcc.gnu.org>
Paul Thomas <pault@gcc.gnu.org>

65
gcc/fortran/resolve.c
View File

@ -3215,20 +3215,32 @@ check_dimension (int i, gfc_array_ref *ar, gfc_array_spec *as)
/* Given start, end and stride values, calculate the minimum and
maximum referenced indexes. */
switch (ar->type)
switch (ar->dimen_type[i])
{
case AR_FULL:
case DIMEN_VECTOR:
break;
case AR_ELEMENT:
case DIMEN_ELEMENT:
if (compare_bound (ar->start[i], as->lower[i]) == CMP_LT)
goto bound;
{
gfc_warning ("Array reference at %L is out of bounds "
"(%ld < %ld) in dimension %d", &ar->c_where[i],
mpz_get_si (ar->start[i]->value.integer),
mpz_get_si (as->lower[i]->value.integer), i+1);
return SUCCESS;
}
if (compare_bound (ar->start[i], as->upper[i]) == CMP_GT)
goto bound;
{
gfc_warning ("Array reference at %L is out of bounds "
"(%ld > %ld) in dimension %d", &ar->c_where[i],
mpz_get_si (ar->start[i]->value.integer),
mpz_get_si (as->upper[i]->value.integer), i+1);
return SUCCESS;
}
break;
case AR_SECTION:
case DIMEN_RANGE:
{
#define AR_START (ar->start[i] ? ar->start[i] : as->lower[i])
#define AR_END (ar->end[i] ? ar->end[i] : as->upper[i])
@ -3253,9 +3265,22 @@ check_dimension (int i, gfc_array_ref *ar, gfc_array_spec *as)
|| (compare_bound_int (ar->stride[i], 0) == CMP_LT
&& comp_start_end == CMP_GT))
{
if (compare_bound (AR_START, as->lower[i]) == CMP_LT
|| compare_bound (AR_START, as->upper[i]) == CMP_GT)
goto bound;
if (compare_bound (AR_START, as->lower[i]) == CMP_LT)
{
gfc_warning ("Lower array reference at %L is out of bounds "
"(%ld < %ld) in dimension %d", &ar->c_where[i],
mpz_get_si (AR_START->value.integer),
mpz_get_si (as->lower[i]->value.integer), i+1);
return SUCCESS;
}
if (compare_bound (AR_START, as->upper[i]) == CMP_GT)
{
gfc_warning ("Lower array reference at %L is out of bounds "
"(%ld > %ld) in dimension %d", &ar->c_where[i],
mpz_get_si (AR_START->value.integer),
mpz_get_si (as->upper[i]->value.integer), i+1);
return SUCCESS;
}
}
/* If we can compute the highest index of the array section,
@ -3264,11 +3289,23 @@ check_dimension (int i, gfc_array_ref *ar, gfc_array_spec *as)
if (compute_last_value_for_triplet (AR_START, AR_END, ar->stride[i],
last_value))
{
if (compare_bound_mpz_t (as->lower[i], last_value) == CMP_GT
|| compare_bound_mpz_t (as->upper[i], last_value) == CMP_LT)
if (compare_bound_mpz_t (as->lower[i], last_value) == CMP_GT)
{
gfc_warning ("Upper array reference at %L is out of bounds "
"(%ld < %ld) in dimension %d", &ar->c_where[i],
mpz_get_si (last_value),
mpz_get_si (as->lower[i]->value.integer), i+1);
mpz_clear (last_value);
goto bound;
return SUCCESS;
}
if (compare_bound_mpz_t (as->upper[i], last_value) == CMP_LT)
{
gfc_warning ("Upper array reference at %L is out of bounds "
"(%ld > %ld) in dimension %d", &ar->c_where[i],
mpz_get_si (last_value),
mpz_get_si (as->upper[i]->value.integer), i+1);
mpz_clear (last_value);
return SUCCESS;
}
}
mpz_clear (last_value);
@ -3283,10 +3320,6 @@ check_dimension (int i, gfc_array_ref *ar, gfc_array_spec *as)
}
return SUCCESS;
bound:
gfc_warning ("Array reference at %L is out of bounds", &ar->c_where[i]);
return SUCCESS;
}

38
gcc/fortran/trans-array.c
View File

@ -2109,11 +2109,11 @@ gfc_trans_array_bound_check (gfc_se * se, tree descriptor, tree index, int n,
tmp = gfc_conv_array_lbound (descriptor, n);
fault = fold_build2 (LT_EXPR, boolean_type_node, index, tmp);
if (name)
asprintf (&msg, "%s for array '%s', lower bound of dimension %d exceeded",
gfc_msg_fault, name, n+1);
asprintf (&msg, "%s for array '%s', lower bound of dimension %d exceeded"
"(%%ld < %%ld)", gfc_msg_fault, name, n+1);
else
asprintf (&msg, "%s, lower bound of dimension %d exceeded, %%ld is "
"smaller than %%ld", gfc_msg_fault, n+1);
asprintf (&msg, "%s, lower bound of dimension %d exceeded (%%ld < %%ld)",
gfc_msg_fault, n+1);
gfc_trans_runtime_check (fault, &se->pre, where, msg,
fold_convert (long_integer_type_node, index),
fold_convert (long_integer_type_node, tmp));
@ -2126,10 +2126,10 @@ gfc_trans_array_bound_check (gfc_se * se, tree descriptor, tree index, int 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);
" exceeded (%%ld > %%ld)", gfc_msg_fault, name, n+1);
else
asprintf (&msg, "%s, upper bound of dimension %d exceeded, %%ld is "
"larger than %%ld", gfc_msg_fault, n+1);
asprintf (&msg, "%s, upper bound of dimension %d exceeded (%%ld > %%ld)",
gfc_msg_fault, n+1);
gfc_trans_runtime_check (fault, &se->pre, where, msg,
fold_convert (long_integer_type_node, index),
fold_convert (long_integer_type_node, tmp));
@ -2323,8 +2323,8 @@ gfc_conv_array_ref (gfc_se * se, gfc_array_ref * ar, gfc_symbol * sym,
cond = fold_build2 (LT_EXPR, boolean_type_node,
indexse.expr, tmp);
asprintf (&msg, "%s for array '%s', "
"lower bound of dimension %d exceeded, %%ld is smaller "
"than %%ld", gfc_msg_fault, sym->name, n+1);
"lower bound of dimension %d exceeded (%%ld < %%ld)",
gfc_msg_fault, sym->name, n+1);
gfc_trans_runtime_check (cond, &se->pre, where, msg,
fold_convert (long_integer_type_node,
indexse.expr),
@ -2340,8 +2340,8 @@ gfc_conv_array_ref (gfc_se * se, gfc_array_ref * ar, gfc_symbol * sym,
cond = fold_build2 (GT_EXPR, boolean_type_node,
indexse.expr, tmp);
asprintf (&msg, "%s for array '%s', "
"upper bound of dimension %d exceeded, %%ld is "
"greater than %%ld", gfc_msg_fault, sym->name, n+1);
"upper bound of dimension %d exceeded (%%ld > %%ld)",
gfc_msg_fault, sym->name, n+1);
gfc_trans_runtime_check (cond, &se->pre, where, msg,
fold_convert (long_integer_type_node,
indexse.expr),
@ -2888,7 +2888,7 @@ gfc_conv_ss_startstride (gfc_loopinfo * loop)
if (info->ref->u.ar.dimen_type[dim] != DIMEN_RANGE)
continue;
if (n == info->ref->u.ar.dimen - 1
if (dim == info->ref->u.ar.dimen - 1
&& (info->ref->u.ar.as->type == AS_ASSUMED_SIZE
|| info->ref->u.ar.as->cp_was_assumed))
check_upper = false;
@ -2941,7 +2941,7 @@ gfc_conv_ss_startstride (gfc_loopinfo * loop)
tmp = fold_build2 (TRUTH_AND_EXPR, boolean_type_node,
non_zerosized, tmp);
asprintf (&msg, "%s, lower bound of dimension %d of array '%s'"
" exceeded, %%ld is smaller than %%ld", gfc_msg_fault,
" exceeded (%%ld < %%ld)", gfc_msg_fault,
info->dim[n]+1, ss->expr->symtree->name);
gfc_trans_runtime_check (tmp, &block, &ss->expr->where, msg,
fold_convert (long_integer_type_node,
@ -2957,9 +2957,8 @@ gfc_conv_ss_startstride (gfc_loopinfo * loop)
tmp = fold_build2 (TRUTH_AND_EXPR, boolean_type_node,
non_zerosized, tmp);
asprintf (&msg, "%s, upper bound of dimension %d of array "
"'%s' exceeded, %%ld is greater than %%ld",
gfc_msg_fault, info->dim[n]+1,
ss->expr->symtree->name);
"'%s' exceeded (%%ld > %%ld)", gfc_msg_fault,
info->dim[n]+1, ss->expr->symtree->name);
gfc_trans_runtime_check (tmp, &block, &ss->expr->where, msg,
fold_convert (long_integer_type_node, info->start[n]),
fold_convert (long_integer_type_node, ubound));
@ -2980,7 +2979,7 @@ gfc_conv_ss_startstride (gfc_loopinfo * loop)
tmp = fold_build2 (TRUTH_AND_EXPR, boolean_type_node,
non_zerosized, tmp);
asprintf (&msg, "%s, lower bound of dimension %d of array '%s'"
" exceeded, %%ld is smaller than %%ld", gfc_msg_fault,
" exceeded (%%ld < %%ld)", gfc_msg_fault,
info->dim[n]+1, ss->expr->symtree->name);
gfc_trans_runtime_check (tmp, &block, &ss->expr->where, msg,
fold_convert (long_integer_type_node,
@ -2995,9 +2994,8 @@ gfc_conv_ss_startstride (gfc_loopinfo * loop)
tmp = fold_build2 (TRUTH_AND_EXPR, boolean_type_node,
non_zerosized, tmp);
asprintf (&msg, "%s, upper bound of dimension %d of array "
"'%s' exceeded, %%ld is greater than %%ld",
gfc_msg_fault, info->dim[n]+1,
ss->expr->symtree->name);
"'%s' exceeded (%%ld > %%ld)", gfc_msg_fault,
info->dim[n]+1, ss->expr->symtree->name);
gfc_trans_runtime_check (tmp, &block, &ss->expr->where, msg,
fold_convert (long_integer_type_node, tmp2),
fold_convert (long_integer_type_node, ubound));

7
gcc/testsuite/ChangeLog
View File

@ -1,6 +1,11 @@
2007-10-14 Tobias Burnus <burnus@net-b.de>
PR fortran/33745
* gfortran.dg/bounds_check_11.f90: New.
2007-10-14 Andrew Pinski <pinskia@gmail.com>
PR c++/30303
PR c++/30303
* g++.dg/other/ctor1.C: New test.
* g++.dg/other/ctor2.C: New test.
* g++.dg/other/dtor1.C: New test.

25
gcc/testsuite/gfortran.dg/bounds_check_11.f90 Normal file
View File

@ -0,0 +1,25 @@
! { dg-do run }
! { dg-options "-fbounds-check" }
! { dg-shouldfail "Array bound checking" }
! PR fortran/33745
!
! Don't check upper bound of assumed-size array
!
program test
implicit none
integer, parameter :: maxss=7,maxc=8
integer :: jp(2,maxc)
call findphase(jp)
contains
subroutine findphase(jp)
integer, intent(out) :: jp(2,*)
jp(2,2:4)=0
jp(2,0:4)=0 ! { dg-warning "out of bounds" }
jp(3,1:4)=0 ! { dg-warning "out of bounds" }
end subroutine
end program test
! { dg-output "At line 18 of file .*" }
! { dg-output "Array reference out of bounds, lower bound of dimension 2 of array 'jp' exceeded .0 < 1." }