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

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 3831e7443e4dfa80b610338509c6db934848b508..7a145fa2d4947163fd201b44bfe193332090584f 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,13 @@
+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

diff --git a/gcc/fortran/array.c b/gcc/fortran/array.c
index 895bccc14d108959a6534a366fbd9e9a4b870f1d..9359624efec4c9dce7dda2fceba34be5dd19ddb5 100644 (file)
--- a/gcc/fortran/array.c
+++ b/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)

diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c
index 1dcc53dd067f2b9ccfd6ca4a6b1a4e9a374d7d78..0071f9056111ad7547e2825b2ec496d072a9cda2 100644 (file)
--- a/gcc/fortran/decl.c
+++ b/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;

diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index df0896dd068e88d78bcdc91d87223b43e17d4e26..2030ec29bb286d7752a90c0e5cfbbe4f85ecbd3d 100644 (file)
--- a/gcc/fortran/gfortran.h
+++ b/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 */

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 6ba856d986852ade443bda30fe8e1b9b675d1a96..3c6d9c49bd9a48fe1f8a646508c2c51681e47a23 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,11 @@
+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

diff --git a/gcc/testsuite/gfortran.dg/parameter_array_init_1.f90 b/gcc/testsuite/gfortran.dg/parameter_array_init_1.f90
new file mode 100644 (file)
index 0000000..bb029a5
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/parameter_array_init_1.f90
@@ -0,0 +1,11 @@
+! { 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

diff --git a/gcc/testsuite/gfortran.dg/parameter_array_init_2.f90 b/gcc/testsuite/gfortran.dg/parameter_array_init_2.f90
new file mode 100644 (file)
index 0000000..bf238e5
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/parameter_array_init_2.f90
@@ -0,0 +1,26 @@
+! { 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\r
+\r
+  if (any (maxloc(j+j,mask=(j==2)) .ne. 0)) call abort ()\r
+  if (size(j+j) .ne. 2) call abort ()\r
+  if (minval(j+j) .ne. 84) call abort ()\r
+  if (minval(j,mask=(j==2)) .ne. huge (j)) call abort ()\r
+  if (maxval(j+j) .ne. 84) call abort ()\r
+  if (maxval(j,mask=(j==2)) .ne. -huge (j)-1) call abort ()\r
+  if (sum(j,mask=j==2) .ne. 0) call abort ()\r
+  if (sum(j+j) .ne. 168) call abort ()\r
+  if (product(j+j) .ne. 7056) call abort ()\r
+  if (any(ubound(j+j) .ne. 2)) call abort ()\r
+  if (any(lbound(j+j) .ne. 1)) call abort ()\r
+  if (dot_product(j+j,j) .ne. 7056) call abort ()\r
+  if (dot_product(j,j+j) .ne. 7056) call abort ()\r
+  if (count(i==1) .ne. 0) call abort ()\r
+  if (any(i==1)) call abort ()\r
+  if (all(i==1)) call abort ()\r
+  end\r