primary.c (gfc_match_rvalue): Only apply implicit type if variable does not have an explicit type.

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.

From-SVN: r94066

1 files changed, 19 insertions, 11 deletions

diff --git a/gcc/fortran/primary.c b/gcc/fortran/primary.c
index da2b7c8..6496bcd 100644
--- a/gcc/fortran/primary.c
+++ b/gcc/fortran/primary.c
@@ -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, int equiv_flag)
     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, int equiv_flag)
       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;