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

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index f87dc8fba8874fdd999e4eb6faeb598c992048de..e40c9e233ff44d496a504e243a3f2183d555007e 100644 (file)
--- 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 55cc641cf8872107fa745f9e2fed84b363e62244..7bb5a25834f2c86afec685f2babbca68cce580b5 100644 (file)
--- 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 0fd46770896a4b8b405b92e0ea4bca0e66d24ced..aa8626626ce527db0bd59b0babf35ad4320b591b 100644 (file)
--- 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 (file)
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 2bd143ff858a203fbfcaa0ac904eb71195a1fb60..92dd65096c1ac8897b90c4a85e7ec9a5c3612660 100644 (file)
--- 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