[flang] Fix call to CHECK() on overriding an erroneous type-bound procedure

[PeteSteinfeld]

Summary

You can define a base type with a type-bound procedure which is erroneously
missing a NOPASS attribute and then define another type that extends the base
type and overrides the erroneous procedure. In this case, when we perform
semantic checking on the overriding procedure, we verify the "pass index" of
the overriding procedure. The attempt to get the procedure's pass index fails
a call to CHECK().

I fixed this by calling SetError() on the symbol of the overridden procedure in
the base type. Then, I check HasError() before executing the code that invokes
the failing call to CHECK(). I also added a test that will cause the compiler
to fail the call to CHECK() without this change.

flang/lib/Semantics/check-declarations.cpp

if (!passName) {
     if (dummyArgs.empty()) {
       messages_.Say(name,
           proc.has<ProcEntityDetails>()
               ? "Procedure component '%s' with no dummy arguments"
                 " must have NOPASS attribute"_err_en_US
               : "Procedure binding '%s' with no dummy arguments"
                 " must have NOPASS attribute"_err_en_US,
           name);
+      context_.SetError(*interface);
       return;
     }
     passName = dummyArgs[0]->name();
   }
   std::optional<int> passArgIndex{};
   for (std::size_t i{0}; i < dummyArgs.size(); ++i) {
     if (dummyArgs[i] && dummyArgs[i]->name() == *passName) {
       passArgIndex = i;
if (const auto *overriddenBinding{
         const auto *bindingChars{Characterize(binding.symbol())};
         const auto *overriddenChars{Characterize(overriddenBinding->symbol())};
         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);
             }
-          } else {
+          } 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)) {

flang/test/Semantics/bindings01.f90

module m1
   end type t
 
 contains
   subroutine mp(x)
     class(t),intent(in) :: x
   end subroutine
 end module m1
 
+module t2
+  type parent
+    real realField
+  contains
+    !ERROR: Procedure binding 'proc' with no dummy arguments must have NOPASS attribute
+    procedure proc
+  end type parent
+  type,extends(parent) :: child
+  contains
+    !ERROR: Procedure binding 'proc' with no dummy arguments must have NOPASS attribute
+    procedure proc
+  end type child
+contains
+  subroutine proc 
+  end subroutine
+end module t2
+
 program test
   use m1
   type,extends(t) :: t2
   end type
   type(t2) a
   call a%tbp
 end program