re PR fortran/15326 ([4.0 only] ICE with assumed length character strings)

	PR fortran/15326
	* trans-array.c (gfc_add_loop_ss_code): Set ss->string_length in
	the GFC_SS_FUNCTION case too.
	* trans-expr.c (gfc_conv_function_val): Allow symbols to be bound
	to function pointers as well as function decls.
	(gfc_interface_sym_mapping, gfc_interface_mapping): New structures.
	(gfc_init_interface_mapping, gfc_free_interface_mapping)
	(gfc_get_interface_mapping_charlen, gfc_get_interface_mapping_array)
	(gfc_set_interface_mapping_bounds, gfc_add_interface_mapping)
	(gfc_finish_interface_mapping, gfc_apply_interface_mapping_to_cons)
	(gfc_apply_interface_mapping_to_ref)
	(gfc_apply_interface_mapping_to_expr)
	(gfc_apply_interface_mapping): New functions.
	(gfc_conv_function_call): Evaluate the arguments before working
	out where the result should go.  Make the null pointer case provide
	the string length in parmse.string_length.  Cope with non-constant
	string lengths, using the above functions to evaluate such lengths.
	Use a temporary typespec; don't assign to sym->cl->backend_decl.
	Don't assign to se->string_length when returning a cached array
	descriptor.

From-SVN: r104040

12 files changed, 1296 insertions, 107 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index e8e64ad..3862446 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,5 +1,28 @@
 2005-09-08  Richard Sandiford  <richard@codesourcery.com>
 
+	PR fortran/15326
+	* trans-array.c (gfc_add_loop_ss_code): Set ss->string_length in
+	the GFC_SS_FUNCTION case too.
+	* trans-expr.c (gfc_conv_function_val): Allow symbols to be bound
+	to function pointers as well as function decls.
+	(gfc_interface_sym_mapping, gfc_interface_mapping): New structures.
+	(gfc_init_interface_mapping, gfc_free_interface_mapping)
+	(gfc_get_interface_mapping_charlen, gfc_get_interface_mapping_array)
+	(gfc_set_interface_mapping_bounds, gfc_add_interface_mapping)
+	(gfc_finish_interface_mapping, gfc_apply_interface_mapping_to_cons)
+	(gfc_apply_interface_mapping_to_ref)
+	(gfc_apply_interface_mapping_to_expr)
+	(gfc_apply_interface_mapping): New functions.
+	(gfc_conv_function_call): Evaluate the arguments before working
+	out where the result should go.  Make the null pointer case provide
+	the string length in parmse.string_length.  Cope with non-constant
+	string lengths, using the above functions to evaluate such lengths.
+	Use a temporary typespec; don't assign to sym->cl->backend_decl.
+	Don't assign to se->string_length when returning a cached array
+	descriptor.
+
+2005-09-08  Richard Sandiford  <richard@codesourcery.com>
+
 	PR fortran/19928
 	* trans-array.c (gfc_conv_array_ref): Call gfc_advance_se_ss_chain
 	after handling scalarized references.  Make "indexse" inherit from
diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c
index 9012a07..fbd8b5b 100644
--- a/gcc/fortran/trans-array.c
+++ b/gcc/fortran/trans-array.c
@@ -1233,6 +1233,7 @@ gfc_add_loop_ss_code (gfc_loopinfo * loop, gfc_ss * ss, bool subscript)
 	  gfc_conv_expr (&se, ss->expr);
 	  gfc_add_block_to_block (&loop->pre, &se.pre);
 	  gfc_add_block_to_block (&loop->post, &se.post);
+	  ss->string_length = se.string_length;
 	  break;
 
 	case GFC_SS_CONSTRUCTOR:
diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index b20ed13..cf49ba4 100644
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -1058,8 +1058,6 @@ gfc_conv_function_val (gfc_se * se, gfc_symbol * sym)
       tmp = gfc_get_symbol_decl (sym);
       gcc_assert (TREE_CODE (TREE_TYPE (tmp)) == POINTER_TYPE
 	      && TREE_CODE (TREE_TYPE (TREE_TYPE (tmp))) == FUNCTION_TYPE);
-
-      se->expr = tmp;
     }
   else
     {
@@ -1067,12 +1065,456 @@ gfc_conv_function_val (gfc_se * se, gfc_symbol * sym)
 	sym->backend_decl = gfc_get_extern_function_decl (sym);
 
       tmp = sym->backend_decl;
-      gcc_assert (TREE_CODE (tmp) == FUNCTION_DECL);
-      se->expr = gfc_build_addr_expr (NULL, tmp);
+      if (!POINTER_TYPE_P (TREE_TYPE (tmp)))
+	{
+	  gcc_assert (TREE_CODE (tmp) == FUNCTION_DECL);
+	  tmp = gfc_build_addr_expr (NULL, tmp);
+	}
+    }
+  se->expr = tmp;
+}
+
+
+/* This group of functions allows a caller to evaluate an expression from
+   the callee's interface.  It establishes a mapping between the interface's
+   dummy arguments and the caller's actual arguments, then applies that
+   mapping to a given gfc_expr.
+
+   You can initialize a mapping structure like so:
+
+       gfc_interface_mapping mapping;
+       ...
+       gfc_init_interface_mapping (&mapping);
+
+   You should then evaluate each actual argument into a temporary
+   gfc_se structure, here called "se", and map the result to the
+   dummy argument's symbol, here called "sym":
+
+       gfc_add_interface_mapping (&mapping, sym, &se);
+
+   After adding all mappings, you should call:
+
+       gfc_finish_interface_mapping (&mapping, pre, post);
+
+   where "pre" and "post" are statement blocks for initialization
+   and finalization code respectively.  You can then evaluate an
+   interface expression "expr" as follows:
+
+       gfc_apply_interface_mapping (&mapping, se, expr);
+
+   Once you've evaluated all expressions, you should free
+   the mapping structure with:
+
+       gfc_free_interface_mapping (&mapping); */
+
+
+/* This structure represents a mapping from OLD to NEW, where OLD is a
+   dummy argument symbol and NEW is a symbol that represents the value
+   of an actual argument.  Mappings are linked together using NEXT
+   (in no particular order).  */
+typedef struct gfc_interface_sym_mapping
+{
+  struct gfc_interface_sym_mapping *next;
+  gfc_symbol *old;
+  gfc_symtree *new;
+}
+gfc_interface_sym_mapping;
+
+
+/* This structure is used by callers to evaluate an expression from
+   a callee's interface.  */
+typedef struct gfc_interface_mapping
+{
+  /* Maps the interface's dummy arguments to the values that the caller
+     is passing.  The whole list is owned by this gfc_interface_mapping.  */
+  gfc_interface_sym_mapping *syms;
+
+  /* A list of gfc_charlens that were needed when creating copies of
+     expressions.  The whole list is owned by this gfc_interface_mapping.  */
+  gfc_charlen *charlens;
+}
+gfc_interface_mapping;
+
+
+static void gfc_apply_interface_mapping_to_expr (gfc_interface_mapping *,
+						 gfc_expr *);
+
+/* Initialize MAPPING.  */
+
+static void
+gfc_init_interface_mapping (gfc_interface_mapping * mapping)
+{
+  mapping->syms = NULL;
+  mapping->charlens = NULL;
+}
+
+
+/* Free all memory held by MAPPING (but not MAPPING itself).  */
+
+static void
+gfc_free_interface_mapping (gfc_interface_mapping * mapping)
+{
+  gfc_interface_sym_mapping *sym;
+  gfc_interface_sym_mapping *nextsym;
+  gfc_charlen *cl;
+  gfc_charlen *nextcl;
+
+  for (sym = mapping->syms; sym; sym = nextsym)
+    {
+      nextsym = sym->next;
+      gfc_free_symbol (sym->new->n.sym);
+      gfc_free (sym->new);
+      gfc_free (sym);
+    }
+  for (cl = mapping->charlens; cl; cl = nextcl)
+    {
+      nextcl = cl->next;
+      gfc_free_expr (cl->length);
+      gfc_free (cl);
+    }
+}
+
+
+/* Return a copy of gfc_charlen CL.  Add the returned structure to
+   MAPPING so that it will be freed by gfc_free_interface_mapping.  */
+
+static gfc_charlen *
+gfc_get_interface_mapping_charlen (gfc_interface_mapping * mapping,
+				   gfc_charlen * cl)
+{
+  gfc_charlen *new;
+
+  new = gfc_get_charlen ();
+  new->next = mapping->charlens;
+  new->length = gfc_copy_expr (cl->length);
+
+  mapping->charlens = new;
+  return new;
+}
+
+
+/* A subroutine of gfc_add_interface_mapping.  Return a descriptorless
+   array variable that can be used as the actual argument for dummy
+   argument SYM.  Add any initialization code to BLOCK.  PACKED is as
+   for gfc_get_nodesc_array_type and DATA points to the first element
+   in the passed array.  */
+
+static tree
+gfc_get_interface_mapping_array (stmtblock_t * block, gfc_symbol * sym,
+				 int packed, tree data)
+{
+  tree type;
+  tree var;
+
+  type = gfc_typenode_for_spec (&sym->ts);
+  type = gfc_get_nodesc_array_type (type, sym->as, packed);
+
+  var = gfc_create_var (type, "parm");
+  gfc_add_modify_expr (block, var, fold_convert (type, data));
+
+  return var;
+}
+
+
+/* A subroutine of gfc_add_interface_mapping.  Set the stride, upper bounds
+   and offset of descriptorless array type TYPE given that it has the same
+   size as DESC.  Add any set-up code to BLOCK.  */
+
+static void
+gfc_set_interface_mapping_bounds (stmtblock_t * block, tree type, tree desc)
+{
+  int n;
+  tree dim;
+  tree offset;
+  tree tmp;
+
+  offset = gfc_index_zero_node;
+  for (n = 0; n < GFC_TYPE_ARRAY_RANK (type); n++)
+    {
+      GFC_TYPE_ARRAY_STRIDE (type, n) = gfc_conv_array_stride (desc, n);
+      if (GFC_TYPE_ARRAY_UBOUND (type, n) == NULL_TREE)
+	{
+	  dim = gfc_rank_cst[n];
+	  tmp = fold_build2 (MINUS_EXPR, gfc_array_index_type,
+			     gfc_conv_descriptor_ubound (desc, dim),
+			     gfc_conv_descriptor_lbound (desc, dim));
+	  tmp = fold_build2 (PLUS_EXPR, gfc_array_index_type,
+			     GFC_TYPE_ARRAY_LBOUND (type, n),
+			     tmp);
+	  tmp = gfc_evaluate_now (tmp, block);
+	  GFC_TYPE_ARRAY_UBOUND (type, n) = tmp;
+	}
+      tmp = fold_build2 (MULT_EXPR, gfc_array_index_type,
+			 GFC_TYPE_ARRAY_LBOUND (type, n),
+			 GFC_TYPE_ARRAY_STRIDE (type, n));
+      offset = fold_build2 (MINUS_EXPR, gfc_array_index_type, offset, tmp);
+    }
+  offset = gfc_evaluate_now (offset, block);
+  GFC_TYPE_ARRAY_OFFSET (type) = offset;
+}
+
+
+/* Extend MAPPING so that it maps dummy argument SYM to the value stored
+   in SE.  The caller may still use se->expr and se->string_length after
+   calling this function.  */
+
+static void
+gfc_add_interface_mapping (gfc_interface_mapping * mapping,
+			   gfc_symbol * sym, gfc_se * se)
+{
+  gfc_interface_sym_mapping *sm;
+  tree desc;
+  tree tmp;
+  tree value;
+  gfc_symbol *new_sym;
+  gfc_symtree *root;
+  gfc_symtree *new_symtree;
+
+  /* Create a new symbol to represent the actual argument.  */
+  new_sym = gfc_new_symbol (sym->name, NULL);
+  new_sym->ts = sym->ts;
+  new_sym->attr.referenced = 1;
+  new_sym->attr.dimension = sym->attr.dimension;
+  new_sym->attr.pointer = sym->attr.pointer;
+  new_sym->attr.flavor = sym->attr.flavor;
+
+  /* Create a fake symtree for it.  */
+  root = NULL;
+  new_symtree = gfc_new_symtree (&root, sym->name);
+  new_symtree->n.sym = new_sym;
+  gcc_assert (new_symtree == root);
+
+  /* Create a dummy->actual mapping.  */
+  sm = gfc_getmem (sizeof (*sm));
+  sm->next = mapping->syms;
+  sm->old = sym;
+  sm->new = new_symtree;
+  mapping->syms = sm;
+
+  /* Stabilize the argument's value.  */
+  se->expr = gfc_evaluate_now (se->expr, &se->pre);
+
+  if (sym->ts.type == BT_CHARACTER)
+    {
+      /* Create a copy of the dummy argument's length.  */
+      new_sym->ts.cl = gfc_get_interface_mapping_charlen (mapping, sym->ts.cl);
+
+      /* If the length is specified as "*", record the length that
+	 the caller is passing.  We should use the callee's length
+	 in all other cases.  */
+      if (!new_sym->ts.cl->length)
+	{
+	  se->string_length = gfc_evaluate_now (se->string_length, &se->pre);
+	  new_sym->ts.cl->backend_decl = se->string_length;
+	}
+    }
+
+  /* Use the passed value as-is if the argument is a function.  */
+  if (sym->attr.flavor == FL_PROCEDURE)
+    value = se->expr;
+
+  /* If the argument is either a string or a pointer to a string,
+     convert it to a boundless character type.  */
+  else if (!sym->attr.dimension && sym->ts.type == BT_CHARACTER)
+    {
+      tmp = gfc_get_character_type_len (sym->ts.kind, NULL);
+      tmp = build_pointer_type (tmp);
+      if (sym->attr.pointer)
+	tmp = build_pointer_type (tmp);
+
+      value = fold_convert (tmp, se->expr);
+      if (sym->attr.pointer)
+	value = gfc_build_indirect_ref (value);
+    }
+
+  /* If the argument is a scalar or a pointer to an array, dereference it.  */
+  else if (!sym->attr.dimension || sym->attr.pointer)
+    value = gfc_build_indirect_ref (se->expr);
+
+  /* If the argument is an array descriptor, use it to determine
+     information about the actual argument's shape.  */
+  else if (POINTER_TYPE_P (TREE_TYPE (se->expr))
+	   && GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (TREE_TYPE (se->expr))))
+    {
+      /* Get the actual argument's descriptor.  */
+      desc = gfc_build_indirect_ref (se->expr);
+
+      /* Create the replacement variable.  */
+      tmp = gfc_conv_descriptor_data_get (desc);
+      value = gfc_get_interface_mapping_array (&se->pre, sym, 0, tmp);
+
+      /* Use DESC to work out the upper bounds, strides and offset.  */
+      gfc_set_interface_mapping_bounds (&se->pre, TREE_TYPE (value), desc);
+    }
+  else
+    /* Otherwise we have a packed array.  */
+    value = gfc_get_interface_mapping_array (&se->pre, sym, 2, se->expr);
+
+  new_sym->backend_decl = value;
+}
+
+
+/* Called once all dummy argument mappings have been added to MAPPING,
+   but before the mapping is used to evaluate expressions.  Pre-evaluate
+   the length of each argument, adding any initialization code to PRE and
+   any finalization code to POST.  */
+
+static void
+gfc_finish_interface_mapping (gfc_interface_mapping * mapping,
+			      stmtblock_t * pre, stmtblock_t * post)
+{
+  gfc_interface_sym_mapping *sym;
+  gfc_expr *expr;
+  gfc_se se;
+
+  for (sym = mapping->syms; sym; sym = sym->next)
+    if (sym->new->n.sym->ts.type == BT_CHARACTER
+	&& !sym->new->n.sym->ts.cl->backend_decl)
+      {
+	expr = sym->new->n.sym->ts.cl->length;
+	gfc_apply_interface_mapping_to_expr (mapping, expr);
+	gfc_init_se (&se, NULL);
+	gfc_conv_expr (&se, expr);
+
+	se.expr = gfc_evaluate_now (se.expr, &se.pre);
+	gfc_add_block_to_block (pre, &se.pre);
+	gfc_add_block_to_block (post, &se.post);
+
+	sym->new->n.sym->ts.cl->backend_decl = se.expr;
+      }
+}
+
+
+/* Like gfc_apply_interface_mapping_to_expr, but applied to
+   constructor C.  */
+
+static void
+gfc_apply_interface_mapping_to_cons (gfc_interface_mapping * mapping,
+				     gfc_constructor * c)
+{
+  for (; c; c = c->next)
+    {
+      gfc_apply_interface_mapping_to_expr (mapping, c->expr);
+      if (c->iterator)
+	{
+	  gfc_apply_interface_mapping_to_expr (mapping, c->iterator->start);
+	  gfc_apply_interface_mapping_to_expr (mapping, c->iterator->end);
+	  gfc_apply_interface_mapping_to_expr (mapping, c->iterator->step);
+	}
+    }
+}
+
+
+/* Like gfc_apply_interface_mapping_to_expr, but applied to
+   reference REF.  */
+
+static void
+gfc_apply_interface_mapping_to_ref (gfc_interface_mapping * mapping,
+				    gfc_ref * ref)
+{
+  int n;
+
+  for (; ref; ref = ref->next)
+    switch (ref->type)
+      {
+      case REF_ARRAY:
+	for (n = 0; n < ref->u.ar.dimen; n++)
+	  {
+	    gfc_apply_interface_mapping_to_expr (mapping, ref->u.ar.start[n]);
+	    gfc_apply_interface_mapping_to_expr (mapping, ref->u.ar.end[n]);
+	    gfc_apply_interface_mapping_to_expr (mapping, ref->u.ar.stride[n]);
+	  }
+	gfc_apply_interface_mapping_to_expr (mapping, ref->u.ar.offset);
+	break;
+
+      case REF_COMPONENT:
+	break;
+
+      case REF_SUBSTRING:
+	gfc_apply_interface_mapping_to_expr (mapping, ref->u.ss.start);
+	gfc_apply_interface_mapping_to_expr (mapping, ref->u.ss.end);
+	break;
+      }
+}
+
+
+/* EXPR is a copy of an expression that appeared in the interface
+   associated with MAPPING.  Walk it recursively looking for references to
+   dummy arguments that MAPPING maps to actual arguments.  Replace each such
+   reference with a reference to the associated actual argument.  */
+
+static void
+gfc_apply_interface_mapping_to_expr (gfc_interface_mapping * mapping,
+				     gfc_expr * expr)
+{
+  gfc_interface_sym_mapping *sym;
+  gfc_actual_arglist *actual;
+
+  if (!expr)
+    return;
+
+  /* Copying an expression does not copy its length, so do that here.  */
+  if (expr->ts.type == BT_CHARACTER && expr->ts.cl)
+    {
+      expr->ts.cl = gfc_get_interface_mapping_charlen (mapping, expr->ts.cl);
+      gfc_apply_interface_mapping_to_expr (mapping, expr->ts.cl->length);
+    }
+
+  /* Apply the mapping to any references.  */
+  gfc_apply_interface_mapping_to_ref (mapping, expr->ref);
+
+  /* ...and to the expression's symbol, if it has one.  */
+  if (expr->symtree)
+    for (sym = mapping->syms; sym; sym = sym->next)
+      if (sym->old == expr->symtree->n.sym)
+	expr->symtree = sym->new;
+
+  /* ...and to subexpressions in expr->value.  */
+  switch (expr->expr_type)
+    {
+    case EXPR_VARIABLE:
+    case EXPR_CONSTANT:
+    case EXPR_NULL:
+    case EXPR_SUBSTRING:
+      break;
+
+    case EXPR_OP:
+      gfc_apply_interface_mapping_to_expr (mapping, expr->value.op.op1);
+      gfc_apply_interface_mapping_to_expr (mapping, expr->value.op.op2);
+      break;
+
+    case EXPR_FUNCTION:
+      for (sym = mapping->syms; sym; sym = sym->next)
+	if (sym->old == expr->value.function.esym)
+	  expr->value.function.esym = sym->new->n.sym;
+
+      for (actual = expr->value.function.actual; actual; actual = actual->next)
+	gfc_apply_interface_mapping_to_expr (mapping, actual->expr);
+      break;
+
+    case EXPR_ARRAY:
+    case EXPR_STRUCTURE:
+      gfc_apply_interface_mapping_to_cons (mapping, expr->value.constructor);
+      break;
     }
 }
 
 
+/* Evaluate interface expression EXPR using MAPPING.  Store the result
+   in SE.  */
+
+static void
+gfc_apply_interface_mapping (gfc_interface_mapping * mapping,
+			     gfc_se * se, gfc_expr * expr)
+{
+  expr = gfc_copy_expr (expr);
+  gfc_apply_interface_mapping_to_expr (mapping, expr);
+  gfc_conv_expr (se, expr);
+  se->expr = gfc_evaluate_now (se->expr, &se->pre);
+  gfc_free_expr (expr);
+}
+
+
 /* Generate code for a procedure call.  Note can return se->post != NULL.
    If se->direct_byref is set then se->expr contains the return parameter.
    Return nonzero, if the call has alternate specifiers.  */
@@ -1081,7 +1523,9 @@ int
 gfc_conv_function_call (gfc_se * se, gfc_symbol * sym,
 			gfc_actual_arglist * arg)
 {
+  gfc_interface_mapping mapping;
   tree arglist;
+  tree retargs;
   tree tmp;
   tree fntype;
   gfc_se parmse;
@@ -1094,21 +1538,16 @@ gfc_conv_function_call (gfc_se * se, gfc_symbol * sym,
   tree stringargs;
   gfc_formal_arglist *formal;
   int has_alternate_specifier = 0;
+  bool need_interface_mapping;
+  gfc_typespec ts;
+  gfc_charlen cl;
 
   arglist = NULL_TREE;
+  retargs = NULL_TREE;
   stringargs = NULL_TREE;
   var = NULL_TREE;
   len = NULL_TREE;
 
-  /* Obtain the string length now because it is needed often below.  */
-  if (sym->ts.type == BT_CHARACTER)
-    {
-      gcc_assert (sym->ts.cl && sym->ts.cl->length
-		  && sym->ts.cl->length->expr_type == EXPR_CONSTANT);
-      len = gfc_conv_mpz_to_tree
-	      (sym->ts.cl->length->value.integer, sym->ts.cl->length->ts.kind);
-    }
-
   if (se->ss != NULL)
     {
       if (!sym->attr.elemental)
@@ -1123,9 +1562,6 @@ gfc_conv_function_call (gfc_se * se, gfc_symbol * sym,
               /* Access the previously obtained result.  */
               gfc_conv_tmp_array_ref (se);
               gfc_advance_se_ss_chain (se);
-
-	      /* Bundle in the string length.  */
-	      se->string_length = len;
               return 0;
             }
 	}
@@ -1134,91 +1570,9 @@ gfc_conv_function_call (gfc_se * se, gfc_symbol * sym,
   else
     info = NULL;
 
-  byref = gfc_return_by_reference (sym);
-  if (byref)
-    {
-      if (se->direct_byref) 
-	{
-	  arglist = gfc_chainon_list (arglist, se->expr);
-
-	  /* Add string length to argument list.  */
-	  if (sym->ts.type == BT_CHARACTER)
-	    {
-	      sym->ts.cl->backend_decl = len;
-	      arglist = gfc_chainon_list (arglist, 
-				convert (gfc_charlen_type_node, len));
-	    }
-	}
-      else if (sym->result->attr.dimension)
-	{
-	  gcc_assert (se->loop && se->ss);
-
-	  /* Set the type of the array.  */
-	  tmp = gfc_typenode_for_spec (&sym->ts);
-	  info->dimen = se->loop->dimen;
-
-	  /* Allocate a temporary to store the result.  */
-	  gfc_trans_allocate_temp_array (se->loop, info, tmp);
-
-	  /* Zero the first stride to indicate a temporary.  */
-	  tmp =
-	    gfc_conv_descriptor_stride (info->descriptor, gfc_rank_cst[0]);
-	  gfc_add_modify_expr (&se->pre, tmp,
-			       convert (TREE_TYPE (tmp), integer_zero_node));
-
-	  /* Pass the temporary as the first argument.  */
-	  tmp = info->descriptor;
-	  tmp = gfc_build_addr_expr (NULL, tmp);
-	  arglist = gfc_chainon_list (arglist, tmp);
-
-	  /* Add string length to argument list.  */
-	  if (sym->ts.type == BT_CHARACTER)
-	    {
-	      sym->ts.cl->backend_decl = len;
-	      arglist = gfc_chainon_list (arglist, 
-			      convert (gfc_charlen_type_node, len));
-	    }
-
-	}
-      else if (sym->ts.type == BT_CHARACTER)
-	{
-
-	  /* Pass the string length.  */
-	  sym->ts.cl->backend_decl = len;
-	  type = gfc_get_character_type (sym->ts.kind, sym->ts.cl);
-	  type = build_pointer_type (type);
-
-	  /* Return an address to a char[0:len-1]* temporary for character pointers.  */
-	  if (sym->attr.pointer || sym->attr.allocatable)
-	    {
-	      /* Build char[0:len-1] * pstr.  */
-	      tmp = fold_build2 (MINUS_EXPR, gfc_charlen_type_node, len,
-				 build_int_cst (gfc_charlen_type_node, 1));
-	      tmp = build_range_type (gfc_array_index_type, gfc_index_zero_node, tmp);
-	      tmp = build_array_type (gfc_character1_type_node, tmp);
-	      var = gfc_create_var (build_pointer_type (tmp), "pstr");
-
-	      /* Provide an address expression for the function arguments.  */
-	      var = gfc_build_addr_expr (NULL, var);
-	    }
-	  else
-	    {
-	      var = gfc_conv_string_tmp (se, type, len);
-	    }
-	  arglist = gfc_chainon_list (arglist, var);
-	  arglist = gfc_chainon_list (arglist, 
-				      convert (gfc_charlen_type_node, len));
-	}
-      else
-	{
-	  gcc_assert (gfc_option.flag_f2c && sym->ts.type == BT_COMPLEX);
-
-	  type = gfc_get_complex_type (sym->ts.kind);
-	  var = gfc_build_addr_expr (NULL, gfc_create_var (type, "cmplx"));
-	  arglist = gfc_chainon_list (arglist, var);
-	}
-    }
-
+  gfc_init_interface_mapping (&mapping);
+  need_interface_mapping = (sym->ts.type == BT_CHARACTER
+			    && sym->ts.cl->length->expr_type != EXPR_CONSTANT);
   formal = sym->formal;
   /* Evaluate the arguments.  */
   for (; arg != NULL; arg = arg->next, formal = formal ? formal->next : NULL)
@@ -1243,12 +1597,8 @@ gfc_conv_function_call (gfc_se * se, gfc_symbol * sym,
 	      gfc_init_se (&parmse, NULL);
 	      parmse.expr = null_pointer_node;
               if (arg->missing_arg_type == BT_CHARACTER)
-                {
-                  stringargs =
-		    gfc_chainon_list (stringargs,
-				      convert (gfc_charlen_type_node,
-					       integer_zero_node));
-                }
+		parmse.string_length = convert (gfc_charlen_type_node,
+						integer_zero_node);
 	    }
 	}
       else if (se->ss && se->ss->useflags)
@@ -1293,6 +1643,9 @@ gfc_conv_function_call (gfc_se * se, gfc_symbol * sym,
 	    } 
 	}
 
+      if (formal && need_interface_mapping)
+	gfc_add_interface_mapping (&mapping, formal->sym, &parmse);
+
       gfc_add_block_to_block (&se->pre, &parmse.pre);
       gfc_add_block_to_block (&se->post, &parmse.post);
 
@@ -1303,6 +1656,98 @@ gfc_conv_function_call (gfc_se * se, gfc_symbol * sym,
 
       arglist = gfc_chainon_list (arglist, parmse.expr);
     }
+  gfc_finish_interface_mapping (&mapping, &se->pre, &se->post);
+
+  ts = sym->ts;
+  if (ts.type == BT_CHARACTER)
+    {
+      /* Calculate the length of the returned string.  */
+      gfc_init_se (&parmse, NULL);
+      if (need_interface_mapping)
+	gfc_apply_interface_mapping (&mapping, &parmse, sym->ts.cl->length);
+      else
+	gfc_conv_expr (&parmse, sym->ts.cl->length);
+      gfc_add_block_to_block (&se->pre, &parmse.pre);
+      gfc_add_block_to_block (&se->post, &parmse.post);
+
+      /* Set up a charlen structure for it.  */
+      cl.next = NULL;
+      cl.length = NULL;
+      cl.backend_decl = fold_convert (gfc_charlen_type_node, parmse.expr);
+      ts.cl = &cl;
+
+      len = cl.backend_decl;
+    }
+  gfc_free_interface_mapping (&mapping);
+
+  byref = gfc_return_by_reference (sym);
+  if (byref)
+    {
+      if (se->direct_byref)
+	retargs = gfc_chainon_list (retargs, se->expr);
+      else if (sym->result->attr.dimension)
+	{
+	  gcc_assert (se->loop && info);
+
+	  /* Set the type of the array.  */
+	  tmp = gfc_typenode_for_spec (&ts);
+	  info->dimen = se->loop->dimen;
+
+	  /* Allocate a temporary to store the result.  */
+	  gfc_trans_allocate_temp_array (se->loop, info, tmp);
+
+	  /* Zero the first stride to indicate a temporary.  */
+	  tmp = gfc_conv_descriptor_stride (info->descriptor, gfc_rank_cst[0]);
+	  gfc_add_modify_expr (&se->pre, tmp,
+			       convert (TREE_TYPE (tmp), integer_zero_node));
+
+	  /* Pass the temporary as the first argument.  */
+	  tmp = info->descriptor;
+	  tmp = gfc_build_addr_expr (NULL, tmp);
+	  retargs = gfc_chainon_list (retargs, tmp);
+	}
+      else if (ts.type == BT_CHARACTER)
+	{
+	  /* Pass the string length.  */
+	  type = gfc_get_character_type (ts.kind, ts.cl);
+	  type = build_pointer_type (type);
+
+	  /* Return an address to a char[0:len-1]* temporary for
+	     character pointers.  */
+	  if (sym->attr.pointer || sym->attr.allocatable)
+	    {
+	      /* Build char[0:len-1] * pstr.  */
+	      tmp = fold_build2 (MINUS_EXPR, gfc_charlen_type_node, len,
+				 build_int_cst (gfc_charlen_type_node, 1));
+	      tmp = build_range_type (gfc_array_index_type,
+				      gfc_index_zero_node, tmp);
+	      tmp = build_array_type (gfc_character1_type_node, tmp);
+	      var = gfc_create_var (build_pointer_type (tmp), "pstr");
+
+	      /* Provide an address expression for the function arguments.  */
+	      var = gfc_build_addr_expr (NULL, var);
+	    }
+	  else
+	    var = gfc_conv_string_tmp (se, type, len);
+
+	  retargs = gfc_chainon_list (retargs, var);
+	}
+      else
+	{
+	  gcc_assert (gfc_option.flag_f2c && ts.type == BT_COMPLEX);
+
+	  type = gfc_get_complex_type (ts.kind);
+	  var = gfc_build_addr_expr (NULL, gfc_create_var (type, "cmplx"));
+	  retargs = gfc_chainon_list (retargs, var);
+	}
+
+      /* Add the string length to the argument list.  */
+      if (ts.type == BT_CHARACTER)
+	retargs = gfc_chainon_list (retargs, len);
+    }
+
+  /* Add the return arguments.  */
+  arglist = chainon (retargs, arglist);
 
   /* Add the hidden string length parameters to the arguments.  */
   arglist = chainon (arglist, stringargs);
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index f20a576..9690bb5 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,5 +1,17 @@
 2005-09-08  Richard Sandiford  <richard@codesourcery.com>
 
+	PR fortran/15326
+	* gfortran.dg/char_result_1.f90,
+	* gfortran.dg/char_result_2.f90,
+	* gfortran.dg/char_result_3.f90,
+	* gfortran.dg/char_result_4.f90,
+	* gfortran.dg/char_result_5.f90,
+	* gfortran.dg/char_result_6.f90,
+	* gfortran.dg/char_result_7.f90,
+	* gfortran.dg/char_result_8.f90: New tests.
+
+2005-09-08  Richard Sandiford  <richard@codesourcery.com>
+
 	PR fortran/19928
 	* gfortran.dg/pr19928-1.f90, gfortran.dg/pr19928-2.f90: New tests.
 
diff --git a/gcc/testsuite/gfortran.dg/char_result_1.f90 b/gcc/testsuite/gfortran.dg/char_result_1.f90
new file mode 100644
index 0000000..84799e6
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/char_result_1.f90
@@ -0,0 +1,113 @@
+! Related to PR 15326.  Try calling string functions whose lengths depend
+! on the lengths of other strings.
+! { dg-do run }
+pure function double (string)
+  character (len = *), intent (in) :: string
+  character (len = len (string) * 2) :: double
+  double = string // string
+end function double
+
+function f1 (string)
+  character (len = *) :: string
+  character (len = len (string)) :: f1
+  f1 = ''
+end function f1
+
+function f2 (string1, string2)
+  character (len = *) :: string1
+  character (len = len (string1) - 20) :: string2
+  character (len = len (string1) + len (string2) / 2) :: f2
+  f2 = ''
+end function f2
+
+program main
+  implicit none
+
+  interface
+    pure function double (string)
+      character (len = *), intent (in) :: string
+      character (len = len (string) * 2) :: double
+    end function double
+    function f1 (string)
+      character (len = *) :: string
+      character (len = len (string)) :: f1
+    end function f1
+    function f2 (string1, string2)
+      character (len = *) :: string1
+      character (len = len (string1) - 20) :: string2
+      character (len = len (string1) + len (string2) / 2) :: f2
+    end function f2
+  end interface
+
+  integer :: a
+  character (len = 80), target :: text
+  character (len = 70), pointer :: textp
+
+  a = 42
+  textp => text
+
+  call test (f1 (text), 80)
+  call test (f2 (text, text), 110)
+  call test (f3 (text), 115)
+  call test (f4 (text), 192)
+  call test (f5 (text), 160)
+  call test (f6 (text), 39)
+
+  call test (f1 (textp), 70)
+  call test (f2 (textp, text), 95)
+  call test (f3 (textp), 105)
+  call test (f4 (textp), 192)
+  call test (f5 (textp), 140)
+  call test (f6 (textp), 29)
+
+  call indirect (textp)
+contains
+  function f3 (string)
+    integer, parameter :: l1 = 30
+    character (len = *) :: string
+    character (len = len (string) + l1 + 5) :: f3
+    f3 = ''
+  end function f3
+
+  function f4 (string)
+    character (len = len (text) - 10) :: string
+    character (len = len (string) + len (text) + a) :: f4
+    f4 = ''
+  end function f4
+
+  function f5 (string)
+    character (len = *) :: string
+    character (len = len (double (string))) :: f5
+    f5 = ''
+  end function f5
+
+  function f6 (string)
+    character (len = *) :: string
+    character (len = len (string (a:))) :: f6
+    f6 = ''
+  end function f6
+
+  subroutine indirect (text2)
+    character (len = *) :: text2
+
+    call test (f1 (text), 80)
+    call test (f2 (text, text), 110)
+    call test (f3 (text), 115)
+    call test (f4 (text), 192)
+    call test (f5 (text), 160)
+    call test (f6 (text), 39)
+
+    call test (f1 (text2), 70)
+    call test (f2 (text2, text2), 95)
+    call test (f3 (text2), 105)
+    call test (f4 (text2), 192)
+    call test (f5 (text2), 140)
+    call test (f6 (text2), 29)
+  end subroutine indirect
+
+  subroutine test (string, length)
+    character (len = *) :: string
+    integer, intent (in) :: length
+    if (len (string) .ne. length) call abort
+  end subroutine test
+end program main
diff --git a/gcc/testsuite/gfortran.dg/char_result_2.f90 b/gcc/testsuite/gfortran.dg/char_result_2.f90
new file mode 100644
index 0000000..cc4a5c4
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/char_result_2.f90
@@ -0,0 +1,105 @@
+! Like char_result_1.f90, but the string arguments are pointers.
+! { dg-do run }
+pure function double (string)
+  character (len = *), intent (in) :: string
+  character (len = len (string) * 2) :: double
+  double = string // string
+end function double
+
+function f1 (string)
+  character (len = *), pointer :: string
+  character (len = len (string)) :: f1
+  f1 = ''
+end function f1
+
+function f2 (string1, string2)
+  character (len = *), pointer :: string1
+  character (len = len (string1) - 20), pointer :: string2
+  character (len = len (string1) + len (string2) / 2) :: f2
+  f2 = ''
+end function f2
+
+program main
+  implicit none
+
+  interface
+    pure function double (string)
+      character (len = *), intent (in) :: string
+      character (len = len (string) * 2) :: double
+    end function double
+    function f1 (string)
+      character (len = *), pointer :: string
+      character (len = len (string)) :: f1
+    end function f1
+    function f2 (string1, string2)
+      character (len = *), pointer :: string1
+      character (len = len (string1) - 20), pointer :: string2
+      character (len = len (string1) + len (string2) / 2) :: f2
+    end function f2
+  end interface
+
+  integer :: a
+  character (len = 80), target :: text
+  character (len = 70), pointer :: textp
+
+  a = 42
+  textp => text
+
+  call test (f1 (textp), 70)
+  call test (f2 (textp, textp), 95)
+  call test (f3 (textp), 105)
+  call test (f4 (textp), 192)
+  call test (f5 (textp), 140)
+  call test (f6 (textp), 29)
+
+  call indirect (textp)
+contains
+  function f3 (string)
+    integer, parameter :: l1 = 30
+    character (len = *), pointer :: string
+    character (len = len (string) + l1 + 5) :: f3
+    f3 = ''
+  end function f3
+
+  function f4 (string)
+    character (len = len (text) - 10), pointer :: string
+    character (len = len (string) + len (text) + a) :: f4
+    f4 = ''
+  end function f4
+
+  function f5 (string)
+    character (len = *), pointer :: string
+    character (len = len (double (string))) :: f5
+    f5 = ''
+  end function f5
+
+  function f6 (string)
+    character (len = *), pointer :: string
+    character (len = len (string (a:))) :: f6
+    f6 = ''
+  end function f6
+
+  subroutine indirect (textp2)
+    character (len = 50), pointer :: textp2
+
+    call test (f1 (textp), 70)
+    call test (f2 (textp, textp), 95)
+    call test (f3 (textp), 105)
+    call test (f4 (textp), 192)
+    call test (f5 (textp), 140)
+    call test (f6 (textp), 29)
+
+    call test (f1 (textp2), 50)
+    call test (f2 (textp2, textp), 65)
+    call test (f3 (textp2), 85)
+    call test (f4 (textp2), 192)
+    call test (f5 (textp2), 100)
+    call test (f6 (textp2), 9)
+  end subroutine indirect
+
+  subroutine test (string, length)
+    character (len = *) :: string
+    integer, intent (in) :: length
+    if (len (string) .ne. length) call abort
+  end subroutine test
+end program main
diff --git a/gcc/testsuite/gfortran.dg/char_result_3.f90 b/gcc/testsuite/gfortran.dg/char_result_3.f90
new file mode 100644
index 0000000..8b9aa92
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/char_result_3.f90
@@ -0,0 +1,78 @@
+! Related to PR 15326.  Try calling string functions whose lengths involve
+! some sort of array calculation.
+! { dg-do run }
+pure elemental function double (x)
+  integer, intent (in) :: x
+  integer :: double
+  double = x * 2
+end function double
+
+program main
+  implicit none
+
+  interface
+    pure elemental function double (x)
+      integer, intent (in) :: x
+      integer :: double
+    end function double
+  end interface
+
+  integer, dimension (100:104), target :: a
+  integer, dimension (:), pointer :: ap
+  integer :: i, lower
+
+  a = (/ (i + 5, i = 0, 4) /)
+  ap => a
+  lower = 11
+
+  call test (f1 (a), 35)
+  call test (f1 (ap), 35)
+  call test (f1 ((/ 5, 10, 50 /)), 65)
+  call test (f1 (a (101:103)), 21)
+
+  call test (f2 (a), 115)
+  call test (f2 (ap), 115)
+  call test (f2 ((/ 5, 10, 50 /)), 119)
+  call test (f2 (a (101:103)), 116)
+
+  call test (f3 (a), 60)
+  call test (f3 (ap), 60)
+  call test (f3 ((/ 5, 10, 50 /)), 120)
+  call test (f3 (a (101:103)), 30)
+
+  call test (f4 (a, 13, 1), 21)
+  call test (f4 (ap, 13, 2), 14)
+  call test (f4 ((/ 5, 10, 50 /), 12, 1), 60)
+  call test (f4 (a (101:103), 12, 1), 15)
+contains
+  function f1 (array)
+    integer, dimension (10:) :: array
+    character (len = sum (array)) :: f1
+    f1 = ''
+  end function f1
+
+  function f2 (array)
+    integer, dimension (10:) :: array
+    character (len = array (11) + a (104) + 100) :: f2
+    f2 = ''
+  end function f2
+
+  function f3 (array)
+    integer, dimension (:) :: array
+    character (len = sum (double (array (2:)))) :: f3
+    f3 = ''
+  end function f3
+
+  function f4 (array, upper, stride)
+    integer, dimension (10:) :: array
+    integer :: upper, stride
+    character (len = sum (array (lower:upper:stride))) :: f4
+    f4 = ''
+  end function f4
+
+  subroutine test (string, length)
+    character (len = *) :: string
+    integer, intent (in) :: length
+    if (len (string) .ne. length) call abort
+  end subroutine test
+end program main
diff --git a/gcc/testsuite/gfortran.dg/char_result_4.f90 b/gcc/testsuite/gfortran.dg/char_result_4.f90
new file mode 100644
index 0000000..0224f43
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/char_result_4.f90
@@ -0,0 +1,62 @@
+! Like char_result_3.f90, but the array arguments are pointers.
+! { dg-do run }
+pure elemental function double (x)
+  integer, intent (in) :: x
+  integer :: double
+  double = x * 2
+end function double
+
+program main
+  implicit none
+
+  interface
+    pure elemental function double (x)
+      integer, intent (in) :: x
+      integer :: double
+    end function double
+  end interface
+
+  integer, dimension (100:104), target :: a
+  integer, dimension (:), pointer :: ap
+  integer :: i, lower
+
+  a = (/ (i + 5, i = 0, 4) /)
+  ap => a
+  lower = 1
+
+  call test (f1 (ap), 35)
+  call test (f2 (ap), 115)
+  call test (f3 (ap), 60)
+  call test (f4 (ap, 5, 2), 21)
+contains
+  function f1 (array)
+    integer, dimension (:), pointer :: array
+    character (len = sum (array)) :: f1
+    f1 = ''
+  end function f1
+
+  function f2 (array)
+    integer, dimension (:), pointer :: array
+    character (len = array (2) + a (104) + 100) :: f2
+    f2 = ''
+  end function f2
+
+  function f3 (array)
+    integer, dimension (:), pointer :: array
+    character (len = sum (double (array (2:)))) :: f3
+    f3 = ''
+  end function f3
+
+  function f4 (array, upper, stride)
+    integer, dimension (:), pointer :: array
+    integer :: upper, stride
+    character (len = sum (array (lower:upper:stride))) :: f4
+    f4 = ''
+  end function f4
+
+  subroutine test (string, length)
+    character (len = *) :: string
+    integer, intent (in) :: length
+    if (len (string) .ne. length) call abort
+  end subroutine test
+end program main
diff --git a/gcc/testsuite/gfortran.dg/char_result_5.f90 b/gcc/testsuite/gfortran.dg/char_result_5.f90
new file mode 100644
index 0000000..96832b3
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/char_result_5.f90
@@ -0,0 +1,137 @@
+! Related to PR 15326.  Test calls to string functions whose lengths
+! depend on various types of scalar value.
+! { dg-do run }
+pure function select (selector, iftrue, iffalse)
+  logical, intent (in) :: selector
+  integer, intent (in) :: iftrue, iffalse
+  integer :: select
+
+  if (selector) then
+    select = iftrue
+  else
+    select = iffalse
+  end if
+end function select
+
+program main
+  implicit none
+
+  interface
+    pure function select (selector, iftrue, iffalse)
+      logical, intent (in) :: selector
+      integer, intent (in) :: iftrue, iffalse
+      integer :: select
+    end function select
+  end interface
+
+  type pair
+    integer :: left, right
+  end type pair
+
+  integer, target :: i
+  integer, pointer :: ip
+  real, target :: r
+  real, pointer :: rp
+  logical, target :: l
+  logical, pointer :: lp
+  complex, target :: c
+  complex, pointer :: cp
+  character, target :: ch
+  character, pointer :: chp
+  type (pair), target :: p
+  type (pair), pointer :: pp
+
+  character (len = 10) :: dig
+
+  i = 100
+  r = 50.5
+  l = .true.
+  c = (10.9, 11.2)
+  ch = '1'
+  p%left = 40
+  p%right = 50
+
+  ip => i
+  rp => r
+  lp => l
+  cp => c
+  chp => ch
+  pp => p
+
+  dig = '1234567890'
+
+  call test (f1 (i), 200)
+  call test (f1 (ip), 200)
+  call test (f1 (-30), 60)
+  call test (f1 (i / (-4)), 50)
+
+  call test (f2 (r), 100)
+  call test (f2 (rp), 100)
+  call test (f2 (70.1), 140)
+  call test (f2 (r / 4), 24)
+  call test (f2 (real (i)), 200)
+
+  call test (f3 (l), 50)
+  call test (f3 (lp), 50)
+  call test (f3 (.false.), 55)
+  call test (f3 (i < 30), 55)
+
+  call test (f4 (c), 10)
+  call test (f4 (cp), 10)
+  call test (f4 (cmplx (60.0, r)), 60)
+  call test (f4 (cmplx (r, 1.0)), 50)
+
+  call test (f5 (ch), 11)
+  call test (f5 (chp), 11)
+  call test (f5 ('23'), 12)
+  call test (f5 (dig (3:)), 13)
+  call test (f5 (dig (10:)), 10)
+
+  call test (f6 (p), 145)
+  call test (f6 (pp), 145)
+  call test (f6 (pair (20, 10)), 85)
+  call test (f6 (pair (i / 2, 1)), 106)
+contains
+  function f1 (i)
+    integer :: i
+    character (len = abs (i) * 2) :: f1
+    f1 = ''
+  end function f1
+
+  function f2 (r)
+    real :: r
+    character (len = floor (r) * 2) :: f2
+    f2 = ''
+  end function f2
+
+  function f3 (l)
+    logical :: l
+    character (len = select (l, 50, 55)) :: f3
+    f3 = ''
+  end function f3
+
+  function f4 (c)
+    complex :: c
+    character (len = int (c)) :: f4
+    f4 = ''
+  end function f4
+
+  function f5 (c)
+    character :: c
+    character (len = scan ('123456789', c) + 10) :: f5
+    f5 = ''
+  end function f5
+
+  function f6 (p)
+    type (pair) :: p
+    integer :: i
+    character (len = sum ((/ p%left, p%right, (i, i = 1, 10) /))) :: f6
+    f6 = ''
+  end function f6
+
+  subroutine test (string, length)
+    character (len = *) :: string
+    integer, intent (in) :: length
+    if (len (string) .ne. length) call abort
+  end subroutine test
+end program main
diff --git a/gcc/testsuite/gfortran.dg/char_result_6.f90 b/gcc/testsuite/gfortran.dg/char_result_6.f90
new file mode 100644
index 0000000..de8e105
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/char_result_6.f90
@@ -0,0 +1,107 @@
+! Like char_result_5.f90, but the function arguments are pointers to scalars.
+! { dg-do run }
+pure function select (selector, iftrue, iffalse)
+  logical, intent (in) :: selector
+  integer, intent (in) :: iftrue, iffalse
+  integer :: select
+
+  if (selector) then
+    select = iftrue
+  else
+    select = iffalse
+  end if
+end function select
+
+program main
+  implicit none
+
+  interface
+    pure function select (selector, iftrue, iffalse)
+      logical, intent (in) :: selector
+      integer, intent (in) :: iftrue, iffalse
+      integer :: select
+    end function select
+  end interface
+
+  type pair
+    integer :: left, right
+  end type pair
+
+  integer, target :: i
+  integer, pointer :: ip
+  real, target :: r
+  real, pointer :: rp
+  logical, target :: l
+  logical, pointer :: lp
+  complex, target :: c
+  complex, pointer :: cp
+  character, target :: ch
+  character, pointer :: chp
+  type (pair), target :: p
+  type (pair), pointer :: pp
+
+  i = 100
+  r = 50.5
+  l = .true.
+  c = (10.9, 11.2)
+  ch = '1'
+  p%left = 40
+  p%right = 50
+
+  ip => i
+  rp => r
+  lp => l
+  cp => c
+  chp => ch
+  pp => p
+
+  call test (f1 (ip), 200)
+  call test (f2 (rp), 100)
+  call test (f3 (lp), 50)
+  call test (f4 (cp), 10)
+  call test (f5 (chp), 11)
+  call test (f6 (pp), 145)
+contains
+  function f1 (i)
+    integer, pointer :: i
+    character (len = abs (i) * 2) :: f1
+    f1 = ''
+  end function f1
+
+  function f2 (r)
+    real, pointer :: r
+    character (len = floor (r) * 2) :: f2
+    f2 = ''
+  end function f2
+
+  function f3 (l)
+    logical, pointer :: l
+    character (len = select (l, 50, 55)) :: f3
+    f3 = ''
+  end function f3
+
+  function f4 (c)
+    complex, pointer :: c
+    character (len = int (c)) :: f4
+    f4 = ''
+  end function f4
+
+  function f5 (c)
+    character, pointer :: c
+    character (len = scan ('123456789', c) + 10) :: f5
+    f5 = ''
+  end function f5
+
+  function f6 (p)
+    type (pair), pointer :: p
+    integer :: i
+    character (len = sum ((/ p%left, p%right, (i, i = 1, 10) /))) :: f6
+    f6 = ''
+  end function f6
+
+  subroutine test (string, length)
+    character (len = *) :: string
+    integer, intent (in) :: length
+    if (len (string) .ne. length) call abort
+  end subroutine test
+end program main
diff --git a/gcc/testsuite/gfortran.dg/char_result_7.f90 b/gcc/testsuite/gfortran.dg/char_result_7.f90
new file mode 100644
index 0000000..a037d2b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/char_result_7.f90
@@ -0,0 +1,55 @@
+! Related to PR 15326.  Try calling string functions whose lengths depend
+! on a dummy procedure.
+! { dg-do run }
+integer pure function double (x)
+  integer, intent (in) :: x
+  double = x * 2
+end function double
+
+program main
+  implicit none
+
+  interface
+    integer pure function double (x)
+      integer, intent (in) :: x
+    end function double
+  end interface
+
+  call test (f1 (double, 100), 200)
+  call test (f2 (double, 70), 140)
+
+  call indirect (double)
+contains
+  function f1 (fn, i)
+    integer :: i
+    interface
+      integer pure function fn (x)
+        integer, intent (in) :: x
+      end function fn
+    end interface
+    character (len = fn (i)) :: f1
+    f1 = ''
+  end function f1
+
+  function f2 (fn, i)
+    integer :: i, fn
+    character (len = fn (i)) :: f2
+    f2 = ''
+  end function f2
+
+  subroutine indirect (fn)
+    interface
+      integer pure function fn (x)
+        integer, intent (in) :: x
+      end function fn
+    end interface
+    call test (f1 (fn, 100), 200)
+    call test (f2 (fn, 70), 140)
+  end subroutine indirect
+
+  subroutine test (string, length)
+    character (len = *) :: string
+    integer, intent (in) :: length
+    if (len (string) .ne. length) call abort
+  end subroutine test
+end program main
diff --git a/gcc/testsuite/gfortran.dg/char_result_8.f90 b/gcc/testsuite/gfortran.dg/char_result_8.f90
new file mode 100644
index 0000000..b1dda89
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/char_result_8.f90
@@ -0,0 +1,51 @@
+! Related to PR 15326.  Compare functions that return string pointers with
+! functions that return strings.
+! { dg-do run }
+program main
+  implicit none
+
+  character (len = 100), target :: string
+
+  call test (f1 (), 30)
+  call test (f2 (50), 50)
+  call test (f3 (), 30)
+  call test (f4 (70), 70)
+
+  call indirect (100)
+contains
+  function f1
+    character (len = 30) :: f1
+    f1 = ''
+  end function f1
+
+  function f2 (i)
+    integer :: i
+    character (len = i) :: f2
+    f2 = ''
+  end function f2
+
+  function f3
+    character (len = 30), pointer :: f3
+    f3 => string
+  end function f3
+
+  function f4 (i)
+    integer :: i
+    character (len = i), pointer :: f4
+    f4 => string
+  end function f4
+
+  subroutine indirect (i)
+    integer :: i
+    call test (f1 (), 30)
+    call test (f2 (i), i)
+    call test (f3 (), 30)
+    call test (f4 (i), i)
+  end subroutine indirect
+
+  subroutine test (string, length)
+    character (len = *) :: string
+    integer, intent (in) :: length
+    if (len (string) .ne. length) call abort
+  end subroutine test
+end program main