commit eb2d3c0fbde4d76186f0bb3c053854a944e067ce
author Peter Steinfeld <psteinfeld@nvidia.com> Wed Mar 10 08:09:57 2021 -0800
committer Copybara-Service <copybara-worker@google.com> Thu Mar 18 00:18:16 2021 -0700
tree d4e112dc8e6cd7c103b9b0f2a39d4a6a1ae2d9ab
parent 351c0def17e3527fa082adce4b7f7e9c31acce4b

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

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.

Differential Revision: https://reviews.llvm.org/D98355

GitOrigin-RevId: 40e261803bd40099ee2f322670157b0b57d7bf3e

lib/Semantics/check-declarations.cpp

diff --git a/lib/Semantics/check-declarations.cpp b/lib/Semantics/check-declarations.cpp
index cd35047..bd92a37 100644
--- a/lib/Semantics/check-declarations.cpp
+++ b/lib/Semantics/check-declarations.cpp
@@ -1356,6 +1356,7 @@
               : "Procedure binding '%s' with no dummy arguments"
                 " must have NOPASS attribute"_err_en_US,
           name);
+      context_.SetError(*interface);
       return;
     }
     passName = dummyArgs[0]->name();
@@ -1480,7 +1481,7 @@
               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())};

test/Semantics/bindings01.f90

diff --git a/test/Semantics/bindings01.f90 b/test/Semantics/bindings01.f90
index 210530b..8a1e656 100644
--- a/test/Semantics/bindings01.f90
+++ b/test/Semantics/bindings01.f90
@@ -132,6 +132,23 @@
   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