[flang] Better error message for RANK(NULL()) (#93577)

We currently complain that the argument may not be a procedure, which is
confusing. Distinguish the NULL() case from other error cases (which are
indeed procedures). And clean up the utility predicates used for these
tests -- the current IsProcedure() is really just a test for a procedure
designator.
This commit is contained in:
Peter Klausler 2024-06-03 12:58:39 -07:00 committed by GitHub
parent 13f6797826
commit c7593344f4
No known key found for this signature in database
GPG Key ID: B5690EEEBB952194
7 changed files with 29 additions and 10 deletions

View File

@ -1017,10 +1017,11 @@ bool IsAllocatableOrPointerObject(const Expr<SomeType> &);
bool IsAllocatableDesignator(const Expr<SomeType> &); bool IsAllocatableDesignator(const Expr<SomeType> &);
// Procedure and pointer detection predicates // Procedure and pointer detection predicates
bool IsProcedure(const Expr<SomeType> &); bool IsProcedureDesignator(const Expr<SomeType> &);
bool IsFunction(const Expr<SomeType> &); bool IsFunctionDesignator(const Expr<SomeType> &);
bool IsPointer(const Expr<SomeType> &); bool IsPointer(const Expr<SomeType> &);
bool IsProcedurePointer(const Expr<SomeType> &); bool IsProcedurePointer(const Expr<SomeType> &);
bool IsProcedure(const Expr<SomeType> &);
bool IsProcedurePointerTarget(const Expr<SomeType> &); bool IsProcedurePointerTarget(const Expr<SomeType> &);
bool IsBareNullPointer(const Expr<SomeType> *); // NULL() w/o MOLD= or type bool IsBareNullPointer(const Expr<SomeType> *); // NULL() w/o MOLD= or type
bool IsNullObjectPointer(const Expr<SomeType> &); bool IsNullObjectPointer(const Expr<SomeType> &);

View File

@ -1808,7 +1808,12 @@ std::optional<SpecificCall> IntrinsicInterface::Match(
continue; continue;
} else if (d.typePattern.kindCode == KindCode::nullPointerType) { } else if (d.typePattern.kindCode == KindCode::nullPointerType) {
continue; continue;
} else if (IsNullPointer(expr)) {
messages.Say(arg->sourceLocation(),
"Actual argument for '%s=' may not be NULL()"_err_en_US,
d.keyword);
} else { } else {
CHECK(IsProcedure(expr));
messages.Say(arg->sourceLocation(), messages.Say(arg->sourceLocation(),
"Actual argument for '%s=' may not be a procedure"_err_en_US, "Actual argument for '%s=' may not be a procedure"_err_en_US,
d.keyword); d.keyword);

View File

@ -818,10 +818,10 @@ bool IsCoarray(const Symbol &symbol) {
return GetAssociationRoot(symbol).Corank() > 0; return GetAssociationRoot(symbol).Corank() > 0;
} }
bool IsProcedure(const Expr<SomeType> &expr) { bool IsProcedureDesignator(const Expr<SomeType> &expr) {
return std::holds_alternative<ProcedureDesignator>(expr.u); return std::holds_alternative<ProcedureDesignator>(expr.u);
} }
bool IsFunction(const Expr<SomeType> &expr) { bool IsFunctionDesignator(const Expr<SomeType> &expr) {
const auto *designator{std::get_if<ProcedureDesignator>(&expr.u)}; const auto *designator{std::get_if<ProcedureDesignator>(&expr.u)};
return designator && designator->GetType().has_value(); return designator && designator->GetType().has_value();
} }
@ -847,6 +847,10 @@ bool IsProcedurePointer(const Expr<SomeType> &expr) {
} }
} }
bool IsProcedure(const Expr<SomeType> &expr) {
return IsProcedureDesignator(expr) || IsProcedurePointer(expr);
}
bool IsProcedurePointerTarget(const Expr<SomeType> &expr) { bool IsProcedurePointerTarget(const Expr<SomeType> &expr) {
return common::visit(common::visitors{ return common::visit(common::visitors{
[](const NullPointer &) { return true; }, [](const NullPointer &) { return true; },

View File

@ -3761,7 +3761,8 @@ private:
const Fortran::evaluate::Assignment::BoundsSpec &lbExprs) { const Fortran::evaluate::Assignment::BoundsSpec &lbExprs) {
Fortran::lower::StatementContext stmtCtx; Fortran::lower::StatementContext stmtCtx;
if (!lowerToHighLevelFIR() && Fortran::evaluate::IsProcedure(assign.rhs)) if (!lowerToHighLevelFIR() &&
Fortran::evaluate::IsProcedureDesignator(assign.rhs))
TODO(loc, "procedure pointer assignment"); TODO(loc, "procedure pointer assignment");
if (Fortran::evaluate::IsProcedurePointer(assign.lhs)) { if (Fortran::evaluate::IsProcedurePointer(assign.lhs)) {
hlfir::Entity lhs = Fortran::lower::convertExprToHLFIR( hlfir::Entity lhs = Fortran::lower::convertExprToHLFIR(

View File

@ -387,7 +387,7 @@ bool DataInitializationCompiler<DSV>::InitElement(
// nothing to do; rely on zero initialization // nothing to do; rely on zero initialization
return true; return true;
} else if (isProcPointer) { } else if (isProcPointer) {
if (evaluate::IsProcedure(*expr)) { if (evaluate::IsProcedureDesignator(*expr)) {
if (CheckPointerAssignment(exprAnalyzer_.context(), designator, *expr, if (CheckPointerAssignment(exprAnalyzer_.context(), designator, *expr,
scope, scope,
/*isBoundsRemapping=*/false, /*isAssumedRank=*/false)) { /*isBoundsRemapping=*/false, /*isAssumedRank=*/false)) {
@ -419,7 +419,7 @@ bool DataInitializationCompiler<DSV>::InitElement(
} else if (evaluate::IsNullPointer(*expr)) { } else if (evaluate::IsNullPointer(*expr)) {
exprAnalyzer_.Say("Initializer for '%s' must not be a pointer"_err_en_US, exprAnalyzer_.Say("Initializer for '%s' must not be a pointer"_err_en_US,
DescribeElement()); DescribeElement());
} else if (evaluate::IsProcedure(*expr)) { } else if (evaluate::IsProcedureDesignator(*expr)) {
exprAnalyzer_.Say("Initializer for '%s' must not be a procedure"_err_en_US, exprAnalyzer_.Say("Initializer for '%s' must not be a procedure"_err_en_US,
DescribeElement()); DescribeElement());
} else if (auto designatorType{designator.GetType()}) { } else if (auto designatorType{designator.GetType()}) {

View File

@ -4608,14 +4608,15 @@ std::optional<ActualArgument> ArgumentAnalyzer::AnalyzeExpr(
context_.SayAt(expr.source, context_.SayAt(expr.source,
"TYPE(*) dummy argument may only be used as an actual argument"_err_en_US); "TYPE(*) dummy argument may only be used as an actual argument"_err_en_US);
} else if (MaybeExpr argExpr{AnalyzeExprOrWholeAssumedSizeArray(expr)}) { } else if (MaybeExpr argExpr{AnalyzeExprOrWholeAssumedSizeArray(expr)}) {
if (isProcedureCall_ || !IsProcedure(*argExpr)) { if (isProcedureCall_ || !IsProcedureDesignator(*argExpr)) {
ActualArgument arg{std::move(*argExpr)}; ActualArgument arg{std::move(*argExpr)};
SetArgSourceLocation(arg, expr.source); SetArgSourceLocation(arg, expr.source);
return std::move(arg); return std::move(arg);
} }
context_.SayAt(expr.source, context_.SayAt(expr.source,
IsFunction(*argExpr) ? "Function call must have argument list"_err_en_US IsFunctionDesignator(*argExpr)
: "Subroutine name is not allowed here"_err_en_US); ? "Function call must have argument list"_err_en_US
: "Subroutine name is not allowed here"_err_en_US);
} }
return std::nullopt; return std::nullopt;
} }

View File

@ -153,3 +153,10 @@ subroutine s10
!ERROR: Actual argument for 'a=' may not be a procedure !ERROR: Actual argument for 'a=' may not be a procedure
print *, abs(a10) print *, abs(a10)
end 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