Re: [patch, fortran] PR34556 Rejects valid with bogus error message: parameter initalization

[Jerry DeLisle <jvdelisle at verizon dot net>]

Paul Richard Thomas wrote:
> Jerry,
>
> I suggest that you make a local, renamed  copy of gfc_is_constant_expr
> and put the exclusion of functions in that.  That'll make the patch
> look a sight neater.  Also, I guess that other transformational
> functions need the same treatment?

Here is revised patch with Paul's suggestions.  I would like to get this in 
before looking at other transformational functions.  Test cases attached.  I 
will probably combine these into one. The reshape_3.f90 is Paul's example in 
this thread.

Regression tested on X86-84.

OK for trunk?

Jerry

2008-01-15  Jerry DeLisle  <jvdelisle@gcc.gnu.org>

	PR fortran/34556
	* simplify.c (is_constant_array_expr): New static function that returns
	true if the given expression is an array and is constant.
	(gfc_simplify_reshape): Use new function.

Index: simplify.c
===================================================================
--- simplify.c	(revision 131492)
+++ simplify.c	(working copy)
@@ -3164,6 +3164,30 @@ gfc_simplify_repeat (gfc_expr *e, gfc_ex
 }
 
 
+/* Test that the expression is a constant array.  */
+
+static bool
+is_constant_array_expr (gfc_expr *e)
+{
+  gfc_constructor *c;
+
+  if (e == NULL)
+    return true;
+
+  if (e->expr_type != EXPR_ARRAY || !gfc_is_constant_expr (e))
+    return false;
+  
+  if (e->value.constructor == NULL)
+    return false;
+  
+  for (c = e->value.constructor; c; c = c->next)
+    if (c->expr->expr_type != EXPR_CONSTANT)
+      return false;
+
+  return true;
+}
+
+
 /* This one is a bear, but mainly has to do with shuffling elements.  */
 
 gfc_expr *
@@ -3178,22 +3202,21 @@ gfc_simplify_reshape (gfc_expr *source, 
   size_t nsource;
   gfc_expr *e;
 
-  /* Unpack the shape array.  */
-  if (source->expr_type != EXPR_ARRAY || !gfc_is_constant_expr (source))
+  /* Check that argument expression types are OK.  */
+  if (!is_constant_array_expr (source))
     return NULL;
 
-  if (shape_exp->expr_type != EXPR_ARRAY || !gfc_is_constant_expr (shape_exp))
+  if (!is_constant_array_expr (shape_exp))
     return NULL;
 
-  if (pad != NULL
-      && (pad->expr_type != EXPR_ARRAY || !gfc_is_constant_expr (pad)))
+  if (!is_constant_array_expr (pad))
     return NULL;
 
-  if (order_exp != NULL
-      && (order_exp->expr_type != EXPR_ARRAY
-	  || !gfc_is_constant_expr (order_exp)))
+  if (!is_constant_array_expr (order_exp))
     return NULL;
 
+  /* Proceed with simplification, unpacking the array.  */
+
   mpz_init (index);
   rank = 0;
   head = tail = NULL;

! { dg-do run }
! PR34556 Rejects valid with bogus error message: parameter initalization
! Found using the Fortran Company Fortran 90 Test Suite (Lite),
! Version 1.4
! Test case modified by Jerry DeLisle  <jvdelisle@gcc.gnu.org to
! show correct results.
module splitprms
      integer, parameter  :: nplam = 3 ! # of plans to expand TABs
      integer, parameter  :: linem = 132 ! max. line length
      integer, parameter  :: ncntm = 39 ! max. # cont. lines
      integer, parameter, dimension (linem, nplam) :: nxttab =  &
      reshape (                                                 &
               (/ max( (/ (6+3*((i-6+3)/3), i= 1,linem),        &
                          (6+2*((i-6+2)/2), i= 1,linem) /),     &
                       (/ (6, i= 1, 2*linem) /)            ),   &
                  (/                      (i, i= 1,linem) /) /),&
                (/ linem, nplam /) )
end module splitprms

program test
  use splitprms
  if (nxttab(1, 1) .ne. 6) call abort
  if (nxttab(1, nplam) .ne. 1) call abort
  if (nxttab(linem, 1) .ne. 135) call abort
  if (nxttab(linem, nplam) .ne. 132) call abort
end program test
! { dg-final { cleanup-modules "splitprms" } }

! { dg-do run }
! PR34556 Rejects valid with bogus error message: parameter initalization
! Found using the Fortran Company Fortran 90 Test Suite (Lite),
! Version 1.4
! Test case modified by Jerry DeLisle  <jvdelisle@gcc.gnu.org to
! show correct results.
module splitprms
      integer, parameter  :: nplam = 3 ! # of plans to expand TABs
      integer, parameter  :: linem = 132 ! max. line length
      integer, parameter  :: ncntm = 39 ! max. # cont. lines
      integer, parameter, dimension (linem, nplam) :: nxttab =  &
      reshape ([[(6, i= 1, 2*linem) ], [(i, i= 1,linem)],    &
                max ([(i, i= 1,linem)], [(10*i, i= 1,linem)])],      &
               [linem, nplam ])
end module splitprms

program test
  use splitprms
  if (nxttab(1, 1) .ne. 6) print *, nxttab(1, 1)
  if (nxttab(1, nplam) .ne. 1) print *, nxttab(1, nplam)
  if (nxttab(linem, 1) .ne. 6) print *, nxttab(linem, 1)
  if (nxttab(linem, nplam) .ne. 132) print *, nxttab(linem, nplam)
end program test
! { dg-final { cleanup-modules "splitprms" } }