[fortran, patch] Fix PR15959, character array initialization.

[Feng Wang <wf_cs at yahoo dot com>]

This patch fix pr15959. If we resolve a constant character array, update the
expression's character length with the maximun of its constructor. And set the
initializer's length to symbol.

Tested with no regression on i686. Ok for mainline and gcc40?

Feng Wang

fortran/ChangeLog entry:
2005-04-01  Feng Wang  <fengwang@nudt.edu.cn>

	PR fortran/15959

	* decl.c (add_init_expr_to_sym): Set symbol's character length.
	* array.c (resolve_character_array): New function. Set constant
	character array's character length.
	(gfc_resolve_array_constructor): Use it.

testsuite/ChangeLog entry:
2005-04-01  Feng Wang  <fengwang@nudt.edu.cn>

	PR fortran/15959
	* gfortran.dg/pr15959.f90: New test.


_________________________________________________________
Do You Yahoo!?
150万曲MP3疯狂搜，带您闯入音乐殿堂
http://music.yisou.com/
美女明星应有尽有，搜遍美图、艳图和酷图
http://image.yisou.com
1G就是1000兆，雅虎电邮自助扩容！
http://cn.rd.yahoo.com/mail_cn/tag/1g/*http://cn.mail.yahoo.com/event/mail_1g/

! { dg-do run}
! Test initializer of character array. PR15959
character (*), parameter :: a (1:2) = (/'ab', 'abc'/)
if (a(2) .ne. 'abc') call abort()
end

Index: decl.c
===================================================================
RCS file: /cvs/gcc/gcc/gcc/fortran/decl.c,v
retrieving revision 1.32
diff -c -3 -p -r1.32 decl.c
*** decl.c	12 Mar 2005 02:06:20 -0000	1.32
--- decl.c	1 Apr 2005 08:48:39 -0000
*************** add_init_expr_to_sym (const char *name, 
*** 711,716 ****
--- 711,721 ----
  	  && gfc_check_assign_symbol (sym, init) == FAILURE)
  	return FAILURE;
  
+       /* Update symbol character length if initializer is a character array.  */
+       if (sym->ts.type == BT_CHARACTER && sym->ts.cl
+ 	  && sym->ts.cl->length == NULL && init->expr_type == EXPR_ARRAY)
+ 	sym->ts.cl->length = gfc_copy_expr (init->ts.cl->length);
+ 
        /* Add initializer.  Make sure we keep the ranks sane.  */
        if (sym->attr.dimension && init->rank == 0)
  	init->rank = sym->as->rank;
Index: array.c
===================================================================
RCS file: /cvs/gcc/gcc/gcc/fortran/array.c,v
retrieving revision 1.13
diff -c -3 -p -r1.13 array.c
*** array.c	7 Feb 2005 22:16:13 -0000	1.13
--- array.c	1 Apr 2005 08:48:41 -0000
*************** resolve_array_list (gfc_constructor * p)
*** 1499,1507 ****
    return t;
  }
  
  
! /* Resolve all of the expressions in an array list.
!    TODO: String lengths.  */
  
  try
  gfc_resolve_array_constructor (gfc_expr * expr)
--- 1499,1544 ----
    return t;
  }
  
+ /* Resolve character array. If it is a constant character array and not
+    specified character length, update character length to the maximum of its
+    constructor's length, including all the constructors.  */
  
! static void
! resolve_character_array (gfc_expr * expr)
! {
!   gfc_constructor * p;
!   int max_length;
! 
!   gcc_assert (expr->expr_type == EXPR_ARRAY);
!   gcc_assert (expr->ts.type == BT_CHARACTER);
! 
!   max_length = -1;
! 
!   if (expr->ts.cl == NULL || expr->ts.cl->length == NULL)
!     {
!       for (p = expr->value.constructor; p; p = p->next)
! 	if (p->expr->expr_type == EXPR_CONSTANT)
! 	  max_length = (p->expr->value.character.length > max_length) ?
! 		p->expr->value.character.length : max_length;
! 	else
! 	  return;
! 
!       if (max_length != -1)
! 	{
! 	  if (expr->ts.cl == NULL)
! 	    expr->ts.cl = gfc_get_charlen ();
! 	  expr->ts.cl->length = gfc_int_expr (max_length);
! 	  for (p = expr->value.constructor; p; p = p->next)
! 	    {
! 	      if (p->expr->ts.cl == NULL)
! 		p->expr->ts.cl = gfc_get_charlen ();
! 	      p->expr->ts.cl->length = gfc_int_expr (max_length);
! 	    }
! 	};
!     }
! }
! 
! /* Resolve all of the expressions in an array list.  */
  
  try
  gfc_resolve_array_constructor (gfc_expr * expr)
*************** gfc_resolve_array_constructor (gfc_expr 
*** 1511,1516 ****
--- 1548,1555 ----
    t = resolve_array_list (expr->value.constructor);
    if (t == SUCCESS)
      t = gfc_check_constructor_type (expr);
+   if (t == SUCCESS && expr->ts.type == BT_CHARACTER)
+     resolve_character_array (expr);
  
    return t;
  }