Index: gcc/fortran/decl.c =================================================================== --- gcc/fortran/decl.c (revision 258727) +++ gcc/fortran/decl.c (working copy) @@ -1245,16 +1245,27 @@ get_proc_name (const char *name, gfc_symbol **result, "from a previous declaration", name); } - if (sym && !sym->gfc_new - && sym->attr.flavor != FL_UNKNOWN - && sym->attr.referenced == 0 && sym->attr.subroutine == 1 - && gfc_state_stack->state == COMP_CONTAINS - && gfc_state_stack->previous->state == COMP_SUBROUTINE) - { - gfc_error_now ("Procedure %qs at %C is already defined at %L", - name, &sym->declared_at); - } + /* C1246 (R1225) MODULE shall appear only in the function-stmt or + subroutine-stmt of a module subprogram or of a nonabstract interface + body that is declared in the scoping unit of a module or submodule. */ + if (sym->attr.external + && (sym->attr.subroutine || sym->attr.function) + && sym->attr.if_source == IFSRC_IFBODY + && !current_attr.module_procedure + && sym->attr.proc == PROC_MODULE + && gfc_state_stack->state == COMP_CONTAINS) + gfc_error_now ("Procedure %qs defined in interface body at %L " + "clashes with internal procedure defined at %C", + name, &sym->declared_at); + if (sym && !sym->gfc_new + && sym->attr.flavor != FL_UNKNOWN + && sym->attr.referenced == 0 && sym->attr.subroutine == 1 + && gfc_state_stack->state == COMP_CONTAINS + && gfc_state_stack->previous->state == COMP_SUBROUTINE) + gfc_error_now ("Procedure %qs at %C is already defined at %L", + name, &sym->declared_at); + if (gfc_current_ns->parent == NULL || *result == NULL) return rc; Index: gcc/testsuite/gfortran.dg/interface_42.f90 =================================================================== --- gcc/testsuite/gfortran.dg/interface_42.f90 (nonexistent) +++ gcc/testsuite/gfortran.dg/interface_42.f90 (working copy) @@ -0,0 +1,24 @@ +! { dg-do compile } +! { dg-options "-fmax-errors=1" } +! PR fortran/84922 +! Code contributed by William Clodius, but simplified by me. +module copy + + interface + module subroutine foo_da(da, copy) ! { dg-error "(1)" } + integer, intent(in) :: da(:) + integer, allocatable, intent(out) :: copy(:) + end subroutine foo_da + end interface + + contains + + subroutine foo_da(da, copy) ! { dg-error "defined in interface body" } + integer, intent(in) :: da(:) + integer, allocatable, intent(out) :: copy(:) + allocate( copy( size(da) ) ) + copy = da + end subroutine foo_da + +end module copy +{ dg-prune-output "compilation terminated" } Index: gcc/testsuite/gfortran.dg/interface_43.f90 =================================================================== --- gcc/testsuite/gfortran.dg/interface_43.f90 (nonexistent) +++ gcc/testsuite/gfortran.dg/interface_43.f90 (working copy) @@ -0,0 +1,25 @@ +! { dg-do compile } +! PR fortran/84922 +! This should compile without error. +module foom + + implicit none + + interface foo + module procedure foo_sngl + module procedure foo_dble + end interface foo + + contains + + subroutine foo_sngl(n, f, g, h) + integer n + real f, g, h + end subroutine foo_sngl + + subroutine foo_dble(n, f, g, h) + integer n + double precision f, g, h + end subroutine foo_dble + +end module foom