------- Comment #7 from pault at gcc dot gnu dot org 2007-05-07 05:44 -------
The patch below works and regtests. Before submitting it, however, I would
like to understand why I could not persuade the use of the repeat count to
work, rather than expanding to a full array.
Paul
Index: gcc/fortran/decl.c
===================================================================
*** gcc/fortran/decl.c (revision 124474)
--- gcc/fortran/decl.c (working copy)
*************** add_init_expr_to_sym (const char *name,
*** 974,980 ****
/* Add initializer. Make sure we keep the ranks sane. */
if (sym->attr.dimension && init->rank == 0)
! init->rank = sym->as->rank;
sym->value = init;
*initp = NULL;
--- 974,1004 ----
/* Add initializer. Make sure we keep the ranks sane. */
if (sym->attr.dimension && init->rank == 0)
! {
! mpz_t size;
! gfc_constructor *ctor, *tail;
! 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)
! {
! ctor = tail = gfc_get_constructor ();
! ctor->expr = init;
! for (n = 1; n < (int)mpz_get_si (size); n++)
! {
! tail->next = gfc_get_constructor ();
! tail = tail->next;
! tail->expr = gfc_copy_expr (init);
! }
! init = gfc_get_expr ();
! init->expr_type = EXPR_ARRAY;
! init->ts = ctor->expr->ts;
! init->value.constructor = ctor;
! mpz_clear (size);
! }
! init->rank = sym->as->rank;
! }
sym->value = init;
*initp = NULL;
Index: gcc/testsuite/gfortran.dg/parameter_array_init_1.f90
===================================================================
*** gcc/testsuite/gfortran.dg/parameter_array_init_1.f90 (revision 0)
--- gcc/testsuite/gfortran.dg/parameter_array_init_1.f90 (revision 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 <[EMAIL PROTECTED]>
+ !
+ 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
--
pault at gcc dot gnu dot org changed:
What |Removed |Added
----------------------------------------------------------------------------
AssignedTo|unassigned at gcc dot gnu |pault at gcc dot gnu dot org
|dot org |
Status|NEW |ASSIGNED
Last reconfirmed|2007-02-09 22:42:15 |2007-05-07 05:44:48
date| |
http://gcc.gnu.org/bugzilla/show_bug.cgi?id=29397
