re PR fortran/29397 (Constant logical expression with parameter array)

2007-05-08  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/29397
	PR fortran/29400
	* decl.c (add_init_expr_to_sym): Expand a scalar initializer
	for a parameter array into an array expression with the right
	shape.
	* array.c (spec_dimen_size): Remove static attribute.
	* gfortran.h : Prototype for spec_dimen_size.

2007-05-08  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/29397
	* gfortran.dg/parameter_array_init_1.f90: New test.

	PR fortran/29400
	* gfortran.dg/parameter_array_init_2.f90: New test.

From-SVN: r124541

gcc/fortran/ChangeLog

+2007-05-08  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/29397
+	PR fortran/29400
+	* decl.c (add_init_expr_to_sym): Expand a scalar initializer
+	for a parameter array into an array expression with the right
+	shape.
+	* array.c (spec_dimen_size): Remove static attribute.
+	* gfortran.h : Prototype for spec_dimen_size.
+
 2007-05-07  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
 
 	PR fortran/31399

gcc/fortran/array.c

@@ -1714,7 +1714,7 @@ gfc_get_array_element (gfc_expr *array, int element)
 /* Get the size of single dimension of an array specification.  The
    array is guaranteed to be one dimensional.  */
 
-static try
+try
 spec_dimen_size (gfc_array_spec *as, int dimen, mpz_t *result)
 {
   if (as == NULL)

gcc/fortran/decl.c

@@ -974,7 +974,44 @@ add_init_expr_to_sym (const char *name, gfc_expr **initp,
 
       /* Add initializer.  Make sure we keep the ranks sane.  */
       if (sym->attr.dimension && init->rank == 0)
-	init->rank = sym->as->rank;
+	{
+	  mpz_t size;
+	  gfc_expr *array;
+	  gfc_constructor *c;
+	  int n;
+	  if (sym->attr.flavor == FL_PARAMETER
+		&& init->expr_type == EXPR_CONSTANT
+		&& spec_size (sym->as, &size) == SUCCESS
+		&& mpz_cmp_si (size, 0) > 0)
+	    {
+	      array = gfc_start_constructor (init->ts.type, init->ts.kind,
+					     &init->where);
+
+	      array->value.constructor = c = NULL;
+	      for (n = 0; n < (int)mpz_get_si (size); n++)
+		{
+		  if (array->value.constructor == NULL)
+		    {
+		      array->value.constructor = c = gfc_get_constructor ();
+		      c->expr = init;
+		    }
+		  else
+		    {
+		      c->next = gfc_get_constructor ();
+		      c = c->next;
+		      c->expr = gfc_copy_expr (init);
+		    }
+		}
+
+	      array->shape = gfc_get_shape (sym->as->rank);
+	      for (n = 0; n < sym->as->rank; n++)
+		spec_dimen_size (sym->as, n, &array->shape[n]);
+
+	      init = array;
+	      mpz_clear (size);
+	    }
+	  init->rank = sym->as->rank;
+	}
 
       sym->value = init;
       *initp = NULL;

gcc/fortran/gfortran.h

@@ -2121,6 +2121,7 @@ void gfc_insert_constructor (gfc_expr *, gfc_constructor *);
 gfc_constructor *gfc_get_constructor (void);
 tree gfc_conv_array_initializer (tree type, gfc_expr * expr);
 try spec_size (gfc_array_spec *, mpz_t *);
+try spec_dimen_size (gfc_array_spec *, int, mpz_t *);
 int gfc_is_compile_time_shape (gfc_array_spec *);
 
 /* interface.c -- FIXME: some of these should be in symbol.c */

gcc/testsuite/ChangeLog

+2007-05-08  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/29397
+	* gfortran.dg/parameter_array_init_1.f90: New test.
+
+	PR fortran/29400
+	* gfortran.dg/parameter_array_init_2.f90: New test.
+
 2007-05-08  Uros Bizjak  <ubizjak@gmail.com>
 
 	PR target/31854

gcc/testsuite/gfortran.dg/parameter_array_init_1.f90

+! { dg-do compile }
+! tests the fix for PR29397, in which the initializer for the parameter
+! 'J' was not expanded into an array.
+!
+! Contributed by Francois-Xavier Coudert <fxcoudert@gcc.gnu.org>
+!
+  INTEGER :: K(3) = 1
+  INTEGER, PARAMETER :: J(3) = 2
+  IF (ANY (MAXLOC (K, J<3) .NE. 1)) CALL ABORT ()
+  IF (ANY (J .NE. 2)) CALL ABORT ()
+END

gcc/testsuite/gfortran.dg/parameter_array_init_2.f90

+! { dg-do run }
+! { dg-options "-std=gnu" } ! suppress the warning about line 15
+! Thrashes the fix for PR29400, where the scalar initializers
+! were not expanded to arrays with the appropriate shape.
+!
+! Contributed by Francois-Xavier Coudert <fxcoudert@gcc.gnu.org>
+!
+  integer,parameter :: i(1,1) = 0, j(2) = 42
+
+  if (any (maxloc(j+j,mask=(j==2)) .ne. 0)) call abort ()
+  if (size(j+j) .ne. 2) call abort ()
+  if (minval(j+j) .ne. 84) call abort ()
+  if (minval(j,mask=(j==2)) .ne. huge (j)) call abort ()
+  if (maxval(j+j) .ne. 84) call abort ()
+  if (maxval(j,mask=(j==2)) .ne. -huge (j)-1) call abort ()
+  if (sum(j,mask=j==2) .ne. 0) call abort ()
+  if (sum(j+j) .ne. 168) call abort ()
+  if (product(j+j) .ne. 7056) call abort ()
+  if (any(ubound(j+j) .ne. 2)) call abort ()
+  if (any(lbound(j+j) .ne. 1)) call abort ()
+  if (dot_product(j+j,j) .ne. 7056) call abort ()
+  if (dot_product(j,j+j) .ne. 7056) call abort ()
+  if (count(i==1) .ne. 0) call abort ()
+  if (any(i==1)) call abort ()
+  if (all(i==1)) call abort ()
+  end