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.


git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@94066 138bc75d-0d04-0410-961f-82ee72b054a4

5 files changed, 83 insertions, 27 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 7ab798d21e6..fb4af7de454 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,13 @@
+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
diff --git a/gcc/fortran/primary.c b/gcc/fortran/primary.c
index da2b7c82b1a..6496bcd3478 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;
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 0e17c4be5e7..c3bf35057df 100644
--- a/gcc/fortran/resolve.c
+++ b/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",
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index fb28b4b7903..6b16fc8542e 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,7 @@
+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
diff --git a/gcc/testsuite/gfortran.dg/implicit_2.f90 b/gcc/testsuite/gfortran.dg/implicit_2.f90
new file mode 100644
index 00000000000..c0582d703b6
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/implicit_2.f90
@@ -0,0 +1,48 @@
+! { 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