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 f43ac735215cca0d2257261c57e809b85a924910..6e1be68f416d10f3c3a3ea4bf82eabadc887c43c 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,9 @@
+2007-04-05  Paul Thomas  <pault@gcc.gnu.org>\r
+\r
+       PR fortran/31292\r
+       * decl.c (gfc_match_modproc): Go up to the top of the namespace\r
+       tree to find the module namespace for gfc_get_symbol.\r
+\r
 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 570a036c0419b88c39d7483ef924c02f2f9e4742..c9383ccce69d97bb7e723586c075649341835582 100644 (file)
--- 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 7ab79cbad97aedb4069ac353fdf1cde8fa9f337d..c3fccfa979e0e9f6d8d7f5fd2199fda510e892f7 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2007-04-05  Paul Thomas  <pault@gcc.gnu.org>\r
+\r
+       PR fortran/31292\r
+       * gfortran.dg/contained_module_proc_1.f90: New test.\r
+\r
 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 (file)
index 0000000..a1e5892
--- /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" } }
+