diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index da9cf10dd68..f962ca93f29 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,14 @@ +2017-05-14 Nicolas Koenig + + PR fortran/80442 + * array.c (gfc_ref_dimen_size): Simplify stride + expression + * data.c (gfc_advance_section): Simplify start, + end and stride expressions + (gfc_advance_section): Simplify start and end + expressions + (gfc_get_section_index): Simplify start expression + 2017-05-13 Jerry DeLisle * io.c (gfc_resolve_dt): Fix returns to bool type. diff --git a/gcc/fortran/array.c b/gcc/fortran/array.c index ec0c26656ff..30656c197d0 100644 --- a/gcc/fortran/array.c +++ b/gcc/fortran/array.c @@ -2201,6 +2201,7 @@ 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; + gfc_expr *stride_expr = NULL; if (dimen < 0 || ar == NULL || dimen > ar->dimen - 1) gfc_internal_error ("gfc_ref_dimen_size(): Bad dimension"); @@ -2225,12 +2226,16 @@ gfc_ref_dimen_size (gfc_array_ref *ar, int dimen, mpz_t *result, mpz_t *end) mpz_set_ui (stride, 1); else { - if (ar->stride[dimen]->expr_type != EXPR_CONSTANT) + stride_expr = gfc_copy_expr(ar->stride[dimen]); + if(!gfc_simplify_expr(stride_expr, 1)) + gfc_internal_error("Simplification error"); + if (stride_expr->expr_type != EXPR_CONSTANT) { mpz_clear (stride); return false; } - mpz_set (stride, ar->stride[dimen]->value.integer); + mpz_set (stride, stride_expr->value.integer); + gfc_free_expr(stride_expr); } /* Calculate the number of elements via gfc_dep_differce, but only if diff --git a/gcc/fortran/data.c b/gcc/fortran/data.c index 184e53d480f..587161ff09d 100644 --- a/gcc/fortran/data.c +++ b/gcc/fortran/data.c @@ -539,6 +539,7 @@ gfc_advance_section (mpz_t *section_index, gfc_array_ref *ar, mpz_t tmp; bool forwards; int cmp; + gfc_expr *start, *end, *stride; for (i = 0; i < ar->dimen; i++) { @@ -547,12 +548,16 @@ gfc_advance_section (mpz_t *section_index, gfc_array_ref *ar, if (ar->stride[i]) { + stride = gfc_copy_expr(ar->stride[i]); + if(!gfc_simplify_expr(stride, 1)) + gfc_internal_error("Simplification error"); mpz_add (section_index[i], section_index[i], - ar->stride[i]->value.integer); - if (mpz_cmp_si (ar->stride[i]->value.integer, 0) >= 0) - forwards = true; - else - forwards = false; + stride->value.integer); + if (mpz_cmp_si (stride->value.integer, 0) >= 0) + forwards = true; + else + forwards = false; + gfc_free_expr(stride); } else { @@ -561,7 +566,13 @@ gfc_advance_section (mpz_t *section_index, gfc_array_ref *ar, } if (ar->end[i]) - cmp = mpz_cmp (section_index[i], ar->end[i]->value.integer); + { + end = gfc_copy_expr(ar->end[i]); + if(!gfc_simplify_expr(end, 1)) + gfc_internal_error("Simplification error"); + cmp = mpz_cmp (section_index[i], end->value.integer); + gfc_free_expr(end); + } else cmp = mpz_cmp (section_index[i], ar->as->upper[i]->value.integer); @@ -569,7 +580,13 @@ gfc_advance_section (mpz_t *section_index, gfc_array_ref *ar, { /* Reset index to start, then loop to advance the next index. */ if (ar->start[i]) - mpz_set (section_index[i], ar->start[i]->value.integer); + { + start = gfc_copy_expr(ar->start[i]); + if(!gfc_simplify_expr(start, 1)) + gfc_internal_error("Simplification error"); + mpz_set (section_index[i], start->value.integer); + gfc_free_expr(start); + } else mpz_set (section_index[i], ar->as->lower[i]->value.integer); } @@ -679,6 +696,7 @@ gfc_get_section_index (gfc_array_ref *ar, mpz_t *section_index, mpz_t *offset) int i; mpz_t delta; mpz_t tmp; + gfc_expr *start; mpz_set_si (*offset, 0); mpz_init (tmp); @@ -692,11 +710,15 @@ gfc_get_section_index (gfc_array_ref *ar, mpz_t *section_index, mpz_t *offset) case DIMEN_RANGE: if (ar->start[i]) { - mpz_sub (tmp, ar->start[i]->value.integer, + start = gfc_copy_expr(ar->start[i]); + if(!gfc_simplify_expr(start, 1)) + gfc_internal_error("Simplification error"); + mpz_sub (tmp, start->value.integer, ar->as->lower[i]->value.integer); mpz_mul (tmp, tmp, delta); mpz_add (*offset, tmp, *offset); - mpz_set (section_index[i], ar->start[i]->value.integer); + mpz_set (section_index[i], start->value.integer); + gfc_free_expr(start); } else mpz_set (section_index[i], ar->as->lower[i]->value.integer); diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index c7e2dec9681..4713ecdf534 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2017-05-14 Nicolas Koenig + + PR fortran/80442 + * gfortran.dg/impl_do_var_data.f90: New Test + 2017-05-13 Pekka Jääskeläinen * brig.dg/test/gimple/priv-array-offset-access.hsail: diff --git a/gcc/testsuite/gfortran.dg/impl_do_var_data.f90 b/gcc/testsuite/gfortran.dg/impl_do_var_data.f90 new file mode 100644 index 00000000000..191562d61fd --- /dev/null +++ b/gcc/testsuite/gfortran.dg/impl_do_var_data.f90 @@ -0,0 +1,12 @@ +! { dg-do run } +! PR 80442 +! This test case used to produce an bogus error +! about the variables being below the lower +! array bounds +program main + implicit none + integer:: i + integer, dimension(3):: A + data (A(i:i+2:i+1), i=1,2) /1, 2, 3/ + if(any(A .ne. [1,3,2])) call abort() +end program