Hello everyone,
since everybody seems to be submitting patches the last few days, I
thought I might as well :)
Attached is a patch that makes the compiler capable of dealing with
implied do variables in
array slices in data statements.
The copying of the expressions is necessary since
gfc_simplify_expr(expr, 1) substitutes every
symbol in expr that is on the iter_stack with its value.
Ok for trunk?
Nicolas
Regression tested for x86_64-pc-linux-gnu.
Changelog:
2017-05-09 Nicolas Koenig <koeni...@student.ethz.ch>
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-09 Nicolas Koenig <koeni...@student.ethz.ch>
PR fortran/80442
* gfortran.dg/impl_do_var_data.f90: New Test
Index: array.c
===================================================================
--- array.c (revision 247809)
+++ array.c (working copy)
@@ -2201,6 +2201,7 @@ gfc_ref_dimen_size (gfc_array_ref *ar, int dimen,
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_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
Index: data.c
===================================================================
--- data.c (revision 247809)
+++ data.c (working copy)
@@ -539,6 +539,7 @@ gfc_advance_section (mpz_t *section_index, gfc_arr
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_arr
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_arr
}
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_arr
{
/* 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 *s
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 *s
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);
! { dg-do run }
! { dg-options "" }
program main
implicit none
integer:: i
integer, dimension(4):: A
data (A(i:i+2:i), i=1,2) /1, 2, 3, 4, 5/
if(any(A .ne. [1,4,3,5])) call abort()
end program
