diff --git a/flang/docs/Extensions.md b/flang/docs/Extensions.md --- a/flang/docs/Extensions.md +++ b/flang/docs/Extensions.md @@ -440,3 +440,34 @@ The precedent among the most commonly used compilers agrees with f18's interpretation: a `DATA` statement without any other specification of the name refers to the host-associated object. + +* Many Fortran compilers allow a non-generic procedure to be `USE`-associated + into a scope that also contains a generic interface of the same name + but does not have the `USE`-associated non-generic procedure as a + specific procedure. +``` +module m1 + contains + subroutine foo(n) + integer, intent(in) :: n + end subroutine +end module + +module m2 + use m1, only: foo + interface foo + module procedure noargs + end interface + contains + subroutine noargs + end subroutine +end module +``` + + This case elicits a warning from f18, as it should not be treated + any differently than the same case with the non-generic procedure of + the same name being defined in the same scope rather than being + `USE`-associated into it, which is explicitly non-conforming in the + standard and not allowed by most other compilers. + If the `USE`-associated entity of the same name is not a procedure, + most compilers disallow it as well. diff --git a/flang/lib/Semantics/resolve-names.cpp b/flang/lib/Semantics/resolve-names.cpp --- a/flang/lib/Semantics/resolve-names.cpp +++ b/flang/lib/Semantics/resolve-names.cpp @@ -3196,8 +3196,8 @@ auto &details{generic.get()}; if (auto *proc{details.CheckSpecific()}) { auto msg{ - "'%s' may not be the name of both a generic interface and a" - " procedure unless it is a specific procedure of the generic"_err_en_US}; + "'%s' should not be the name of both a generic interface and a" + " procedure unless it is a specific procedure of the generic"_warn_en_US}; if (proc->name().begin() > generic.name().begin()) { Say(proc->name(), std::move(msg)); } else { diff --git a/flang/test/Semantics/resolve17.f90 b/flang/test/Semantics/resolve17.f90 --- a/flang/test/Semantics/resolve17.f90 +++ b/flang/test/Semantics/resolve17.f90 @@ -11,7 +11,7 @@ interface s end interface contains - !ERROR: 's' may not be the name of both a generic interface and a procedure unless it is a specific procedure of the generic + !WARNING: 's' should not be the name of both a generic interface and a procedure unless it is a specific procedure of the generic subroutine s end subroutine end module diff --git a/flang/test/Semantics/resolve18.f90 b/flang/test/Semantics/resolve18.f90 --- a/flang/test/Semantics/resolve18.f90 +++ b/flang/test/Semantics/resolve18.f90 @@ -11,7 +11,7 @@ module m2 use m1 implicit none - !ERROR: 'foo' may not be the name of both a generic interface and a procedure unless it is a specific procedure of the generic + !WARNING: 'foo' should not be the name of both a generic interface and a procedure unless it is a specific procedure of the generic interface foo module procedure s end interface