[flang] Finer error detection in separate module procedure case (#110912)

When a separate module procedure has a dummy procedure argument that is
simply declared EXTERNAL in its interface but is actually called as a
subroutine or function in its definition, the compiler is emitting an
error message. This is too strong; an error is appropriate only when the
dummy procedure in the definition has an interface that is incompatible
with the one in the interface definition.

However, this is not a safe coding practice, and can lead to trouble
during execution if a function is passed as an actual argument but
called as a subroutine in the procedure (or the other way around), so
add a warning message as well for this case (off by default).

Fixes https://github.com/llvm/llvm-project/issues/110797.

3 files changed, 31 insertions, 6 deletions

diff --git a/flang/include/flang/Common/Fortran-features.h b/flang/include/flang/Common/Fortran-features.h
index f813cba..3942a79 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<LanguageFeature, LanguageFeature_enumSize>;
 using UsageWarnings = EnumSet<UsageWarning, UsageWarning_enumSize>;
diff --git a/flang/lib/Semantics/check-declarations.cpp b/flang/lib/Semantics/check-declarations.cpp
index 7778561..f8e8730 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 c63ab6f..cb1e268 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 @@ contains
     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 @@ submodule(m10) sm10
   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