[PATCH, gfortran] Fix initialization of arrays of strings

[Steve Kargl]

On Tue, Jul 12, 2005 at 08:32:48AM +0800, Feng Wang wrote:
> 
> All the 'main  ' memory is allocated during gfc_set_constant_character_len
> call. I mean that resolve_character_array_constructor does not call
> gfc_get_charlen to set ts.cl if the constractor's expr is not of EXPR_CONSTANT
> (a(2)). This cause an ICE when invoking gfc_free_expr (init->ts.cl->length) in
> add_init_expr_to_sym. The memory I said is the memory of (gfc_charlen).
> 

Is the attached patch acceptable to you?

2005-07-12  Steven G. Kargl  <kargls@comcast.net>

	* array.c (resolve_character_array_constructor): Allocate memory for
	p->expr->ts.cl and attach to namespace list for automatic deallocation.

2005-07-12  Steven G. Kargl  <kargls@comcast.net>

	gfortran.dg/char_array_constructor.f90: New test.

-- 
Steve
-------------- next part --------------
! { dg-do run }
module z
   integer :: i
   character(6) :: a(2) = (/ ('main  ' , i = 1, 2) /)
   character(6) :: b(2) = (/ 'abcd  ' , 'efghij' /)
end module

program y
  use z
  if (a(1) /= 'main  ') call abort
  if (a(2) /= 'main  ') call abort
  if (b(1) /= 'abcd  ') call abort
  if (b(2) /= 'efghij') call abort
end program y
-------------- next part --------------
Index: array.c
===================================================================
RCS file: /cvs/gcc/gcc/gcc/fortran/array.c,v
retrieving revision 1.17
diff -c -p -r1.17 array.c
*** array.c	25 Jun 2005 00:40:33 -0000	1.17
--- array.c	12 Jul 2005 17:30:44 -0000
*************** resolve_character_array_constructor (gfc
*** 1547,1553 ****
  	  expr->ts.cl->length = gfc_int_expr (max_length);
  	  /* Update the element constructors.  */
  	  for (p = expr->value.constructor; p; p = p->next)
! 	    gfc_set_constant_character_len (max_length, p->expr);
  	}
      }
  }
--- 1547,1561 ----
  	  expr->ts.cl->length = gfc_int_expr (max_length);
  	  /* Update the element constructors.  */
  	  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->next = gfc_current_ns->cl_list;
! 		  gfc_current_ns->cl_list = p->expr->ts.cl;
! 		}
! 	      gfc_set_constant_character_len (max_length, p->expr);
! 	    }
  	}
      }
  }