re PR fortran/15959 (ICE and assertion failure in trans-decl.c with character initialization)

2005-04-05  Feng Wang  <fengwang@nudt.edu.cn>

	PR fortran/15959
	PR fortran/20713

	* array.c (resolve_character_array_constructor): New function. Set
	constant character array's character length.
	(gfc_resolve_array_constructor): Use it.
	* decl.c (add_init_expr_to_sym): Set symbol and initializer character
	length.
	(gfc_set_constant_character_len): New function. Set constant character
	expression according the given length.
	* match.h (gfc_set_constant_character_len): Add prototype.

2005-04-05  Feng Wang  <fengwang@nudt.edu.cn>

	* gfortran.dg/pr15959.f90: New test.
	* gfortran.dg/string_pad_trunc.f90: New test.

From-SVN: r97613

1 files changed, 53 insertions, 0 deletions

diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c
index 5f6c075..4a566a9 100644
--- a/gcc/fortran/decl.c
+++ b/gcc/fortran/decl.c
@@ -646,6 +646,30 @@ build_sym (const char *name, gfc_charlen * cl,
   return SUCCESS;
 }
 
+/* Set character constant to the given length. The constant will be padded or
+   truncated.  */
+
+void
+gfc_set_constant_character_len (int len, gfc_expr * expr)
+{
+  char * s;
+  int slen;
+
+  gcc_assert (expr->expr_type == EXPR_CONSTANT);
+  gcc_assert (expr->ts.type == BT_CHARACTER && expr->ts.kind == 1);
+
+  slen = expr->value.character.length;
+  if (len != slen)
+    {
+      s = gfc_getmem (len);
+      memcpy (s, expr->value.character.string, MIN (len, slen));
+      if (len > slen)
+	memset (&s[slen], ' ', len - slen);
+      gfc_free (expr->value.character.string);
+      expr->value.character.string = s;
+      expr->value.character.length = len;
+    }
+}
 
 /* Function called by variable_decl() that adds an initialization
    expression to a symbol.  */
@@ -711,6 +735,35 @@ add_init_expr_to_sym (const char *name, gfc_expr ** initp,
 	  && gfc_check_assign_symbol (sym, init) == FAILURE)
 	return FAILURE;
 
+      if (sym->ts.type == BT_CHARACTER && sym->ts.cl)
+	{
+	  /* Update symbol character length according initializer.  */
+	  if (sym->ts.cl->length == NULL)
+	    {
+	      if (init->expr_type == EXPR_CONSTANT)
+		sym->ts.cl->length =
+			gfc_int_expr (init->value.character.length);
+	      else if (init->expr_type == EXPR_ARRAY)
+		sym->ts.cl->length = gfc_copy_expr (init->ts.cl->length);
+	    }
+	  /* Update initializer character length according symbol.  */
+	  else if (sym->ts.cl->length->expr_type == EXPR_CONSTANT)
+	    {
+	      int len = mpz_get_si (sym->ts.cl->length->value.integer);
+	      gfc_constructor * p;
+
+	      if (init->expr_type == EXPR_CONSTANT)
+		gfc_set_constant_character_len (len, init);
+	      else if (init->expr_type == EXPR_ARRAY)
+		{
+		  gfc_free_expr (init->ts.cl->length);
+		  init->ts.cl->length = gfc_copy_expr (sym->ts.cl->length);
+		  for (p = init->value.constructor; p; p = p->next)
+		    gfc_set_constant_character_len (len, p->expr);
+		}
+	    }
+	}
+
       /* Add initializer.  Make sure we keep the ranks sane.  */
       if (sym->attr.dimension && init->rank == 0)
 	init->rank = sym->as->rank;