diff --git a/flang/lib/Semantics/check-select-type.cpp b/flang/lib/Semantics/check-select-type.cpp --- a/flang/lib/Semantics/check-select-type.cpp +++ b/flang/lib/Semantics/check-select-type.cpp @@ -254,16 +254,16 @@ std::get>(construct.t)}; const auto &selectType{selectTypeStmt.statement}; const auto &unResolvedSel{std::get(selectType.t)}; - const auto *selector{GetExprFromSelector(unResolvedSel)}; - - if (!selector) { - return; // expression semantics failed on Selector - } - if (auto exprType{selector->GetType()}) { - const auto &typeCaseList{ - std::get>( - construct.t)}; - TypeCaseValues{context_, *exprType}.Check(typeCaseList); + if (const auto *selector{GetExprFromSelector(unResolvedSel)}) { + if (IsProcedure(*selector)) { + context_.Say( + selectTypeStmt.source, "Selector may not be a procedure"_err_en_US); + } else if (auto exprType{selector->GetType()}) { + const auto &typeCaseList{ + std::get>( + construct.t)}; + TypeCaseValues{context_, *exprType}.Check(typeCaseList); + } } } diff --git a/flang/test/Semantics/selecttype01.f90 b/flang/test/Semantics/selecttype01.f90 --- a/flang/test/Semantics/selecttype01.f90 +++ b/flang/test/Semantics/selecttype01.f90 @@ -277,3 +277,14 @@ print *, "default" end select end + +subroutine CheckNotProcedure + use m1 + !ERROR: Selector may not be a procedure + select type (x=>f) + end select + contains + function f() result(res) + class(shape), allocatable :: res + end +end