[flang-commits] [flang] b6b589c - [flang] An erroneous type bound procedure was causing a call to CHECK()

[Peter Steinfeld via flang-commits]

Author: Peter Steinfeld
Date: 2020-10-23T13:53:58-07:00
New Revision: b6b589ca84841f7ef4ac8c67570ec1e43b29aa76

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

LOG: [flang] An erroneous type bound procedure was causing a call to CHECK()

I added a test to verify that the associated symbol did not have errors before
doing the anaylsis of a call to a component ref along with a test that
triggers the original problem.

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

Added: 
    

Modified: 
    flang/lib/Semantics/expression.cpp
    flang/test/Semantics/bindings01.f90

Removed: 
    


################################################################################
diff  --git a/flang/lib/Semantics/expression.cpp b/flang/lib/Semantics/expression.cpp
index be4cd6ea5d24..21b76878c566 100644
--- a/flang/lib/Semantics/expression.cpp
+++ b/flang/lib/Semantics/expression.cpp
@@ -1700,6 +1700,9 @@ auto ExpressionAnalyzer::AnalyzeProcedureComponentRef(
   const parser::StructureComponent &sc{pcr.v.thing};
   if (MaybeExpr base{Analyze(sc.base)}) {
     if (const Symbol * sym{sc.component.symbol}) {
+      if (context_.HasError(sym)) {
+        return std::nullopt;
+      }
       if (auto *dtExpr{UnwrapExpr<Expr<SomeDerived>>(*base)}) {
         if (sym->has<semantics::GenericDetails>()) {
           AdjustActuals adjustment{

diff  --git a/flang/test/Semantics/bindings01.f90 b/flang/test/Semantics/bindings01.f90
index f2d5876167c2..210530b5af26 100644
--- a/flang/test/Semantics/bindings01.f90
+++ b/flang/test/Semantics/bindings01.f90
@@ -114,3 +114,28 @@ subroutine s7(x)
   end subroutine s7
 end module
 
+module m1
+  implicit none
+  interface g
+    module procedure mp
+  end interface g
+
+  type t
+  contains
+    !ERROR: The binding of 'tbp' ('g') must be either an accessible module procedure or an external procedure with an explicit interface
+    procedure,pass(x) :: tbp => g
+  end type t
+
+contains
+  subroutine mp(x)
+    class(t),intent(in) :: x
+  end subroutine
+end module m1
+
+program test
+  use m1
+  type,extends(t) :: t2
+  end type
+  type(t2) a
+  call a%tbp
+end program