re PR fortran/29800 (-fbounds-check: For derived types, write not also compound name)
2013-06-26 Tobias Burnus <burnus@net-b.de> PR fortran/29800 * trans-array.c (gfc_conv_array_ref): Improve out-of-bounds diagnostic message. * trans-array.c (gfc_conv_array_ref): Update prototype. * trans-expr.c (gfc_conv_variable): Update call. 2013-06-26 Tobias Burnus <burnus@net-b.de> PR fortran/29800 * gfortran.dg/bounds_check_17.f90: New. From-SVN: r200425
This commit is contained in:
parent
fd8c65e7d3
commit
31f02c7752
6 changed files with 75 additions and 5 deletions
|
@ -1,3 +1,11 @@
|
|||
2013-06-26 Tobias Burnus <burnus@net-b.de>
|
||||
|
||||
PR fortran/29800
|
||||
* trans-array.c (gfc_conv_array_ref): Improve out-of-bounds
|
||||
diagnostic message.
|
||||
* trans-array.c (gfc_conv_array_ref): Update prototype.
|
||||
* trans-expr.c (gfc_conv_variable): Update call.
|
||||
|
||||
2013-06-24 Steven G. Kargl <sgk@troutmask.apl.washington.edu>
|
||||
Francois-Xavier Coudert <fxcoudert@gcc.gnu.org>
|
||||
Dominique d'Humieres <dominiq@lps.ens.fr>
|
||||
|
|
|
@ -3145,7 +3145,7 @@ build_array_ref (tree desc, tree offset, tree decl)
|
|||
a(i, j, k) = base[offset + i * stride[0] + j * stride[1] + k * stride[2]]*/
|
||||
|
||||
void
|
||||
gfc_conv_array_ref (gfc_se * se, gfc_array_ref * ar, gfc_symbol * sym,
|
||||
gfc_conv_array_ref (gfc_se * se, gfc_array_ref * ar, gfc_expr *expr,
|
||||
locus * where)
|
||||
{
|
||||
int n;
|
||||
|
@ -3154,6 +3154,8 @@ gfc_conv_array_ref (gfc_se * se, gfc_array_ref * ar, gfc_symbol * sym,
|
|||
tree stride;
|
||||
gfc_se indexse;
|
||||
gfc_se tmpse;
|
||||
gfc_symbol * sym = expr->symtree->n.sym;
|
||||
char *var_name = NULL;
|
||||
|
||||
if (ar->dimen == 0)
|
||||
{
|
||||
|
@ -3184,6 +3186,35 @@ gfc_conv_array_ref (gfc_se * se, gfc_array_ref * ar, gfc_symbol * sym,
|
|||
return;
|
||||
}
|
||||
|
||||
if (gfc_option.rtcheck & GFC_RTCHECK_BOUNDS)
|
||||
{
|
||||
size_t len;
|
||||
gfc_ref *ref;
|
||||
|
||||
len = strlen (sym->name) + 1;
|
||||
for (ref = expr->ref; ref; ref = ref->next)
|
||||
{
|
||||
if (ref->type == REF_ARRAY && &ref->u.ar == ar)
|
||||
break;
|
||||
if (ref->type == REF_COMPONENT)
|
||||
len += 1 + strlen (ref->u.c.component->name);
|
||||
}
|
||||
|
||||
var_name = XALLOCAVEC (char, len);
|
||||
strcpy (var_name, sym->name);
|
||||
|
||||
for (ref = expr->ref; ref; ref = ref->next)
|
||||
{
|
||||
if (ref->type == REF_ARRAY && &ref->u.ar == ar)
|
||||
break;
|
||||
if (ref->type == REF_COMPONENT)
|
||||
{
|
||||
strcat (var_name, "%%");
|
||||
strcat (var_name, ref->u.c.component->name);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
cst_offset = offset = gfc_index_zero_node;
|
||||
add_to_offset (&cst_offset, &offset, gfc_conv_array_offset (se->expr));
|
||||
|
||||
|
@ -3219,7 +3250,7 @@ gfc_conv_array_ref (gfc_se * se, gfc_array_ref * ar, gfc_symbol * sym,
|
|||
cond = fold_build2_loc (input_location, LT_EXPR, boolean_type_node,
|
||||
indexse.expr, tmp);
|
||||
asprintf (&msg, "Index '%%ld' of dimension %d of array '%s' "
|
||||
"below lower bound of %%ld", n+1, sym->name);
|
||||
"below lower bound of %%ld", n+1, var_name);
|
||||
gfc_trans_runtime_check (true, false, cond, &se->pre, where, msg,
|
||||
fold_convert (long_integer_type_node,
|
||||
indexse.expr),
|
||||
|
@ -3243,7 +3274,7 @@ gfc_conv_array_ref (gfc_se * se, gfc_array_ref * ar, gfc_symbol * sym,
|
|||
cond = fold_build2_loc (input_location, GT_EXPR,
|
||||
boolean_type_node, indexse.expr, tmp);
|
||||
asprintf (&msg, "Index '%%ld' of dimension %d of array '%s' "
|
||||
"above upper bound of %%ld", n+1, sym->name);
|
||||
"above upper bound of %%ld", n+1, var_name);
|
||||
gfc_trans_runtime_check (true, false, cond, &se->pre, where, msg,
|
||||
fold_convert (long_integer_type_node,
|
||||
indexse.expr),
|
||||
|
|
|
@ -123,7 +123,7 @@ void gfc_conv_resolve_dependencies (gfc_loopinfo *, gfc_ss *, gfc_ss *);
|
|||
tree gfc_build_null_descriptor (tree);
|
||||
|
||||
/* Get a single array element. */
|
||||
void gfc_conv_array_ref (gfc_se *, gfc_array_ref *, gfc_symbol *, locus *);
|
||||
void gfc_conv_array_ref (gfc_se *, gfc_array_ref *, gfc_expr *, locus *);
|
||||
/* Translate a reference to a temporary array. */
|
||||
void gfc_conv_tmp_array_ref (gfc_se * se);
|
||||
/* Translate a reference to an array temporary. */
|
||||
|
|
|
@ -1910,7 +1910,7 @@ gfc_conv_variable (gfc_se * se, gfc_expr * expr)
|
|||
&& ref->next == NULL && (se->descriptor_only))
|
||||
return;
|
||||
|
||||
gfc_conv_array_ref (se, &ref->u.ar, sym, &expr->where);
|
||||
gfc_conv_array_ref (se, &ref->u.ar, expr, &expr->where);
|
||||
/* Return a pointer to an element. */
|
||||
break;
|
||||
|
||||
|
|
|
@ -1,3 +1,8 @@
|
|||
2013-06-26 Tobias Burnus <burnus@net-b.de>
|
||||
|
||||
PR fortran/29800
|
||||
* gfortran.dg/bounds_check_17.f90: New.
|
||||
|
||||
2013-06-25 Ed Smith-Rowland <3dw4rd@verizon.net>
|
||||
|
||||
PR c++/57640
|
||||
|
|
26
gcc/testsuite/gfortran.dg/bounds_check_17.f90
Normal file
26
gcc/testsuite/gfortran.dg/bounds_check_17.f90
Normal file
|
@ -0,0 +1,26 @@
|
|||
! { dg-do run }
|
||||
! { dg-options "-fcheck=bounds" }
|
||||
! { dg-shouldfail "above upper bound" }
|
||||
!
|
||||
! PR fortran/29800
|
||||
!
|
||||
! Contributed by Joost VandeVondele
|
||||
!
|
||||
|
||||
TYPE data
|
||||
INTEGER :: x(10)
|
||||
END TYPE
|
||||
TYPE data_areas
|
||||
TYPE(data) :: y(10)
|
||||
END TYPE
|
||||
|
||||
TYPE(data_areas) :: z(10)
|
||||
|
||||
integer, volatile :: i,j,k
|
||||
i=1 ; j=1 ; k=11
|
||||
|
||||
z(i)%y(j)%x(k)=0
|
||||
|
||||
END
|
||||
|
||||
! { dg-output "At line 22 of file .*bounds_check_17.f90.*Fortran runtime error: Index '11' of dimension 1 of array 'z%y%x' above upper bound of 10" }
|
Loading…
Add table
Reference in a new issue