Index: flang/lib/Semantics/check-call.cpp =================================================================== --- flang/lib/Semantics/check-call.cpp +++ flang/lib/Semantics/check-call.cpp @@ -77,13 +77,21 @@ "actual argument", *expr, context)}) { const auto *argProcDesignator{ std::get_if(&expr->u)}; - const auto *argProcSymbol{ - argProcDesignator ? argProcDesignator->GetSymbol() : nullptr}; - if (argProcSymbol && !argChars->IsTypelessIntrinsicDummy() && - argProcDesignator && argProcDesignator->IsElemental()) { // C1533 - evaluate::SayWithDeclaration(messages, *argProcSymbol, - "Non-intrinsic ELEMENTAL procedure '%s' may not be passed as an actual argument"_err_en_US, - argProcSymbol->name()); + if (const auto *argProcSymbol{ + argProcDesignator ? argProcDesignator->GetSymbol() : nullptr}) { + if (!argChars->IsTypelessIntrinsicDummy() && argProcDesignator && + argProcDesignator->IsElemental()) { // C1533 + evaluate::SayWithDeclaration(messages, *argProcSymbol, + "Non-intrinsic ELEMENTAL procedure '%s' may not be passed as an actual argument"_err_en_US, + argProcSymbol->name()); + } else if (const auto *subp{argProcSymbol->GetUltimate() + .detailsIf()}) { + if (subp->stmtFunction()) { + evaluate::SayWithDeclaration(messages, *argProcSymbol, + "Statement function '%s' may not be passed as an actual argument"_err_en_US, + argProcSymbol->name()); + } + } } } } @@ -574,6 +582,17 @@ std::get_if(&expr->u)}; const auto *argProcSymbol{ argProcDesignator ? argProcDesignator->GetSymbol() : nullptr}; + if (argProcSymbol) { + if (const auto *subp{ + argProcSymbol->GetUltimate().detailsIf()}) { + if (subp->stmtFunction()) { + evaluate::SayWithDeclaration(messages, *argProcSymbol, + "Statement function '%s' may not be passed as an actual argument"_err_en_US, + argProcSymbol->name()); + return; + } + } + } if (auto argChars{characteristics::DummyArgument::FromActual( "actual argument", *expr, context)}) { if (!argChars->IsTypelessIntrinsicDummy()) { Index: flang/lib/Semantics/pointer-assignment.cpp =================================================================== --- flang/lib/Semantics/pointer-assignment.cpp +++ flang/lib/Semantics/pointer-assignment.cpp @@ -279,6 +279,17 @@ } bool PointerAssignmentChecker::Check(const evaluate::ProcedureDesignator &d) { + if (const Symbol * symbol{d.GetSymbol()}) { + if (const auto *subp{ + symbol->GetUltimate().detailsIf()}) { + if (subp->stmtFunction()) { + evaluate::SayWithDeclaration(context_.messages(), *symbol, + "Statement function '%s' may not be the target of a pointer assignment"_err_en_US, + symbol->name()); + return false; + } + } + } if (auto chars{Procedure::Characterize(d, context_)}) { return Check(d.GetName(), false, &*chars, d.GetSpecificIntrinsic()); } else { Index: flang/test/Semantics/assign03.f90 =================================================================== --- flang/test/Semantics/assign03.f90 +++ flang/test/Semantics/assign03.f90 @@ -314,4 +314,11 @@ ptr => s_external call ptr end subroutine + + subroutine s14 + procedure(real), pointer :: ptr + sf(x) = x + 1. + !ERROR: Statement function 'sf' may not be the target of a pointer assignment + ptr => sf + end subroutine end Index: flang/test/Semantics/call02.f90 =================================================================== --- flang/test/Semantics/call02.f90 +++ flang/test/Semantics/call02.f90 @@ -43,6 +43,19 @@ end function end +subroutine s03 + interface + subroutine sub1(p) + procedure(real) :: p + end subroutine + end interface + sf(x) = x + 1. + !ERROR: Statement function 'sf' may not be passed as an actual argument + call sub1(sf) + !ERROR: Statement function 'sf' may not be passed as an actual argument + call sub2(sf) +end + module m01 procedure(sin) :: elem01 interface