re PR fortran/33228 (Accepts use-associated functions in MODULE PROCEDURE)

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.

From-SVN: r127925

5 files changed, 128 insertions, 8 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index f87dc8f..e40c9e2 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,9 @@
+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-29  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
 
 	PR fortran/32989
diff --git a/gcc/fortran/interface.c b/gcc/fortran/interface.c
index 55cc641..7bb5a25 100644
--- a/gcc/fortran/interface.c
+++ b/gcc/fortran/interface.c
@@ -988,9 +988,13 @@ check_interface0 (gfc_interface *p, const char *interface_name)
   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;
 	    }
 	}
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 0fd4677..aa86266 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,9 @@
+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  Jakub Jelinek  <jakub@redhat.com>
 
 	* gcc.dg/sync-2.c (AI_ALIGN): Define if not defined.
diff --git a/gcc/testsuite/gfortran.dg/generic_14.f90 b/gcc/testsuite/gfortran.dg/generic_14.f90
new file mode 100644
index 0000000..3198da1
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/generic_14.f90
@@ -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" } }
diff --git a/gcc/testsuite/gfortran.dg/generic_9.f90 b/gcc/testsuite/gfortran.dg/generic_9.f90
index 2bd143f..92dd650 100644
--- a/gcc/testsuite/gfortran.dg/generic_9.f90
+++ b/gcc/testsuite/gfortran.dg/generic_9.f90
@@ -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