2006-07-04 Paul Thomas <pault@gcc.gnu.org>

	PR fortran/28174
	* trans-array.c (gfc_conv_expr_descriptor): When building temp,
	ensure that the substring reference uses a new charlen.
	* trans-expr.c (gfc_conv_aliased_arg): Add the formal intent to
	the argument list, lift the treatment of missing string lengths
	from the above and implement the use of the intent.
	(gfc_conv_function_call): Add the extra argument to the call to
	the above.

	PR fortran/28167
	* trans-array.c (get_array_ctor_var_strlen): Treat a constant
	substring reference.
	* array.c (gfc_resolve_character_array_constructor): Remove 
	static attribute and add the gfc_ prefix, make use of element
	charlens for the expression and pick up constant string lengths
	for expressions that are not themselves constant.
	* gfortran.h : resolve_character_array_constructor prototype
	added.
	* resolve.c (gfc_resolve_expr): Call resolve_character_array_
	constructor again after expanding the constructor, to ensure
	that the character length is passed to the expression.

2006-07-04  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/28174
	* gfortran.dg/actual_array_substr_2.f90: New test.

	PR fortran/28167
	* gfortran.dg/actual_array_constructor_2.f90: New test.



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

1 files changed, 43 insertions, 9 deletions

diff --git a/gcc/fortran/array.c b/gcc/fortran/array.c
index 2cb34994562..fa38ab9c956 100644
--- a/gcc/fortran/array.c
+++ b/gcc/fortran/array.c
@@ -1518,8 +1518,8 @@ resolve_array_list (gfc_constructor * p)
    not specified character length, update character length to the maximum of
    its element constructors' length.  */
 
-static void
-resolve_character_array_constructor (gfc_expr * expr)
+void
+gfc_resolve_character_array_constructor (gfc_expr * expr)
 {
   gfc_constructor * p;
   int max_length;
@@ -1531,20 +1531,53 @@ resolve_character_array_constructor (gfc_expr * expr)
 
   if (expr->ts.cl == NULL)
     {
+      for (p = expr->value.constructor; p; p = p->next)
+	if (p->expr->ts.cl != NULL)
+	  {
+	    /* Ensure that if there is a char_len around that it is
+	       used; otherwise the middle-end confuses them!  */
+	    expr->ts.cl = p->expr->ts.cl;
+	    goto got_charlen;
+	  }
+
       expr->ts.cl = gfc_get_charlen ();
       expr->ts.cl->next = gfc_current_ns->cl_list;
       gfc_current_ns->cl_list = expr->ts.cl;
     }
 
+got_charlen:
+
   if (expr->ts.cl->length == NULL)
     {
       /* Find the maximum length of the elements. Do nothing for variable array
-	 constructor.  */
+	 constructor, unless the character length is constant or there is a
+	constant substring reference.  */
+
       for (p = expr->value.constructor; p; p = p->next)
-	if (p->expr->expr_type == EXPR_CONSTANT)
-	  max_length = MAX (p->expr->value.character.length, max_length);
-	else
-	  return;
+	{
+	  gfc_ref *ref;
+	  for (ref = p->expr->ref; ref; ref = ref->next)
+	    if (ref->type == REF_SUBSTRING
+		  && ref->u.ss.start->expr_type == EXPR_CONSTANT
+		  && ref->u.ss.end->expr_type == EXPR_CONSTANT)
+	      break;
+
+	  if (p->expr->expr_type == EXPR_CONSTANT)
+	    max_length = MAX (p->expr->value.character.length, max_length);
+
+	  else if (ref)
+	    max_length = MAX ((int)(mpz_get_ui (ref->u.ss.end->value.integer)
+			      - mpz_get_ui (ref->u.ss.start->value.integer))
+			      + 1, max_length);
+
+	  else if (p->expr->ts.cl && p->expr->ts.cl->length
+		     && p->expr->ts.cl->length->expr_type == EXPR_CONSTANT)
+	    max_length = MAX ((int)mpz_get_si (p->expr->ts.cl->length->value.integer),
+			      max_length);
+
+	  else
+	    return;
+	}
 
       if (max_length != -1)
 	{
@@ -1552,7 +1585,8 @@ resolve_character_array_constructor (gfc_expr * expr)
 	  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);
+	    if (p->expr->expr_type == EXPR_CONSTANT)
+	      gfc_set_constant_character_len (max_length, p->expr);
 	}
     }
 }
@@ -1568,7 +1602,7 @@ gfc_resolve_array_constructor (gfc_expr * expr)
   if (t == SUCCESS)
     t = gfc_check_constructor_type (expr);
   if (t == SUCCESS && expr->ts.type == BT_CHARACTER)
-    resolve_character_array_constructor (expr);
+    gfc_resolve_character_array_constructor (expr);
 
   return t;
 }