re PR fortran/41515 (PARAMETER statement in module subroutines)

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.

From-SVN: r152377

gcc/fortran/ChangeLog

+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

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);

gcc/testsuite/ChangeLog

+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.

gcc/testsuite/gfortran.dg/parameter_array_init_5.f90

+! { 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" } }