diff --git a/flang/include/flang/Common/Fortran-features.h b/flang/include/flang/Common/Fortran-features.h index f813cbae40a57..3942a79262864 100644 --- a/flang/include/flang/Common/Fortran-features.h +++ b/flang/include/flang/Common/Fortran-features.h @@ -72,7 +72,8 @@ ENUM_CLASS(UsageWarning, Portability, PointerToUndefinable, IgnoredIntrinsicFunctionType, PreviousScalarUse, RedeclaredInaccessibleComponent, ImplicitShared, IndexVarRedefinition, IncompatibleImplicitInterfaces, BadTypeForTarget, - VectorSubscriptFinalization, UndefinedFunctionResult, UselessIomsg) + VectorSubscriptFinalization, UndefinedFunctionResult, UselessIomsg, + MismatchingDummyProcedure) using LanguageFeatures = EnumSet; using UsageWarnings = EnumSet; diff --git a/flang/lib/Semantics/check-declarations.cpp b/flang/lib/Semantics/check-declarations.cpp index 7778561fb5bd3..f8e873008ceab 100644 --- a/flang/lib/Semantics/check-declarations.cpp +++ b/flang/lib/Semantics/check-declarations.cpp @@ -3765,12 +3765,20 @@ void SubprogramMatchHelper::CheckDummyDataObject(const Symbol &symbol1, void SubprogramMatchHelper::CheckDummyProcedure(const Symbol &symbol1, const Symbol &symbol2, const DummyProcedure &proc1, const DummyProcedure &proc2) { + std::string whyNot; if (!CheckSameIntent(symbol1, symbol2, proc1.intent, proc2.intent)) { } else if (!CheckSameAttrs(symbol1, symbol2, proc1.attrs, proc2.attrs)) { - } else if (proc1 != proc2) { + } else if (!proc2.IsCompatibleWith(proc1, &whyNot)) { Say(symbol1, symbol2, - "Dummy procedure '%s' does not match the corresponding argument in" - " the interface body"_err_en_US); + "Dummy procedure '%s' is not compatible with the corresponding argument in the interface body: %s"_err_en_US, + whyNot); + } else if (proc1 != proc2) { + evaluate::AttachDeclaration( + symbol1.owner().context().Warn( + common::UsageWarning::MismatchingDummyProcedure, + "Dummy procedure '%s' does not exactly match the corresponding argument in the interface body"_warn_en_US, + symbol1.name()), + symbol2); } } diff --git a/flang/test/Semantics/separate-mp02.f90 b/flang/test/Semantics/separate-mp02.f90 index c63ab6f41a132..cb1e2687bad73 100644 --- a/flang/test/Semantics/separate-mp02.f90 +++ b/flang/test/Semantics/separate-mp02.f90 @@ -1,4 +1,4 @@ -! RUN: %python %S/test_errors.py %s %flang_fc1 +! RUN: %python %S/test_errors.py %s %flang_fc1 -pedantic ! When a module subprogram has the MODULE prefix the following must match ! with the corresponding separate module procedure interface body: @@ -238,7 +238,7 @@ module subroutine s1(x) procedure(s_real2) :: x end module subroutine s2(x) - !ERROR: Dummy procedure 'x' does not match the corresponding argument in the interface body + !ERROR: Dummy procedure 'x' is not compatible with the corresponding argument in the interface body: incompatible dummy procedure interfaces: incompatible dummy argument #1: incompatible dummy data object types: INTEGER(4) vs REAL(4) procedure(s_integer) :: x end end @@ -357,3 +357,19 @@ module character(2) function f() module character(3) function f() end function end submodule + +module m11 + interface + module subroutine s(x) + ! The subroutine/function distinction is not known. + external x + end + end interface +end +submodule(m11) sm11 + contains + !WARNING: Dummy procedure 'x' does not exactly match the corresponding argument in the interface body + module subroutine s(x) + call x ! no error + end +end