[flang] Finer error detection in separate module procedure case

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>;

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);
   }
 }
 

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