+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
/* 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)
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. */
}
- /* 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)
+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
--- /dev/null
+! { 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" } }