procyberian/gcc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Fortran: improve bounds-checking for array sections [PR30802]

Browse source 
gcc/fortran/ChangeLog:

	PR fortran/30802
	* trans-array.cc (trans_array_bound_check): Add optional argument
	COMPNAME for explicit specification of array component name.
	(array_bound_check_elemental): Helper function for generating
	bounds-checking code for elemental dimensions.
	(gfc_conv_expr_descriptor): Use bounds-checking also for elemental
	dimensions, i.e. those not handled by the scalarizer.

gcc/testsuite/ChangeLog:

	PR fortran/30802
	* gfortran.dg/bounds_check_fail_6.f90: New test.
This commit is contained in:
Harald Anlauf 2023-09-15 19:13:38 +02:00
parent b975c0dc3b
commit 1cbf18978a
2 changed files with 97 additions and 1 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

69
gcc/fortran/trans-array.cc
View file

@ -3452,7 +3452,8 @@ gfc_conv_array_ubound (tree descriptor, int dim)
static tree
trans_array_bound_check (gfc_se * se, gfc_ss *ss, tree index, int n,
locus * where, bool check_upper)
locus * where, bool check_upper,
const char *compname = NULL)
{
tree fault;
tree tmp_lo, tmp_up;
@ -3474,6 +3475,10 @@ trans_array_bound_check (gfc_se * se, gfc_ss *ss, tree index, int n,
if (VAR_P (descriptor))
name = IDENTIFIER_POINTER (DECL_NAME (descriptor));
/* Use given (array component) name. */
if (compname)
name = compname;
/* If upper bound is present, include both bounds in the error message. */
if (check_upper)
{
@ -3524,6 +3529,64 @@ trans_array_bound_check (gfc_se * se, gfc_ss *ss, tree index, int n,
}
/* Generate code for bounds checking for elemental dimensions. */
static void
array_bound_check_elemental (gfc_se * se, gfc_ss * ss, gfc_expr * expr)
{
gfc_array_ref *ar;
gfc_ref *ref;
gfc_symbol *sym;
char *var_name = NULL;
size_t len;
int dim;
if (expr->expr_type == EXPR_VARIABLE)
{
sym = expr->symtree->n.sym;
len = strlen (sym->name) + 1;
for (ref = expr->ref; ref; ref = ref->next)
if (ref->type == REF_COMPONENT)
len += 2 + strlen (ref->u.c.component->name);
var_name = XALLOCAVEC (char, len);
strcpy (var_name, sym->name);
for (ref = expr->ref; ref; ref = ref->next)
{
/* Append component name. */
if (ref->type == REF_COMPONENT)
{
strcat (var_name, "%%");
strcat (var_name, ref->u.c.component->name);
continue;
}
if (ref->type == REF_ARRAY && ref->u.ar.dimen > 0)
{
ar = &ref->u.ar;
for (dim = 0; dim < ar->dimen; dim++)
{
if (ar->dimen_type[dim] == DIMEN_ELEMENT)
{
gfc_se indexse;
gfc_init_se (&indexse, NULL);
gfc_conv_expr_type (&indexse, ar->start[dim],
gfc_array_index_type);
trans_array_bound_check (se, ss, indexse.expr, dim,
&ar->where,
ar->as->type != AS_ASSUMED_SIZE
|| dim < ar->dimen - 1,
var_name);
}
}
}
}
}
}
/* Return the offset for an index. Performs bound checking for elemental
dimensions. Single element references are processed separately.
DIM is the array dimension, I is the loop dimension. */
@ -7823,6 +7886,10 @@ gfc_conv_expr_descriptor (gfc_se *se, gfc_expr *expr)
/* Setup the scalarizing loops and bounds. */
gfc_conv_ss_startstride (&loop);
/* Add bounds-checking for elemental dimensions. */
if ((gfc_option.rtcheck & GFC_RTCHECK_BOUNDS) && !expr->no_bounds_check)
array_bound_check_elemental (se, ss, expr);
if (need_tmp)
{
if (expr->ts.type == BT_CHARACTER

29
gcc/testsuite/gfortran.dg/bounds_check_fail_6.f90 Normal file
View file

@ -0,0 +1,29 @@
! { dg-do run }
! { dg-additional-options "-fcheck=bounds -g -fdump-tree-original" }
! { dg-output "At line 18 .*" }
! { dg-shouldfail "dimension 3 of array 'u%z' outside of expected range" }
!
! PR fortran/30802 - improve bounds-checking for array sections
program test
implicit none
integer :: k = 0
integer, dimension(10,20,30) :: x = 42
type t
real, dimension(10,20,30) :: z = 23
end type t
type(t) :: u
! pr30802
print *, u% z(1,:,k) ! runtime check only for dimension 3
! pr97039
call foo (x(k,:,k+1)) ! runtime checks for dimensions 1,3
contains
subroutine foo (a)
integer, intent(in) :: a(:)
end subroutine foo
end program test
! { dg-final { scan-tree-dump-times "'u%%z.' outside of expected range" 2 "original" } }
! { dg-final { scan-tree-dump-times "'x.' outside of expected range" 4 "original" } }