2006-09-11 Paul Thomas <pault@gcc.gnu.org>

	PR fortran/28890
	trans-expr.c (gfc_conv_function_call): Obtain the string length
	of a dummy character(*) function from the symbol if it is not
	already translated.  For a call to a character(*) function, use
	the passed, hidden string length argument, which is available
	from the backend_decl of the formal argument.
	resolve.c (resolve_function): It is an error if a function call
	to a character(*) function is other than a dummy procedure or
	an intrinsic.

2006-09-11  Paul Thomas  <pault@gcc.gnu.org>

	PR libfortran/28890
	gfortran.dg/assumed_charlen_function_5.f90: New test.





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

1 files changed, 26 insertions, 6 deletions

diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index 37bf782f7bd..dc5ac27b786 100644
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -2030,6 +2030,16 @@ gfc_conv_function_call (gfc_se * se, gfc_symbol * sym,
 	  gfc_add_expr_to_block (&se->pre, tmp);
 	}
 
+      if (fsym && fsym->ts.type == BT_CHARACTER
+	     && parmse.string_length == NULL_TREE
+	     && e->ts.type == BT_PROCEDURE
+	     && e->symtree->n.sym->ts.type == BT_CHARACTER
+	     && e->symtree->n.sym->ts.cl->length != NULL)
+	{
+	  gfc_conv_const_charlen (e->symtree->n.sym->ts.cl);
+	  parmse.string_length = e->symtree->n.sym->ts.cl->backend_decl;
+	}
+
       /* Character strings are passed as two parameters, a length and a
          pointer.  */
       if (parmse.string_length != NULL_TREE)
@@ -2046,12 +2056,22 @@ gfc_conv_function_call (gfc_se * se, gfc_symbol * sym,
 	{
 	  /* Assumed character length results are not allowed by 5.1.1.5 of the
 	     standard and are trapped in resolve.c; except in the case of SPREAD
-	     (and other intrinsics?).  In this case, we take the character length
-	     of the first argument for the result.  */
-	  cl.backend_decl = TREE_VALUE (stringargs);
-	}
-      else
-	{
+	     (and other intrinsics?) and dummy functions.  In the case of SPREAD,
+	     we take the character length of the first argument for the result.
+	     For dummies, we have to look through the formal argument list for
+	     this function and use the character length found there.*/
+	  if (!sym->attr.dummy)
+	    cl.backend_decl = TREE_VALUE (stringargs);
+	  else
+	    {
+	      formal = sym->ns->proc_name->formal;
+	      for (; formal; formal = formal->next)
+		if (strcmp (formal->sym->name, sym->name) == 0)
+		  cl.backend_decl = formal->sym->ts.cl->backend_decl;
+	    }
+        }
+        else
+        {
 	  /* Calculate the length of the returned string.  */
 	  gfc_init_se (&parmse, NULL);
 	  if (need_interface_mapping)