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

[Peter Steinfeld via flang-commits]

Author: Peter Steinfeld
Date: 2021-03-10T09:38:29-08:00
New Revision: 40e261803bd40099ee2f322670157b0b57d7bf3e

URL: https://github.com/llvm/llvm-project/commit/40e261803bd40099ee2f322670157b0b57d7bf3e
DIFF: https://github.com/llvm/llvm-project/commit/40e261803bd40099ee2f322670157b0b57d7bf3e.diff

LOG: [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

Added: 
    

Modified: 
    flang/lib/Semantics/check-declarations.cpp
    flang/test/Semantics/bindings01.f90

Removed: 
    


################################################################################
diff  --git a/flang/lib/Semantics/check-declarations.cpp b/flang/lib/Semantics/check-declarations.cpp
index cd35047681e3..bd92a3778a94 100644
--- a/flang/lib/Semantics/check-declarations.cpp
+++ b/flang/lib/Semantics/check-declarations.cpp
@@ -1356,6 +1356,7 @@ void CheckHelper::CheckPassArg(
               : "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 @@ void CheckHelper::CheckProcBinding(
               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())};

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