2009-10-01 Tobias Burnus <burnus@net-b.de>

        PR fortran/41515
        * decl.c (do_parm): Call add_init_expr_to_sym.

2009-10-01  Tobias Burnus  <burnus@net-b.de>

        PR fortran/41515
        * gfortran.dg/parameter_array_init_5.f90: New test.

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@152377 138bc75d-0d04-0410-961f-82ee72b054a4

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 2398dd0..06e1ae5 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,8 @@
+2009-10-01  Tobias Burnus  <burnus@net-b.de>
+
+       PR fortran/41515
+       * decl.c (do_parm): Call add_init_expr_to_sym.
+
 2009-09-30  Dennis Wassel  <dennis.wassel@gmail.com>
 
        * gcc/fortran/trans-array.c (gfc_trans_array_bound_check): Improved

diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c
index 20718ca..8244204 100644 (file)
--- a/gcc/fortran/decl.c
+++ b/gcc/fortran/decl.c
@@ -6261,6 +6261,7 @@ do_parm (void)
   gfc_symbol *sym;
   gfc_expr *init;
   match m;
+  gfc_try t;
 
   m = gfc_match_symbol (&sym, 0);
   if (m == MATCH_NO)
@@ -6302,35 +6303,8 @@ do_parm (void)
       goto cleanup;
     }
 
-  if (sym->ts.type == BT_CHARACTER
-      && sym->ts.u.cl != NULL
-      && sym->ts.u.cl->length != NULL
-      && sym->ts.u.cl->length->expr_type == EXPR_CONSTANT
-      && init->expr_type == EXPR_CONSTANT
-      && init->ts.type == BT_CHARACTER)
-    gfc_set_constant_character_len (
-      mpz_get_si (sym->ts.u.cl->length->value.integer), init, -1);
-  else if (sym->ts.type == BT_CHARACTER && sym->ts.u.cl != NULL
-          && sym->ts.u.cl->length == NULL)
-       {
-         int clen;
-         if (init->expr_type == EXPR_CONSTANT)
-           {
-             clen = init->value.character.length;
-             sym->ts.u.cl->length = gfc_int_expr (clen);
-           }
-         else if (init->expr_type == EXPR_ARRAY)
-           {
-             gfc_expr *p = init->value.constructor->expr;
-             clen = p->value.character.length;
-             sym->ts.u.cl->length = gfc_int_expr (clen);
-           }
-         else if (init->ts.u.cl && init->ts.u.cl->length)
-           sym->ts.u.cl->length = gfc_copy_expr (sym->value->ts.u.cl->length);
-       }
-
-  sym->value = init;
-  return MATCH_YES;
+  t = add_init_expr_to_sym (sym->name, &init, &gfc_current_locus);
+  return (t == SUCCESS) ? MATCH_YES : MATCH_ERROR;
 
 cleanup:
   gfc_free_expr (init);

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index b3551d1..8d5e32c 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2009-10-01  Tobias Burnus  <burnus@net-b.de>
+
+       PR fortran/41515
+       * gfortran.dg/parameter_array_init_5.f90: New test.
+
 2009-10-01  Jason Merrill  <jason@redhat.com>
 
        * g++.dg/cpp0x/defaulted13.C: New.

diff --git a/gcc/testsuite/gfortran.dg/parameter_array_init_5.f90 b/gcc/testsuite/gfortran.dg/parameter_array_init_5.f90
new file mode 100644 (file)
index 0000000..2977b88
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/parameter_array_init_5.f90
@@ -0,0 +1,26 @@
+! { dg-do run }
+!
+! PR fortran/41515
+! Contributed by ros@rzg.mpg.de.
+!
+! Before, the "parm' string array was never initialized.
+!
+Module BUG3
+contains
+    Subroutine SR
+    character(3)   :: parm(5)
+    character(20)  :: str
+    parameter(parm=(/'xo ','yo ','ag ','xr ','yr '/))
+
+    str =    'XXXXXXXXXXXXXXXXXXXX'
+    if(str /='XXXXXXXXXXXXXXXXXXXX') call abort()
+    write(str,*) parm
+    if(str /= ' xo yo ag xr yr') call abort()
+    end subroutine SR
+end Module BUG3
+!
+program TEST
+    use bug3
+    call sr
+end program TEST
+! { dg-final { cleanup-modules "bug3" } }