[Patch, fortran] PR84931 - Expansion of array constructor with constant implied-do-object goes sideways

[Paul Richard Thomas <paul dot richard dot thomas at gmail dot com>]

Thomas already committed a fix for the original problem (revisions
258641, 258666 & 258667).

However, I found another testcase that still failed - that of multiple
array constructors with iterators, within an array constructor without
an iterator. The attached fixes this and streamlines the implicated
chunk of code. Thomas's testcase is appropriately updated.

Bootstraps and regtests on FC27/x86_64 - OK for trunk, 7- and 6-branches?

Please note that I am not in a position to do any commits until Wednesday.

Paul

2018-03-25  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-25  Paul Thomas  <pault@gcc.gnu.org>

PR fortran/84931
* gfortran.dg/array_constructor_52.f90: Add new test.

Index: gcc/fortran/simplify.c
===================================================================
*** gcc/fortran/simplify.c	(revision 258835)
--- gcc/fortran/simplify.c	(working copy)
*************** gfc_simplify_xor (gfc_expr *x, gfc_expr
*** 7879,7886 ****
  gfc_expr *
  gfc_convert_constant (gfc_expr *e, bt type, int kind)
  {
!   gfc_expr *g, *result, *(*f) (gfc_expr *, int);
!   gfc_constructor *c;
  
    switch (e->ts.type)
      {
--- 7879,7886 ----
  gfc_expr *
  gfc_convert_constant (gfc_expr *e, bt type, int kind)
  {
!   gfc_expr *result, *(*f) (gfc_expr *, int);
!   gfc_constructor *c, *t;
  
    switch (e->ts.type)
      {
*************** gfc_convert_constant (gfc_expr *e, bt ty
*** 8017,8047 ****
  	  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);
! 	    }
! 	  else
! 	    {
! 	      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);
! 	    }
  	}
  
        break;
--- 8017,8040 ----
  	  gfc_expr *tmp;
  	  if (c->iterator == NULL)
  	    {
+ 	      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_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;
Index: gcc/testsuite/gfortran.dg/array_constructor_52.f90
===================================================================
*** gcc/testsuite/gfortran.dg/array_constructor_52.f90	(revision 258835)
--- gcc/testsuite/gfortran.dg/array_constructor_52.f90	(working copy)
***************
*** 3,11 ****
  ! handled correctly.
  program test
     implicit none
!    integer, parameter :: n = 2**16
     real, dimension(n) :: y
     integer :: i
!    y = (/ (1, i=1, n) /)
!    if (y(2) /= 1) stop 1
  end program test
--- 3,21 ----
  ! handled correctly.
  program test
     implicit none
!    integer, parameter :: n = 2**16 + 1
     real, dimension(n) :: y
+    real, dimension(2*n) :: z
     integer :: i
! 
!    y = [(1, i=1, n) ]          ! This was the original problem
!    if (int(y(2)) /= 1) stop 1
! 
!    y = [33, (1, i=1, n-1) ]    ! Check that something more complicated works
!    if (int(y(3)) /= 1) stop 2
! 
!    z = [[(1, i=1, n) ],[(2, i=1, n) ]] ! Failed with first version of the fix
! 
!    if (int(z(2)) /= 1) stop 3
!    if (int(z(n+1)) /= 2) stop 4
  end program test