Implicitly typed functions

[Paul Brook <paul at codesourcery dot com>]

When applying an implicit type to a function result we should take that 
implicit type from the function namespace, not it's parent namespace.
Attached patch fixes this.
It also ensures we apply implicit derived types to all symbols during parsing, 
not just unknown ones.

Tested on i686-linux.
Applied to mainline.

Paul

2005-01-22  Paul Brook  <paul@codesourcery.com>

 * primary.c (gfc_match_rvalue): Only apply implicit type if variable
 does not have an explicit type.
 (gfc_match_variable): Resolve implicit derived types in all cases.
 Resolve contained function types from their own namespace, not the
 parent.
 * resolve.c (resolve_contained_fntype): Remove duplicate sym->result
 checking.  Resolve from the contained namespace, not the parent.
testsuite/
 * gfortran.dg/implicit_2.f90: New test.

Index: primary.c
===================================================================
RCS file: /var/cvsroot/gcc-cvs/gcc/gcc/fortran/primary.c,v
retrieving revision 1.16
diff -u -p -r1.16 primary.c
--- primary.c	15 Jan 2005 22:38:01 -0000	1.16
+++ primary.c	22 Jan 2005 14:22:32 -0000
@@ -2011,6 +2011,7 @@ gfc_match_rvalue (gfc_expr ** result)
          resolution phase.  */
 
       if (gfc_peek_char () == '%'
+	  && sym->ts.type == BT_UNKNOWN
 	  && gfc_get_default_type (sym, sym->ns)->type == BT_DERIVED)
 	gfc_set_default_type (sym, 0, sym->ns);
 
@@ -2188,29 +2189,18 @@ gfc_match_variable (gfc_expr ** result, 
     case FL_UNKNOWN:
       if (gfc_add_flavor (&sym->attr, FL_VARIABLE, NULL) == FAILURE)
 	return MATCH_ERROR;
-
-      /* Special case for derived type variables that get their types
-         via an IMPLICIT statement.  This can't wait for the
-         resolution phase.  */
-
-      if (gfc_peek_char () == '%'
-	  && gfc_get_default_type (sym, sym->ns)->type == BT_DERIVED)
-	gfc_set_default_type (sym, 0, sym->ns);
-
       break;
 
     case FL_PROCEDURE:
       /* Check for a nonrecursive function result */
       if (sym->attr.function && (sym->result == sym || sym->attr.entry))
 	{
-
 	  /* If a function result is a derived type, then the derived
 	     type may still have to be resolved.  */
 
 	  if (sym->ts.type == BT_DERIVED
 	      && gfc_use_derived (sym->ts.derived) == NULL)
 	    return MATCH_ERROR;
-
 	  break;
 	}
 
@@ -2221,6 +2211,24 @@ gfc_match_variable (gfc_expr ** result, 
       return MATCH_ERROR;
     }
 
+  /* Special case for derived type variables that get their types
+     via an IMPLICIT statement.  This can't wait for the
+     resolution phase.  */
+
+    {
+      gfc_namespace * implicit_ns;
+
+      if (gfc_current_ns->proc_name == sym)
+	implicit_ns = gfc_current_ns;
+      else
+	implicit_ns = sym->ns;
+	
+      if (gfc_peek_char () == '%'
+	  && sym->ts.type == BT_UNKNOWN
+	  && gfc_get_default_type (sym, implicit_ns)->type == BT_DERIVED)
+	gfc_set_default_type (sym, 0, implicit_ns);
+    }
+
   expr = gfc_get_expr ();
 
   expr->expr_type = EXPR_VARIABLE;
Index: resolve.c
===================================================================
RCS file: /var/cvsroot/gcc-cvs/gcc/gcc/fortran/resolve.c,v
retrieving revision 1.29
diff -u -p -r1.29 resolve.c
--- resolve.c	16 Jan 2005 17:53:26 -0000	1.29
+++ resolve.c	22 Jan 2005 14:21:08 -0000
@@ -259,27 +259,13 @@ resolve_contained_fntype (gfc_symbol * s
 	   || sym->attr.flavor == FL_VARIABLE))
     return;
 
-  /* Try to find out of what type the function is.  If there was an
-     explicit RESULT clause, try to get the type from it.  If the
-     function is never defined, set it to the implicit type.  If
-     even that fails, give up.  */
+  /* Try to find out of what the return type is.  */
   if (sym->result != NULL)
     sym = sym->result;
 
   if (sym->ts.type == BT_UNKNOWN)
     {
-      /* Assume we can find an implicit type.  */
-      t = SUCCESS;
-
-      if (sym->result == NULL)
-	t = gfc_set_default_type (sym, 0, ns);
-      else
-	{
-	  if (sym->result->ts.type == BT_UNKNOWN)
-	    t = gfc_set_default_type (sym->result, 0, NULL);
-
-	  sym->ts = sym->result->ts;
-	}
+      t = gfc_set_default_type (sym, 0, ns);
 
       if (t == FAILURE)
 	gfc_error ("Contained function '%s' at %L has no IMPLICIT type",