re PR fortran/25964 (NIST regression on fm311.f)

2005-01-26  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/25964
	* resolve.c (resolve_function): Exclude statement functions from
	global reference checking.

	PR fortran/25084
	PR fortran/20852
	PR fortran/25085
	PR fortran/25086
	* resolve.c (resolve_function): Declare a gfc_symbol to replace the
	references through the symtree to the symbol associated with the
	function expresion. Give error on reference to an assumed character
	length function is defined in an interface or an external function
	that is not a dummy argument.
	(resolve_symbol): Give error if an assumed character length function
	is array-valued, pointer-valued, pure or recursive. Emit warning
	that character(*) value functions are obsolescent in F95.

	PR fortran/25416
	* trans-expr.c (gfc_conv_function_call): The above patch to resolve.c
	prevents any assumed character length function call from getting here
	except intrinsics such as SPREAD. In this case, ensure that no
	segfault occurs from referencing non-existent charlen->length->
	expr_type and provide a backend_decl for the charlen from the charlen
	of the first actual argument.

	Cure temp name confusion.
	* trans-expr.c (gfc_get_interface_mapping_array): Change name of
	temporary from "parm" to "ifm" to avoid clash with temp coming from
	trans-array.c.

2005-01-26  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/25964
	* gfortran.dg/global_references_2.f90: New test.

	PR fortran/25084
	PR fortran/20852
	PR fortran/25085
	PR fortran/25086
	* gfortran.dg/assumed_charlen_function_1.f90: New test.
	* gfortran.dg/assumed_charlen_function_3.f90: New test.

	PR fortran/25416
	* gfortran.dg/assumed_charlen_function_2.f90: New test.

From-SVN: r110269

1 files changed, 24 insertions, 11 deletions

diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index b30a121..2322705 100644
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -1224,7 +1224,7 @@ gfc_get_interface_mapping_array (stmtblock_t * block, gfc_symbol * sym,
   type = gfc_typenode_for_spec (&sym->ts);
   type = gfc_get_nodesc_array_type (type, sym->as, packed);
 
-  var = gfc_create_var (type, "parm");
+  var = gfc_create_var (type, "ifm");
   gfc_add_modify_expr (block, var, fold_convert (type, data));
 
   return var;
@@ -1807,8 +1807,10 @@ gfc_conv_function_call (gfc_se * se, gfc_symbol * sym,
 
   gfc_init_interface_mapping (&mapping);
   need_interface_mapping = ((sym->ts.type == BT_CHARACTER
-			     && sym->ts.cl->length->expr_type != EXPR_CONSTANT)
-			    || sym->attr.dimension);
+				  && sym->ts.cl->length
+				  && sym->ts.cl->length->expr_type
+						!= EXPR_CONSTANT)
+			      || sym->attr.dimension);
   formal = sym->formal;
   /* Evaluate the arguments.  */
   for (; arg != NULL; arg = arg->next, formal = formal ? formal->next : NULL)
@@ -1905,19 +1907,30 @@ gfc_conv_function_call (gfc_se * se, gfc_symbol * sym,
   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);
+      if (sym->ts.cl->length == NULL)
+	{
+	  /* 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
-	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);
+	{
+	  /* 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);
+	  cl.backend_decl = fold_convert (gfc_charlen_type_node, parmse.expr);
+	}
 
       /* 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;