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

2009-09-10  Steven G. Kargl  <kargl@gcc.gnu.org>

	PR fortran/31292
	* fortran/decl.c(gfc_match_modproc): Check that module procedures
	from a module can USEd in module procedure statements in other
	program units.  Update locus for better error message display.
	Detect intrinsic procedures in module procedure statements.

2009-09-10  Steven G. Kargl  <kargl@gcc.gnu.org>

	PR fortran/31292
	* gfortran.dg/module_procedure_1.f90: New test.
	* gfortran.dg/module_procedure_2.f90: Ditto.
	* gfortran.dg/generic_14.f90: Move dg-error to new location.

From-SVN: r151616

6 files changed, 93 insertions, 5 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index c01c4b3..d134e2c 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,11 @@
+2009-09-10  Steven G. Kargl  <kargl@gcc.gnu.org>
+
+	PR fortran/31292
+	* fortran/decl.c(gfc_match_modproc): Check that module procedures
+	from a module can USEd in module procedure statements in other
+	program units.  Update locus for better error message display.
+	Detect intrinsic procedures in module procedure statements.
+
 2009-09-09  Richard Guenther  <rguenther@suse.de>
 
 	PR fortran/41297
diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c
index 52796a6..3ce7fd4 100644
--- a/gcc/fortran/decl.c
+++ b/gcc/fortran/decl.c
@@ -6485,7 +6485,10 @@ gfc_match_modproc (void)
 
   module_ns = gfc_current_ns->parent;
   for (; module_ns; module_ns = module_ns->parent)
-    if (module_ns->proc_name->attr.flavor == FL_MODULE)
+    if (module_ns->proc_name->attr.flavor == FL_MODULE
+	|| module_ns->proc_name->attr.flavor == FL_PROGRAM
+	|| (module_ns->proc_name->attr.flavor == FL_PROCEDURE
+	    && !module_ns->proc_name->attr.contained))
       break;
 
   if (module_ns == NULL)
@@ -6497,6 +6500,7 @@ gfc_match_modproc (void)
 
   for (;;)
     {
+      locus old_locus = gfc_current_locus;
       bool last = false;
 
       m = gfc_match_name (name);
@@ -6517,6 +6521,13 @@ gfc_match_modproc (void)
       if (gfc_get_symbol (name, module_ns, &sym))
 	return MATCH_ERROR;
 
+      if (sym->attr.intrinsic)
+	{
+	  gfc_error ("Intrinsic procedure at %L cannot be a MODULE "
+		     "PROCEDURE", &old_locus);
+	  return MATCH_ERROR;
+	}
+
       if (sym->attr.proc != PROC_MODULE
 	  && gfc_add_procedure (&sym->attr, PROC_MODULE,
 				sym->name, NULL) == FAILURE)
@@ -6526,6 +6537,7 @@ gfc_match_modproc (void)
 	return MATCH_ERROR;
 
       sym->attr.mod_proc = 1;
+      sym->declared_at = old_locus;
 
       if (last)
 	break;
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 3a6e97a..7b23648 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,10 @@
+2009-09-10  Steven G. Kargl  <kargl@gcc.gnu.org>
+
+	PR fortran/31292
+	* gfortran.dg/module_procedure_1.f90: New test.
+	* gfortran.dg/module_procedure_2.f90: Ditto.
+	* gfortran.dg/generic_14.f90: Move dg-error to new location.
+
 2009-09-10  Rainer Orth  <ro@CeBiTec.Uni-Bielefeld.DE>
 	    James A. Morrison  <phython@gcc.gnu.org>
 
diff --git a/gcc/testsuite/gfortran.dg/generic_14.f90 b/gcc/testsuite/gfortran.dg/generic_14.f90
index 3198da1..e95f6f2 100644
--- a/gcc/testsuite/gfortran.dg/generic_14.f90
+++ b/gcc/testsuite/gfortran.dg/generic_14.f90
@@ -85,18 +85,18 @@ end module f
 
 module g
   implicit none
-  external wrong_b            ! { dg-error "has no explicit interface" }
+  external wrong_b
   interface gen_wrong_5
-    module procedure wrong_b  ! wrong, see above
+    module procedure wrong_b  ! { dg-error "has no explicit interface" }
   end interface gen_wrong_5
 end module g
 
 module h
   implicit none
-  external wrong_c            ! { dg-error "has no explicit interface" }
+  external wrong_c
   real wrong_c
   interface gen_wrong_6
-    module procedure wrong_c  ! wrong, see above
+    module procedure wrong_c  ! { dg-error "has no explicit interface" }
   end interface gen_wrong_6
 end module h
 
diff --git a/gcc/testsuite/gfortran.dg/module_procedure_1.f90 b/gcc/testsuite/gfortran.dg/module_procedure_1.f90
new file mode 100644
index 0000000..5e1fa15
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/module_procedure_1.f90
@@ -0,0 +1,53 @@
+! { dg-do run }
+! Modified program from http://groups.google.com/group/\
+! comp.lang.fortran/browse_frm/thread/423e4392dc965ab7#
+!
+module myoperator
+   contains
+      function dadd(arg1,arg2)
+         integer ::dadd(2)
+         integer, intent(in) :: arg1(2), arg2(2)
+         dadd(1)=arg1(1)+arg2(1)
+         dadd(2)=arg1(2)+arg2(2)
+      end function dadd
+end module myoperator
+
+program test_interface
+
+   use myoperator
+
+   implicit none
+
+   interface operator (.myadd.)
+      module procedure dadd
+   end interface
+
+   integer input1(2), input2(2), mysum(2)
+
+   input1 = (/0,1/)
+   input2 = (/3,3/)
+   mysum = input1 .myadd. input2
+   if (mysum(1) /= 3 .and. mysum(2) /= 4) call abort 
+
+   call test_sub(input1, input2)
+
+end program test_interface 
+
+subroutine test_sub(input1, input2)
+
+   use myoperator
+
+   implicit none
+
+   interface operator (.myadd.)
+      module procedure dadd
+   end interface
+
+   integer, intent(in) :: input1(2), input2(2)
+   integer mysum(2)
+
+   mysum = input1 .myadd. input2
+   if (mysum(1) /= 3 .and. mysum(2) /= 4) call abort 
+
+end subroutine test_sub 
+! { dg-final { cleanup-modules "myoperator" } }
diff --git a/gcc/testsuite/gfortran.dg/module_procedure_2.f90 b/gcc/testsuite/gfortran.dg/module_procedure_2.f90
new file mode 100644
index 0000000..8f6db25
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/module_procedure_2.f90
@@ -0,0 +1,8 @@
+! { dg-do compile }
+program test
+   implicit none
+   intrinsic sin
+   interface gen2
+      module procedure sin  ! { dg-error "cannot be a MODULE PROCEDURE" }
+   end interface gen2
+end program test