+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
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)
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)
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);
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
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)
{
}
-/* 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
+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.
--- /dev/null
+! { 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
projects / gcc.git / commitdiff