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

re PR fortran/58146 (Array slice bounds checking) 

2013-08-26  Thomas Koenig  <tkoenig@gcc.gnu.org>

	PR fortran/58146
	* array.c (gfc_ref_dimen_size):  If possible, use
	gfc_dep_difference to calculate array refrence
	sizes.  Fall back to integer code otherwise.
	* dependency.c (discard_nops).  Move up.
	Also discarde widening integer conversions.
	(gfc_dep_compare_expr):  Use discard_nops.

2013-08-26  Thomas Koenig  <tkoenig@gcc.gnu.org>

	PR fortran/58146
	* gfortran.dg/bounds_check_18.f90:  New test.

From-SVN: r201981
This commit is contained in:
Thomas Koenig 2013-08-25 22:55:12 +00:00
parent 7ecc260031
commit 8cd61b3c8b
5 changed files with 122 additions and 73 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
gcc/fortran/ChangeLog
View File

@ -1,3 +1,13 @@
2013-08-26 Thomas Koenig <tkoenig@gcc.gnu.org>
PR fortran/58146
* array.c (gfc_ref_dimen_size): If possible, use
gfc_dep_difference to calculate array refrence
sizes. Fall back to integer code otherwise.
* dependency.c (discard_nops). Move up.
Also discarde widening integer conversions.
(gfc_dep_compare_expr): Use discard_nops.
2013-08-23 Mikael Morin <mikael@gcc.gnu.org>
PR fortran/57798

66
gcc/fortran/array.c
View File

@ -2112,6 +2112,7 @@ bool
gfc_ref_dimen_size (gfc_array_ref *ar, int dimen, mpz_t *result, mpz_t *end)
{
mpz_t upper, lower, stride;
mpz_t diff;
bool t;
if (dimen < 0 || ar == NULL || dimen > ar->dimen - 1)
@ -2130,9 +2131,63 @@ gfc_ref_dimen_size (gfc_array_ref *ar, int dimen, mpz_t *result, mpz_t *end)
break;
case DIMEN_RANGE:
mpz_init (stride);
if (ar->stride[dimen] == NULL)
mpz_set_ui (stride, 1);
else
{
if (ar->stride[dimen]->expr_type != EXPR_CONSTANT)
{
mpz_clear (stride);
return false;
}
mpz_set (stride, ar->stride[dimen]->value.integer);
}
/* Calculate the number of elements via gfc_dep_differce, but only if
start and end are both supplied in the reference or the array spec.
This is to guard against strange but valid code like
subroutine foo(a,n)
real a(1:n)
n = 3
print *,size(a(n-1:))
where the user changes the value of a variable. If we have to
determine end as well, we cannot do this using gfc_dep_difference.
Fall back to the constants-only code then. */
if (end == NULL)
{
bool use_dep;
use_dep = gfc_dep_difference (ar->end[dimen], ar->start[dimen],
&diff);
if (!use_dep && ar->end[dimen] == NULL && ar->start[dimen] == NULL)
use_dep = gfc_dep_difference (ar->as->upper[dimen],
ar->as->lower[dimen], &diff);
if (use_dep)
{
mpz_init (*result);
mpz_add (*result, diff, stride);
mpz_div (*result, *result, stride);
if (mpz_cmp_ui (*result, 0) < 0)
mpz_set_ui (*result, 0);
mpz_clear (stride);
mpz_clear (diff);
return true;
}
}
/* Constant-only code here, which covers more cases
like a(:4) etc. */
mpz_init (upper);
mpz_init (lower);
mpz_init (stride);
t = false;
if (ar->start[dimen] == NULL)
@ -2163,15 +2218,6 @@ gfc_ref_dimen_size (gfc_array_ref *ar, int dimen, mpz_t *result, mpz_t *end)
mpz_set (upper, ar->end[dimen]->value.integer);
}
if (ar->stride[dimen] == NULL)
mpz_set_ui (stride, 1);
else
{
if (ar->stride[dimen]->expr_type != EXPR_CONSTANT)
goto cleanup;
mpz_set (stride, ar->stride[dimen]->value.integer);
}
mpz_init (*result);
mpz_sub (*result, upper, lower);
mpz_add (*result, *result, stride);

105
gcc/fortran/dependency.c
View File

@ -240,6 +240,46 @@ gfc_dep_compare_functions (gfc_expr *e1, gfc_expr *e2, bool impure_ok)
return -2;
}
/* Helper function to look through parens, unary plus and widening
integer conversions. */
static gfc_expr*
discard_nops (gfc_expr *e)
{
gfc_actual_arglist *arglist;
if (e == NULL)
return NULL;
while (true)
{
if (e->expr_type == EXPR_OP
&& (e->value.op.op == INTRINSIC_UPLUS
|| e->value.op.op == INTRINSIC_PARENTHESES))
{
e = e->value.op.op1;
continue;
}
if (e->expr_type == EXPR_FUNCTION && e->value.function.isym
&& e->value.function.isym->id == GFC_ISYM_CONVERSION
&& e->ts.type == BT_INTEGER)
{
arglist = e->value.function.actual;
if (arglist->expr->ts.type == BT_INTEGER
&& e->ts.kind > arglist->expr->ts.kind)
{
e = arglist->expr;
continue;
}
}
break;
}
return e;
}
/* Compare two expressions. Return values:
* +1 if e1 > e2
* 0 if e1 == e2
@ -252,59 +292,13 @@ gfc_dep_compare_functions (gfc_expr *e1, gfc_expr *e2, bool impure_ok)
int
gfc_dep_compare_expr (gfc_expr *e1, gfc_expr *e2)
{
gfc_actual_arglist *args1;
gfc_actual_arglist *args2;
int i;
gfc_expr *n1, *n2;
n1 = NULL;
n2 = NULL;
if (e1 == NULL && e2 == NULL)
return 0;
/* Remove any integer conversion functions to larger types. */
if (e1->expr_type == EXPR_FUNCTION && e1->value.function.isym
&& e1->value.function.isym->id == GFC_ISYM_CONVERSION
&& e1->ts.type == BT_INTEGER)
{
args1 = e1->value.function.actual;
if (args1->expr->ts.type == BT_INTEGER
&& e1->ts.kind > args1->expr->ts.kind)
n1 = args1->expr;
}
if (e2->expr_type == EXPR_FUNCTION && e2->value.function.isym
&& e2->value.function.isym->id == GFC_ISYM_CONVERSION
&& e2->ts.type == BT_INTEGER)
{
args2 = e2->value.function.actual;
if (args2->expr->ts.type == BT_INTEGER
&& e2->ts.kind > args2->expr->ts.kind)
n2 = args2->expr;
}
if (n1 != NULL)
{
if (n2 != NULL)
return gfc_dep_compare_expr (n1, n2);
else
return gfc_dep_compare_expr (n1, e2);
}
else
{
if (n2 != NULL)
return gfc_dep_compare_expr (e1, n2);
}
if (e1->expr_type == EXPR_OP
&& (e1->value.op.op == INTRINSIC_UPLUS
|| e1->value.op.op == INTRINSIC_PARENTHESES))
return gfc_dep_compare_expr (e1->value.op.op1, e2);
if (e2->expr_type == EXPR_OP
&& (e2->value.op.op == INTRINSIC_UPLUS
|| e2->value.op.op == INTRINSIC_PARENTHESES))
return gfc_dep_compare_expr (e1, e2->value.op.op1);
e1 = discard_nops (e1);
e2 = discard_nops (e2);
if (e1->expr_type == EXPR_OP && e1->value.op.op == INTRINSIC_PLUS)
{
@ -501,21 +495,6 @@ gfc_dep_compare_expr (gfc_expr *e1, gfc_expr *e2)
}
/* Helper function to look through parens and unary plus. */
static gfc_expr*
discard_nops (gfc_expr *e)
{
while (e && e->expr_type == EXPR_OP
&& (e->value.op.op == INTRINSIC_UPLUS
|| e->value.op.op == INTRINSIC_PARENTHESES))
e = e->value.op.op1;
return e;
}
/* Return the difference between two expressions. Integer expressions of
the form

5
gcc/testsuite/ChangeLog
View File

@ -1,3 +1,8 @@
2013-08-26 Thomas Koenig <tkoenig@gcc.gnu.org>
PR fortran/58146
* gfortran.dg/bounds_check_18.f90: New test.
2013-08-23 Jan Hubicka <jh@suse.cz>
* g++.dg/ipa/devirt-14.C: Fix typo.

9
gcc/testsuite/gfortran.dg/bounds_check_18.f90 Normal file
View File

@ -0,0 +1,9 @@
! { dg-do compile }
program main
implicit none
integer :: n
real, dimension(10) :: a
n = 0
call random_number(a)
if (any(a(n+1:n+5) > [1.0, 2.0, 3.0])) print *,"Hello!" ! { dg-error "not conformable" }
end program main