re PR fortran/80442 (Rejects DATA statement with array slice)

2017-05-09  Nicolas Koenig  <koenigni@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  <koenigni@student.ethz.ch>

	PR fortran/80442
	* gfortran.dg/impl_do_var_data.f90: New Test

From-SVN: r248012

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index da9cf10dd6864357863384be1458b7e1dbba9d0d..f962ca93f29f84b5eff7634fc35e67d78f3591df 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,14 @@
+2017-05-14  Nicolas Koenig  <koenigni@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-13  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
 
        * io.c (gfc_resolve_dt): Fix returns to bool type.

diff --git a/gcc/fortran/array.c b/gcc/fortran/array.c
index ec0c26656ff65eb809947de8f1dcf89e0e86bc21..30656c197d07ce30a888ff01682afdd40ca46ed1 100644 (file)
--- 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 184e53d480ff4bae0bd1e11b94976c1148386d0a..587161ff09dd1354efde0b81e81cc1940c6ab6d6 100644 (file)
--- 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 c7e2dec96816fab5453e1828206c232ff60e0944..4713ecdf534bb28c1f28f2ddcac8e5f9db9360b5 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2017-05-14  Nicolas Koenig  <koenigni@student.ethz.ch>
+
+       PR fortran/80442
+       * gfortran.dg/impl_do_var_data.f90: New Test
+
 2017-05-13  Pekka Jääskeläinen  <pekka.jaaskelainen@parmance.com>
 
        * 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 (file)
index 0000000..191562d
--- /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