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:
parent
7ecc260031
commit
8cd61b3c8b
|
@ -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
|
||||
|
|
|
@ -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);
|
||||
|
|
|
@ -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
|
||||
|
||||
|
|
|
@ -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.
|
||||
|
|
|
@ -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
|
Loading…
Reference in New Issue