diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index c01c4b351b0d0d1b8247055f8b1489c552f83b78..d134e2cadcfe3a9391a96cc1b9e9a15794f1e5a4 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 52796a655750510f6f02dbe9360cabcdb7cb4e6c..3ce7fd4a33753ccff0217138b68a7d565bbcc361 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 3a6e97a8ea4e204f4b0d24a152c01e06fc781fae..7b23648297d5d59b4da18ea41ec711e0759df4a7 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 3198da1dafc1c66a6ad517ba05bfe1a8d9d75779..e95f6f2edebcfbb6c11a1aad7338f426162c889a 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 0000000000000000000000000000000000000000..5e1fa15c729fcffb32f8ce241a0e05c5e4484ac9
--- /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 0000000000000000000000000000000000000000..8f6db25fb13d6434c536376c834644475adadeea
--- /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