diff --git a/flang/include/flang/Evaluate/tools.h b/flang/include/flang/Evaluate/tools.h index cb750d5e82d8c..378a5fca03264 100644 --- a/flang/include/flang/Evaluate/tools.h +++ b/flang/include/flang/Evaluate/tools.h @@ -1017,10 +1017,11 @@ bool IsAllocatableOrPointerObject(const Expr &); bool IsAllocatableDesignator(const Expr &); // Procedure and pointer detection predicates -bool IsProcedure(const Expr &); -bool IsFunction(const Expr &); +bool IsProcedureDesignator(const Expr &); +bool IsFunctionDesignator(const Expr &); bool IsPointer(const Expr &); bool IsProcedurePointer(const Expr &); +bool IsProcedure(const Expr &); bool IsProcedurePointerTarget(const Expr &); bool IsBareNullPointer(const Expr *); // NULL() w/o MOLD= or type bool IsNullObjectPointer(const Expr &); diff --git a/flang/lib/Evaluate/intrinsics.cpp b/flang/lib/Evaluate/intrinsics.cpp index ded277877f49d..b4153ffc40c6b 100644 --- a/flang/lib/Evaluate/intrinsics.cpp +++ b/flang/lib/Evaluate/intrinsics.cpp @@ -1808,7 +1808,12 @@ std::optional IntrinsicInterface::Match( continue; } else if (d.typePattern.kindCode == KindCode::nullPointerType) { continue; + } else if (IsNullPointer(expr)) { + messages.Say(arg->sourceLocation(), + "Actual argument for '%s=' may not be NULL()"_err_en_US, + d.keyword); } else { + CHECK(IsProcedure(expr)); messages.Say(arg->sourceLocation(), "Actual argument for '%s=' may not be a procedure"_err_en_US, d.keyword); diff --git a/flang/lib/Evaluate/tools.cpp b/flang/lib/Evaluate/tools.cpp index 826b97b87bf3f..4699c5312868c 100644 --- a/flang/lib/Evaluate/tools.cpp +++ b/flang/lib/Evaluate/tools.cpp @@ -818,10 +818,10 @@ bool IsCoarray(const Symbol &symbol) { return GetAssociationRoot(symbol).Corank() > 0; } -bool IsProcedure(const Expr &expr) { +bool IsProcedureDesignator(const Expr &expr) { return std::holds_alternative(expr.u); } -bool IsFunction(const Expr &expr) { +bool IsFunctionDesignator(const Expr &expr) { const auto *designator{std::get_if(&expr.u)}; return designator && designator->GetType().has_value(); } @@ -847,6 +847,10 @@ bool IsProcedurePointer(const Expr &expr) { } } +bool IsProcedure(const Expr &expr) { + return IsProcedureDesignator(expr) || IsProcedurePointer(expr); +} + bool IsProcedurePointerTarget(const Expr &expr) { return common::visit(common::visitors{ [](const NullPointer &) { return true; }, diff --git a/flang/lib/Lower/Bridge.cpp b/flang/lib/Lower/Bridge.cpp index 898b37504a6e6..898f189cb2692 100644 --- a/flang/lib/Lower/Bridge.cpp +++ b/flang/lib/Lower/Bridge.cpp @@ -3568,7 +3568,8 @@ class FirConverter : public Fortran::lower::AbstractConverter { const Fortran::evaluate::Assignment::BoundsSpec &lbExprs) { Fortran::lower::StatementContext stmtCtx; - if (!lowerToHighLevelFIR() && Fortran::evaluate::IsProcedure(assign.rhs)) + if (!lowerToHighLevelFIR() && + Fortran::evaluate::IsProcedureDesignator(assign.rhs)) TODO(loc, "procedure pointer assignment"); if (Fortran::evaluate::IsProcedurePointer(assign.lhs)) { hlfir::Entity lhs = Fortran::lower::convertExprToHLFIR( diff --git a/flang/lib/Semantics/data-to-inits.cpp b/flang/lib/Semantics/data-to-inits.cpp index 605a9f10712e7..b6dbbbf63138e 100644 --- a/flang/lib/Semantics/data-to-inits.cpp +++ b/flang/lib/Semantics/data-to-inits.cpp @@ -387,7 +387,7 @@ bool DataInitializationCompiler::InitElement( // nothing to do; rely on zero initialization return true; } else if (isProcPointer) { - if (evaluate::IsProcedure(*expr)) { + if (evaluate::IsProcedureDesignator(*expr)) { if (CheckPointerAssignment(exprAnalyzer_.context(), designator, *expr, scope, /*isBoundsRemapping=*/false, /*isAssumedRank=*/false)) { @@ -419,7 +419,7 @@ bool DataInitializationCompiler::InitElement( } else if (evaluate::IsNullPointer(*expr)) { exprAnalyzer_.Say("Initializer for '%s' must not be a pointer"_err_en_US, DescribeElement()); - } else if (evaluate::IsProcedure(*expr)) { + } else if (evaluate::IsProcedureDesignator(*expr)) { exprAnalyzer_.Say("Initializer for '%s' must not be a procedure"_err_en_US, DescribeElement()); } else if (auto designatorType{designator.GetType()}) { diff --git a/flang/lib/Semantics/expression.cpp b/flang/lib/Semantics/expression.cpp index 50e2b41212d7d..470d7bfdc00a0 100644 --- a/flang/lib/Semantics/expression.cpp +++ b/flang/lib/Semantics/expression.cpp @@ -4608,14 +4608,15 @@ std::optional ArgumentAnalyzer::AnalyzeExpr( context_.SayAt(expr.source, "TYPE(*) dummy argument may only be used as an actual argument"_err_en_US); } else if (MaybeExpr argExpr{AnalyzeExprOrWholeAssumedSizeArray(expr)}) { - if (isProcedureCall_ || !IsProcedure(*argExpr)) { + if (isProcedureCall_ || !IsProcedureDesignator(*argExpr)) { ActualArgument arg{std::move(*argExpr)}; SetArgSourceLocation(arg, expr.source); return std::move(arg); } context_.SayAt(expr.source, - IsFunction(*argExpr) ? "Function call must have argument list"_err_en_US - : "Subroutine name is not allowed here"_err_en_US); + IsFunctionDesignator(*argExpr) + ? "Function call must have argument list"_err_en_US + : "Subroutine name is not allowed here"_err_en_US); } return std::nullopt; } diff --git a/flang/test/Semantics/resolve09.f90 b/flang/test/Semantics/resolve09.f90 index 634b9861f3b67..485526a733e4b 100644 --- a/flang/test/Semantics/resolve09.f90 +++ b/flang/test/Semantics/resolve09.f90 @@ -153,3 +153,10 @@ subroutine s10 !ERROR: Actual argument for 'a=' may not be a procedure print *, abs(a10) end + +subroutine s11 + real, pointer :: p(:) + !ERROR: Actual argument for 'a=' may not be NULL() + print *, rank(null()) + print *, rank(null(mold=p)) ! ok +end