[flang] Stricter interface compatibility checking for TBP overrides

[klausler]

Summary

The compiler currently ignores attributes for PASS dummy arguments that
are incompatible between a type-bound procedure in an extended type and
the binding of the same name that it overrides in an ancestor type,
if any. Strengthen this checking so that discrepancies between attributes
and intents are caught, and add some tests.

[PeteSteinfeld]

All builds and tests correctly and looks good.

flang/lib/Evaluate/characteristics.cpp

if ((that.attrs.test(Attr::Pure) && !attrs.test(Attr::Pure)) ||
       functionResult != that.functionResult) {
     return false;
   }
   int argCount{static_cast<int>(dummyArguments.size())};
   if (argCount != static_cast<int>(that.dummyArguments.size())) {
     return false;
   }
   for (int j{0}; j < argCount; ++j) {
-    if ((!passIndex || j != *passIndex) &&
-        dummyArguments[j] != that.dummyArguments[j]) {
+    if (passIndex && j == *passIndex) {
+      if (!that.dummyArguments[j].IsCompatibleWith(dummyArguments[j])) {
+        return false;
+      }
+    } else if (dummyArguments[j] != that.dummyArguments[j]) {
       return false;
     }
   }
   return true;
 }
 
 std::optional<Procedure> Procedure::Characterize(
     const semantics::Symbol &original, FoldingContext &context) {

flang/lib/Semantics/check-declarations.cpp

if (const auto *overriddenBinding{
                 : "A passed-argument type-bound procedure may not override a NOPASS procedure"_err_en_US);
       } else {
         const auto *bindingChars{Characterize(binding.symbol())};
         const auto *overriddenChars{Characterize(*overridden)};
         if (bindingChars && overriddenChars) {
           if (isNopass) {
             if (!bindingChars->CanOverride(*overriddenChars, std::nullopt)) {
               SayWithDeclaration(*overridden,
-                  "A type-bound procedure and its override must have compatible interfaces"_err_en_US);
+                  "A NOPASS type-bound procedure and its override must have identical interfaces"_err_en_US);
             }
           } else if (!context_.HasError(binding.symbol())) {
             int passIndex{bindingChars->FindPassIndex(binding.passName())};
             int overriddenPassIndex{
                 overriddenChars->FindPassIndex(overriddenBinding->passName())};
             if (passIndex != overriddenPassIndex) {
               SayWithDeclaration(*overridden,
                   "A type-bound procedure and its override must use the same PASS argument"_err_en_US);
             } else if (!bindingChars->CanOverride(
                            *overriddenChars, passIndex)) {
               SayWithDeclaration(*overridden,
-                  "A type-bound procedure and its override must have compatible interfaces apart from their passed argument"_err_en_US);
+                  "A type-bound procedure and its override must have compatible interfaces"_err_en_US);
             }
           }
         }
       }
       if (symbol.attrs().test(Attr::PRIVATE)) {
         if (FindModuleContaining(dtScope) ==
             FindModuleContaining(overridden->owner())) {
           // types declared in same madule

flang/test/Semantics/bindings04.f90

+! RUN: %python %S/test_errors.py %s %flang_fc1
+module m1
+  type t1
+   contains
+    procedure :: tbp => s1
+  end type
+  type, extends(t1) :: t1e
+   contains
+    !ERROR: A type-bound procedure and its override must have compatible interfaces
+    procedure :: tbp => s1e
+  end type
+ contains
+  subroutine s1(x)
+    class(t1) :: x
+  end
+  subroutine s1e(x)
+    class(t1e), intent(in out) :: x
+  end
+end
+
+module m2
+  type t1
+   contains
+    procedure :: tbp => s1
+  end type
+  type, extends(t1) :: t1e
+   contains
+    !ERROR: A type-bound procedure and its override must have compatible interfaces
+    procedure :: tbp => s1e
+  end type
+ contains
+  subroutine s1(x)
+    class(t1), intent(in out) :: x
+  end
+  subroutine s1e(x)
+    class(t1e) :: x
+  end
+end
+
+module m3
+  type t1
+   contains
+    procedure, nopass :: tbp => s1
+  end type
+  type, extends(t1) :: t1e
+   contains
+   !ERROR: A NOPASS type-bound procedure and its override must have identical interfaces
+    procedure, nopass :: tbp => s1e
+  end type
+ contains
+  subroutine s1(x)
+    real, intent(in out) :: x
+  end
+  subroutine s1e(x)
+    real :: x
+  end
+end