From: Paul Thomas <pault@gcc.gnu.org>
Date: Thu, 5 Apr 2007 14:00:27 +0000 (+0000)
Subject: re PR fortran/31292 (ICE with module procedure interface in a procedure body)
X-Git-Tag: releases/gcc-4.3.0~5867
X-Git-Url: https://gcc.gnu.org/git/?a=commitdiff_plain;h=060fca4a44e24baebe7575b9119518b7821c1c45;p=gcc.git

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
---

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index f43ac735215c..6e1be68f416d 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,9 @@
+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
diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c
index 570a036c0419..c9383ccce69d 100644
--- a/gcc/fortran/decl.c
+++ b/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
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 7ab79cbad97a..c3fccfa979e0 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+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
diff --git a/gcc/testsuite/gfortran.dg/contained_module_proc_1.f90 b/gcc/testsuite/gfortran.dg/contained_module_proc_1.f90
new file mode 100644
index 000000000000..a1e58929378b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/contained_module_proc_1.f90
@@ -0,0 +1,40 @@
+! { 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" } }
+