diff mbox

[fortran] PR80442 Handle DATA statement with iteration var in array slice

Message ID 97eda4bd-8d46-386b-88c3-299b007fcc00@student.ethz.ch
State New
Headers show

Commit Message

Nicolas Koenig May 9, 2017, 8:49 p.m. UTC 
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  <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
diff mbox

Patch

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);