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

gcc/fortran/ChangeLog

+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.
+
 2005-01-22  Tobias Schl"uter  <tobias.schlueter@physik.uni-muenchen.de>
 
 	PR fortran/19543

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;

gcc/fortran/resolve.c

@@ -259,27 +259,13 @@ resolve_contained_fntype (gfc_symbol * sym, gfc_namespace * ns)
 	   || 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",

gcc/testsuite/ChangeLog

+2005-01-22  Paul Brook  <paul@codesourcery.com>
+
+	* gfortran.dg/implicit_2.f90: New test.
+
 2005-01-22  Bud Davis  <bdavis9659@comcast.net>
 
 	PR fortran/19314

gcc/testsuite/gfortran.dg/implicit_2.f90

+! { dg-do compile }
+
+module implicit_2
+  ! This should cause an error if function types are resolved from the
+  ! module namespace.
+  implicit none
+  type t
+    integer i
+  end type
+contains
+! This caused an ICE because we were trying to apply the implicit type
+! after we had applied the explicit type.
+subroutine test()
+  implicit type (t) (v)
+  type (t) v1, v2
+  v1%i = 1
+  call foo (v2%i)
+end subroutine
+
+! A similar error because we failed to apply the implicit type to a function.
+! This is a contained function to check we lookup the type in the function
+! namespace, not it's parent.
+function f() result (val)
+  implicit type (t) (v)
+
+  val%i = 1
+end function
+
+! And again for a result variable.
+function fun()
+  implicit type (t) (f)
+
+  fun%i = 1
+end function
+
+! intrinsic types are resolved later than derived type, so check those as well.
+function test2()
+  implicit integer (t)
+  test2 = 42
+end function
+subroutine bar()
+  ! Check that implicit types are applied to names already known to be
+  ! variables.
+  implicit type(t) (v)
+  save v
+  v%i = 42
+end subroutine
+end module