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, 78 insertions, 9 deletions

diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index e94a926..99fb2a2 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -1183,17 +1183,21 @@ static try
 resolve_function (gfc_expr * expr)
 {
   gfc_actual_arglist *arg;
+  gfc_symbol * sym;
   const char *name;
   try t;
   int temp;
 
-  /* If the procedure is not internal or module, it must be external and
-     should be checked for usage.  */
-  if (expr->symtree && expr->symtree->n.sym
-	&& !expr->symtree->n.sym->attr.dummy
-	&& !expr->symtree->n.sym->attr.contained
-	&& !expr->symtree->n.sym->attr.use_assoc)
-    resolve_global_procedure (expr->symtree->n.sym, &expr->where, 0);
+  sym = NULL;
+  if (expr->symtree)
+    sym = expr->symtree->n.sym;
+
+  /* If the procedure is not internal, a statement function or a module
+     procedure,it must be external and should be checked for usage.  */
+  if (sym && !sym->attr.dummy && !sym->attr.contained
+	&& sym->attr.proc != PROC_ST_FUNCTION
+	&& !sym->attr.use_assoc)
+    resolve_global_procedure (sym, &expr->where, 0);
 
   /* Switch off assumed size checking and do this again for certain kinds
      of procedure, once the procedure itself is resolved.  */
@@ -1205,19 +1209,44 @@ resolve_function (gfc_expr * expr)
   /* Resume assumed_size checking. */
   need_full_assumed_size--;
 
+  if (sym && sym->ts.type == BT_CHARACTER
+	  && sym->ts.cl && sym->ts.cl->length == NULL)
+    {
+      if (sym->attr.if_source == IFSRC_IFBODY)
+	{
+	  /* This follows from a slightly odd requirement at 5.1.1.5 in the
+	     standard that allows assumed character length functions to be
+	     declared in interfaces but not used.  Picking up the symbol here,
+	     rather than resolve_symbol, accomplishes that.  */
+	  gfc_error ("Function '%s' can be declared in an interface to "
+		     "return CHARACTER(*) but cannot be used at %L",
+		     sym->name, &expr->where);
+	  return FAILURE;
+	}
+
+      /* Internal procedures are taken care of in resolve_contained_fntype.  */
+      if (!sym->attr.dummy && !sym->attr.contained)
+	{
+	  gfc_error ("Function '%s' is declared CHARACTER(*) and cannot "
+		     "be used at %L since it is not a dummy argument",
+		     sym->name, &expr->where);
+	  return FAILURE;
+	}
+    }
+
 /* See if function is already resolved.  */
 
   if (expr->value.function.name != NULL)
     {
       if (expr->ts.type == BT_UNKNOWN)
-	expr->ts = expr->symtree->n.sym->ts;
+	expr->ts = sym->ts;
       t = SUCCESS;
     }
   else
     {
       /* Apply the rules of section 14.1.2.  */
 
-      switch (procedure_kind (expr->symtree->n.sym))
+      switch (procedure_kind (sym))
 	{
 	case PTYPE_GENERIC:
 	  t = resolve_generic_f (expr);
@@ -4862,6 +4891,46 @@ resolve_symbol (gfc_symbol * sym)
 	  return;
 	}
 
+      /* 5.1.1.5 of the Standard: A function name declared with an asterisk
+	 char-len-param shall not be array-valued, pointer-valued, recursive
+	 or pure.  ....snip... A character value of * may only be used in the
+	 following ways: (i) Dummy arg of procedure - dummy associates with
+	 actual length; (ii) To declare a named constant; or (iii) External
+	 function - but length must be declared in calling scoping unit.  */
+      if (sym->attr.function
+	    && sym->ts.type == BT_CHARACTER
+	    && sym->ts.cl && sym->ts.cl->length == NULL)
+	{
+	  if ((sym->as && sym->as->rank) || (sym->attr.pointer)
+		 || (sym->attr.recursive) || (sym->attr.pure))
+	    {
+	      if (sym->as && sym->as->rank)
+		gfc_error ("CHARACTER(*) function '%s' at %L cannot be "
+			   "array-valued", sym->name, &sym->declared_at);
+
+	      if (sym->attr.pointer)
+		gfc_error ("CHARACTER(*) function '%s' at %L cannot be "
+			   "pointer-valued", sym->name, &sym->declared_at);
+
+	      if (sym->attr.pure)
+		gfc_error ("CHARACTER(*) function '%s' at %L cannot be "
+			   "pure", sym->name, &sym->declared_at);
+
+	      if (sym->attr.recursive)
+		gfc_error ("CHARACTER(*) function '%s' at %L cannot be "
+			   "recursive", sym->name, &sym->declared_at);
+
+	      return;
+	    }
+
+	  /* Appendix B.2 of the standard.  Contained functions give an
+	     error anyway.  Fixed-form is likely to be F77/legacy.  */
+	  if (!sym->attr.contained && gfc_current_form != FORM_FIXED)
+	    gfc_notify_std (GFC_STD_F95_OBS, "CHARACTER(*) function "
+			    "'%s' at %L is obsolescent in fortran 95",
+			    sym->name, &sym->declared_at);
+	}
+
       break;
 
     case FL_DERIVED: