re PR fortran/31292 (ICE with module procedure interface in a procedure body)

2007-04-05  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/31292
	* decl.c (gfc_match_modproc): Go up to the top of the namespace
	tree to find the module namespace for gfc_get_symbol.

2007-04-05  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/31292
	* gfortran.dg/contained_module_proc_1.f90: New test.

From-SVN: r123517

gcc/fortran/ChangeLog

+2007-04-05  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/31292
+	* decl.c (gfc_match_modproc): Go up to the top of the namespace
+	tree to find the module namespace for gfc_get_symbol.
+
 2007-04-03  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
 
 	PR fortran/31304

gcc/fortran/decl.c

@@ -4241,6 +4241,7 @@ gfc_match_modproc (void)
   char name[GFC_MAX_SYMBOL_LEN + 1];
   gfc_symbol *sym;
   match m;
+  gfc_namespace *module_ns;
 
   if (gfc_state_stack->state != COMP_INTERFACE
       || gfc_state_stack->previous == NULL
@@ -4251,6 +4252,14 @@ gfc_match_modproc (void)
       return MATCH_ERROR;
     }
 
+  module_ns = gfc_current_ns->parent;
+  for (; module_ns; module_ns = module_ns->parent)
+    if (module_ns->proc_name->attr.flavor == FL_MODULE)
+      break;
+
+  if (module_ns == NULL)
+    return MATCH_ERROR;
+
   for (;;)
     {
       m = gfc_match_name (name);
@@ -4259,7 +4268,7 @@ gfc_match_modproc (void)
       if (m != MATCH_YES)
 	return MATCH_ERROR;
 
-      if (gfc_get_symbol (name, gfc_current_ns->parent, &sym))
+      if (gfc_get_symbol (name, module_ns, &sym))
 	return MATCH_ERROR;
 
       if (sym->attr.proc != PROC_MODULE

gcc/testsuite/ChangeLog

+2007-04-05  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/31292
+	* gfortran.dg/contained_module_proc_1.f90: New test.
+
 2007-04-04  Stuart Hastings  <stuart@apple.com>
 
 	PR 31281

gcc/testsuite/gfortran.dg/contained_module_proc_1.f90

+! { dg-do run }
+! Tests the check for PR31292, in which the module procedure
+! statement would put the symbol for assign_t in the wrong
+! namespace and this caused the interface checking to fail.
+!
+! Contributed by Tobias Burnus <burnus@gcc.gnu.org>
+!
+module chk_gfortran
+   implicit none
+   type t
+      integer x
+   end type t
+   contains
+      function is_gfortran()
+         logical is_gfortran
+         interface assignment(=)
+            module procedure assign_t
+         end interface assignment(=)
+         type(t) y(3)
+
+         y%x = (/1,2,3/)
+         y = y((/2,3,1/))
+         is_gfortran = y(3)%x == 1
+      end function is_gfortran
+
+      elemental subroutine assign_t(lhs,rhs)
+         type(t), intent(in) :: rhs
+         type(t), intent(out) :: lhs
+
+         lhs%x = rhs%x
+      end subroutine assign_t
+end module chk_gfortran
+
+program fire
+   use chk_gfortran
+   implicit none
+   if(.not. is_gfortran()) call abort()
+end program fire
+! { dg-final { cleanup-modules "chk_gfortran" } }
+