[Fortran, Patch] PR33228 Improve checking for MODULE PROCEDURE

[Tobias Burnus <burnus at net-b dot de>]

:ADDPATCH fortran:

The Fortran 2003 standard states:

"C1208 (R1206) If MODULE appears in a procedure-stmt, each
procedure-name in that statement shall be accessible in the current
scope as a module procedure."

"module procedure (2.2.3.2) : A procedure that is defined by a module
subprogram."

The following is not module procedure, even if one USEs the module:

module a
  interface
    subroutine sub()
    end subroutine sub
  end interface
end module a

gfortran was accepting this, g95 and NAG f95 rejected this. See also,
esp. the second post by Richard Maine.
http://groups.google.com/group/comp.lang.fortran/browse_thread/thread/4d51d6ca89f7d4f8/

In the patch, I also updated some error messages so that they are more
helpful.

(By the way, if one wants to to include the subroutine sub in an generic
interface, one can use in Fortran 2003 the PROCEDURE statement; this
needs Janus' PROCEDURE patch.)

Build and regression tested on x86_64-unknown-linux-gnu.
OK for the trunk?

Tobias

2007-08-30  Tobias Burnus  <burnus@net-b.de>

	PR fortran/33228
	* interface.c (check_interface0): Improve error for external procs.
	(check_sym_interfaces): Fix checking of module procedures.

2007-08-30  Tobias Burnus  <burnus@net-b.de>

	PR fortran/33228
	* gfortran.dg/generic_9.f90: Update error message.
	* gfortran.dg/generic_14.f90: New.

Index: gcc/fortran/interface.c
===================================================================
--- gcc/fortran/interface.c	(Revision 127921)
+++ gcc/fortran/interface.c	(Arbeitskopie)
@@ -988,9 +988,13 @@ check_interface0 (gfc_interface *p, cons
   for (; p; p = p->next)
     if (!p->sym->attr.function && !p->sym->attr.subroutine)
       {
-	gfc_error ("Procedure '%s' in %s at %L is neither function nor "
-		   "subroutine", p->sym->name, interface_name,
-		   &p->sym->declared_at);
+	if (p->sym->attr.external)
+	  gfc_error ("Procedure '%s' in %s at %L has no explicit interface",
+		     p->sym->name, interface_name, &p->sym->declared_at);
+	else
+	  gfc_error ("Procedure '%s' in %s at %L is neither function nor "
+		     "subroutine", p->sym->name, interface_name,
+		     &p->sym->declared_at);
 	return 1;
       }
   p = psave;
@@ -1081,11 +1085,10 @@ check_sym_interfaces (gfc_symbol *sym)
 
       for (p = sym->generic; p; p = p->next)
 	{
-	  if (!p->sym->attr.use_assoc && p->sym->attr.mod_proc
-	      && p->sym->attr.if_source != IFSRC_DECL)
+	  if (p->sym->attr.mod_proc && p->sym->attr.if_source != IFSRC_DECL)
 	    {
-	      gfc_error ("MODULE PROCEDURE '%s' at %L does not come "
-			 "from a module", p->sym->name, &p->where);
+	      gfc_error ("'%s' at %L is not a module procedure",
+			 p->sym->name, &p->where);
 	      return;
 	    }
 	}
Index: gcc/testsuite/gfortran.dg/generic_14.f90
===================================================================
--- gcc/testsuite/gfortran.dg/generic_14.f90	(Revision 0)
+++ gcc/testsuite/gfortran.dg/generic_14.f90	(Revision 0)
@@ -0,0 +1,105 @@
+! { dg-do compile }
+!
+! Check whether MODULE PROCEDUREs are properly treated
+! They need to be contained in a procedure, i.e. an
+! interface in another procedure is invalid; they may, however,
+! come from a use-associated procedure.
+! (The PROCEDURE statement allows also for non-module procedures
+!  if there is an explicit interface.)
+!
+! PR fortran/33228
+!
+module inclmod
+  implicit none
+  interface
+    subroutine wrong1(a)
+      integer :: a
+    end subroutine wrong1
+  end interface
+  interface gen_incl
+    module procedure ok1
+  end interface gen_incl
+  external wrong2
+  external wrong3
+  real wrong3
+contains
+  subroutine ok1(f)
+    character :: f
+  end subroutine ok1
+end module inclmod
+
+module a
+  use inclmod
+  implicit none
+  interface gen
+    subroutine ok1_a(a,b)
+      integer :: a,b
+    end subroutine ok1_a
+    module procedure ok1, ok2_a
+  end interface gen
+contains
+  subroutine ok2_a(a,b,c)
+     integer :: a,b,c
+  end subroutine ok2_a
+end module a
+
+module b
+  use inclmod
+  interface gen_wrong_0
+    module procedure gen_incl  ! { dg-error "Cannot change attributes" }
+  end interface gen_wrong_0
+end module b
+
+module c
+  use inclmod
+  interface gen_wrong_1
+    module procedure wrong1  ! { dg-error "is not a module procedure" }
+  end interface gen_wrong_1
+end module c
+
+module d
+  use inclmod
+  interface gen_wrong_2
+    module procedure wrong2  ! { dg-error "Cannot change attributes" }
+  end interface gen_wrong_2
+end module d
+
+module e
+  use inclmod
+  interface gen_wrong_3
+    module procedure wrong3  ! { dg-error "Cannot change attributes" }
+  end interface gen_wrong_3
+end module e
+
+module f
+  implicit none
+  interface
+    subroutine wrong_a(a)
+      integer :: a
+    end subroutine wrong_a
+  end interface
+  interface gen_wrong_4
+    module procedure wrong_a  ! { dg-error "is not a module procedure" }
+  end interface gen_wrong_4
+end module f
+
+module g
+  implicit none
+  external wrong_b            ! { dg-error "has no explicit interface" }
+  interface gen_wrong_5
+    module procedure wrong_b  ! wrong, see above
+  end interface gen_wrong_5
+end module g
+
+module h
+  implicit none
+  external wrong_c            ! { dg-error "has no explicit interface" }
+  real wrong_c
+  interface gen_wrong_6
+    module procedure wrong_c  ! wrong, see above
+  end interface gen_wrong_6
+end module h
+
+end
+
+! { dg-final { cleanup-modules "a inclmod" } }
Index: gcc/testsuite/gfortran.dg/generic_9.f90
===================================================================
--- gcc/testsuite/gfortran.dg/generic_9.f90	(Revision 127921)
+++ gcc/testsuite/gfortran.dg/generic_9.f90	(Arbeitskopie)
@@ -21,7 +21,7 @@ MODULE class_foo
 USE class_foo_type, ONLY: foo, bar_init_set_int
 
 INTERFACE foo_init
-  MODULE PROCEDURE foo_init_default  ! { dg-error "does not come from a module" }
+  MODULE PROCEDURE foo_init_default  ! { dg-error "is not a module procedure" }
 END INTERFACE
 
 INTERFACE bar_init