re PR fortran/84931 (Expansion of array constructor with constant implied-do-object goes sideways)

2018-03-30  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/84931
	* simplify.c (gfc_convert_constant): Handle case of array
	constructors within an array that has no iterator and improve
	the conciseness of this section of code.

2018-03-30  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/84931
	* gfortran.dg/array_constructor_53.f90: New test.

From-SVN: r258977

gcc/fortran/ChangeLog

+2018-03-30  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/84931
+	* simplify.c (gfc_convert_constant): Handle case of array
+	constructors within an array that has no iterator and improve
+	the conciseness of this section of code.
+
 2017-03-30  Thomas Koenig  <tkoenig@gcc.gnu.org>
 
 	PR fortran/85111
@@ -12,7 +19,7 @@
 	PR fortran/69497
 	* symbol.c (gfc_symbol_done_2): Start freeing namespaces
 	from the root.
-	(gfc_free_namespace): Restore assert (revert r258839). 
+	(gfc_free_namespace): Restore assert (revert r258839).
 
 2018-03-28  Jakub Jelinek  <jakub@redhat.com>
 

gcc/fortran/simplify.c

@@ -380,7 +380,7 @@ compute_dot_product (gfc_expr *matrix_a, int stride_a, int offset_a,
 {
   gfc_expr *result, *a, *b, *c;
 
-  /* Set result to an INTEGER(1) 0 for numeric types and .false. for 
+  /* Set result to an INTEGER(1) 0 for numeric types and .false. for
      LOGICAL.  Mixed-mode math in the loop will promote result to the
      correct type and kind.  */
   if (matrix_a->ts.type == BT_LOGICAL)
@@ -2086,7 +2086,7 @@ gfc_simplify_cshift (gfc_expr *array, gfc_expr *shift, gfc_expr *dim)
     }
   else
     shiftvec = NULL;
-  
+
   /* Shut up compiler */
   len = 1;
   rsoffset = 1;
@@ -2296,7 +2296,7 @@ gfc_simplify_dim (gfc_expr *x, gfc_expr *y)
 gfc_expr*
 gfc_simplify_dot_product (gfc_expr *vector_a, gfc_expr *vector_b)
 {
-  /* If vector_a is a zero-sized array, the result is 0 for INTEGER, 
+  /* If vector_a is a zero-sized array, the result is 0 for INTEGER,
      REAL, and COMPLEX types and .false. for LOGICAL.  */
   if (vector_a->shape && mpz_get_si (vector_a->shape[0]) == 0)
     {
@@ -2423,7 +2423,7 @@ gfc_simplify_eoshift (gfc_expr *array, gfc_expr *shift, gfc_expr *boundary,
     {
       if (boundary->rank > 0)
 	gfc_simplify_expr (boundary, 1);
-      
+
       if (!gfc_is_constant_expr (boundary))
 	  return NULL;
     }
@@ -2443,7 +2443,7 @@ gfc_simplify_eoshift (gfc_expr *array, gfc_expr *shift, gfc_expr *boundary,
       temp_boundary = true;
       switch (array->ts.type)
 	{
-	  
+
 	case BT_INTEGER:
 	  bnd = gfc_get_int_expr (array->ts.kind, NULL, 0);
 	  break;
@@ -2477,7 +2477,7 @@ gfc_simplify_eoshift (gfc_expr *array, gfc_expr *shift, gfc_expr *boundary,
       temp_boundary = false;
       bnd = boundary;
     }
-  
+
   gfc_array_size (array, &size);
   arraysize = mpz_get_ui (size);
   mpz_clear (size);
@@ -2615,7 +2615,7 @@ gfc_simplify_eoshift (gfc_expr *array, gfc_expr *shift, gfc_expr *boundary,
 
       if (bnd_ctor)
 	bnd_ctor = gfc_constructor_next (bnd_ctor);
-      
+
       count[0]++;
       n = 0;
       while (count[n] == extent[n])
@@ -5316,7 +5316,7 @@ simplify_minmaxloc_to_array (gfc_expr *result, gfc_expr *array,
 	  if (*src && min_max_choose (*src, ex, sign) > 0)
 	    mpz_set_si ((*dest)->value.integer, n + 1);
 	}
- 
+
       count[0]++;
       base += sstride[0];
       dest += dstride[0];
@@ -5373,7 +5373,7 @@ gfc_simplify_minmaxloc (gfc_expr *array, gfc_expr *dim, gfc_expr *mask,
   gfc_expr *extremum;
   int ikind;
   int init_val;
-  
+
   if (!is_constant_array_expr (array)
       || !gfc_is_constant_expr (dim))
     return NULL;
@@ -7879,8 +7879,8 @@ gfc_simplify_xor (gfc_expr *x, gfc_expr *y)
 gfc_expr *
 gfc_convert_constant (gfc_expr *e, bt type, int kind)
 {
-  gfc_expr *g, *result, *(*f) (gfc_expr *, int);
-  gfc_constructor *c;
+  gfc_expr *result, *(*f) (gfc_expr *, int);
+  gfc_constructor *c, *t;
 
   switch (e->ts.type)
     {
@@ -8017,31 +8017,24 @@ gfc_convert_constant (gfc_expr *e, bt type, int kind)
 	  gfc_expr *tmp;
 	  if (c->iterator == NULL)
 	    {
-	      tmp = f (c->expr, kind);
-	      if (tmp == NULL)
-		{
-		  gfc_free_expr (result);
-		  return NULL;
-		}
-
-	      gfc_constructor_append_expr (&result->value.constructor,
-					   tmp, &c->where);
+	      if (c->expr->expr_type == EXPR_ARRAY)
+		tmp = gfc_convert_constant (c->expr, type, kind);
+	      else
+		tmp = f (c->expr, kind);
 	    }
 	  else
+	    tmp = gfc_convert_constant (c->expr, type, kind);
+
+	  if (tmp == NULL || tmp == &gfc_bad_expr)
 	    {
-	      gfc_constructor *n;
-	      g = gfc_convert_constant (c->expr, type, kind);
-	      if (g == NULL || g == &gfc_bad_expr)
-	        {
-		  gfc_free_expr (result);
-		  return g;
-		}
-	      n = gfc_constructor_get ();
-	      n->expr = g;
-	      n->iterator = gfc_copy_iterator (c->iterator);
-	      n->where = c->where;
-	      gfc_constructor_append (&result->value.constructor, n);
+	      gfc_free_expr (result);
+	      return NULL;
 	    }
+
+	  t = gfc_constructor_append_expr (&result->value.constructor,
+					   tmp, &c->where);
+	  if (c->iterator)
+	    t->iterator = gfc_copy_iterator (c->iterator);
 	}
 
       break;

gcc/testsuite/ChangeLog

+2018-03-30  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/84931
+	* gfortran.dg/array_constructor_53.f90: New test.
+
 2018-03-30  Thomas Koenig  <tkoenig@gcc.gnu.org>
 
 	PR fortran/85130

gcc/testsuite/gfortran.dg/array_constructor_53.f90

+! { dg-do  run }
+! PR 84931 - long array constructors with type conversion were not
+! handled correctly. array_constructor_52.f90 tests the original
+! problem.
+program test
+   implicit none
+   integer, parameter :: n = 2**16 + 1
+   real, dimension(n) :: y
+   real, dimension(2*n) :: z
+   integer :: i
+
+   y = [33, (1, i=1, n-1) ]    ! Check that something more complicated works
+   if (int(y(3)) /= 1) stop 1
+
+   z = [[(1, i=1, n) ],[(2, i=1, n) ]] ! Failed with first version of the fix
+
+   if (int(z(2)) /= 1) stop 2
+   if (int(z(n+1)) /= 2) stop 3
+end program test