re PR fortran/33117 (Improve error message for generic interface with subroutines...

gcc/fortran/:
2011-01-06  Daniel Franke  <franke.daniel@gmail.com>

	PR fortran/33117
	PR fortran/46478
	* parse.c (parse_interface): Remove check for procedure types.
	* interface.c (check_interface0): Verify that procedures are
	either all SUBROUTINEs or all FUNCTIONs.

gcc/testsuite/:
2011-01-06  Daniel Franke  <franke.daniel@gmail.com>

	PR fortran/33117
	PR fortran/46478
	* gfortran.dg/interface_33.f90: New test.

From-SVN: r168542

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index d00b9edb6946f4b72a09c7b2945a94fe6dcab526..3181e5e1a354262ce3f6d3b39b981825fc88c2d8 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,11 @@
+2011-01-06  Daniel Franke  <franke.daniel@gmail.com>
+
+       PR fortran/33117
+       PR fortran/46478
+       * parse.c (parse_interface): Remove check for procedure types.
+       * interface.c (check_interface0): Verify that procedures are
+       either all SUBROUTINEs or all FUNCTIONs.
+
 2011-01-05  Janus Weil  <janus@gcc.gnu.org>
 
        PR fortran/47180

diff --git a/gcc/fortran/interface.c b/gcc/fortran/interface.c
index cf83557be550b2a4fc999cf7c424ae66e72dd716..1febb5d8587f1079ca20a59e39a44e4d6935d362 100644 (file)
--- a/gcc/fortran/interface.c
+++ b/gcc/fortran/interface.c
@@ -1092,8 +1092,9 @@ gfc_compare_interfaces (gfc_symbol *s1, gfc_symbol *s2, const char *name2,
 
 
 /* Given a pointer to an interface pointer, remove duplicate
-   interfaces and make sure that all symbols are either functions or
-   subroutines.  Returns nonzero if something goes wrong.  */
+   interfaces and make sure that all symbols are either functions
+   or subroutines, and all of the same kind.  Returns nonzero if
+   something goes wrong.  */
 
 static int
 check_interface0 (gfc_interface *p, const char *interface_name)
@@ -1101,21 +1102,32 @@ check_interface0 (gfc_interface *p, const char *interface_name)
   gfc_interface *psave, *q, *qlast;
 
   psave = p;
-  /* Make sure all symbols in the interface have been defined as
-     functions or subroutines.  */
   for (; p; p = p->next)
-    if ((!p->sym->attr.function && !p->sym->attr.subroutine)
-       || !p->sym->attr.if_source)
-      {
-       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;
-      }
+    {
+      /* Make sure all symbols in the interface have been defined as
+        functions or subroutines.  */
+      if ((!p->sym->attr.function && !p->sym->attr.subroutine)
+         || !p->sym->attr.if_source)
+       {
+         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;
+       }
+
+      /* Verify that procedures are either all SUBROUTINEs or all FUNCTIONs.  */
+      if ((psave->sym->attr.function && !p->sym->attr.function)
+         || (psave->sym->attr.subroutine && !p->sym->attr.subroutine))
+       {
+         gfc_error ("In %s at %L procedures must be either all SUBROUTINEs"
+                    " or all FUNCTIONs", interface_name, &p->sym->declared_at);
+         return 1;
+       }
+    }
   p = psave;
 
   /* Remove duplicate interfaces in this interface list.  */

diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c
index ea9667d4a6b2098f43864a0ad76143f9a50c1b4e..58d8b43065e0bcc62108977457685e18e60560c6 100644 (file)
--- a/gcc/fortran/parse.c
+++ b/gcc/fortran/parse.c
@@ -2263,32 +2263,16 @@ loop:
     }
 
 
-  /* Make sure that a generic interface has only subroutines or
-     functions and that the generic name has the right attribute.  */
-  if (current_interface.type == INTERFACE_GENERIC)
+  /* Make sure that the generic name has the right attribute.  */
+  if (current_interface.type == INTERFACE_GENERIC
+      && current_state == COMP_NONE)
     {
-      if (current_state == COMP_NONE)
-       {
-         if (new_state == COMP_FUNCTION && sym)
-           gfc_add_function (&sym->attr, sym->name, NULL);
-         else if (new_state == COMP_SUBROUTINE && sym)
-           gfc_add_subroutine (&sym->attr, sym->name, NULL);
-
-         current_state = new_state;
-       }
-      else
-       {
-         if (new_state != current_state)
-           {
-             if (new_state == COMP_SUBROUTINE)
-               gfc_error ("SUBROUTINE at %C does not belong in a "
-                          "generic function interface");
+      if (new_state == COMP_FUNCTION && sym)
+       gfc_add_function (&sym->attr, sym->name, NULL);
+      else if (new_state == COMP_SUBROUTINE && sym)
+       gfc_add_subroutine (&sym->attr, sym->name, NULL);
 
-             if (new_state == COMP_FUNCTION)
-               gfc_error ("FUNCTION at %C does not belong in a "
-                          "generic subroutine interface");
-           }
-       }
+      current_state = new_state;
     }
 
   if (current_interface.type == INTERFACE_ABSTRACT)

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 3c634409ce2c0077dda7ac65e1dcbb80974d3431..f6e442355cca4efabc885bb7f5cbb9d223c04866 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,9 @@
+2011-01-06  Daniel Franke  <franke.daniel@gmail.com>
+
+       PR fortran/33117
+       PR fortran/46478
+       * gfortran.dg/interface_33.f90: New test.
+
 2011-01-06  Jakub Jelinek  <jakub@redhat.com>
 
        PR c/47150

diff --git a/gcc/testsuite/gfortran.dg/interface_33.f90 b/gcc/testsuite/gfortran.dg/interface_33.f90
new file mode 100644 (file)
index 0000000..f1475b0
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/interface_33.f90
@@ -0,0 +1,36 @@
+! { dg-do "compile" }
+!
+! PR fortran/33117, PR fortran/46478
+! Procedures of a generic interface must be either
+! all SUBROUTINEs or all FUNCTIONs.
+!
+
+!
+! PR fortran/33117
+!
+module m1
+  interface gen
+    subroutine sub()            ! dg-error { "all SUBROUTINEs or all FUNCTIONs" }
+    end subroutine sub
+    function bar()
+      real :: bar
+    end function bar
+  end interface gen
+end module
+
+!
+! PR fortran/46478
+!
+MODULE m2
+  INTERFACE new_name
+    MODULE PROCEDURE func_name
+    MODULE PROCEDURE subr_name
+  END INTERFACE
+CONTAINS
+   LOGICAL FUNCTION func_name()  ! dg-error { "all SUBROUTINEs or all FUNCTIONs" }
+   END FUNCTION
+   SUBROUTINE subr_name()
+   END SUBROUTINE
+END MODULE
+
+! { dg-final { cleanup-modules "m1 m2" } }