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.

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@151616 138bc75d-0d04-0410-961f-82ee72b054a4

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index c01c4b3..d134e2c 100644 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
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 (file)
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