Skip to content

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

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
merged 1 commit into from
Jun 3, 2024
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
5 changes: 3 additions & 2 deletions flang/include/flang/Evaluate/tools.h
Original file line number Diff line number Diff line change
Expand Up @@ -1017,10 +1017,11 @@ bool IsAllocatableOrPointerObject(const Expr<SomeType> &);
bool IsAllocatableDesignator(const Expr<SomeType> &);

// Procedure and pointer detection predicates
bool IsProcedure(const Expr<SomeType> &);
bool IsFunction(const Expr<SomeType> &);
bool IsProcedureDesignator(const Expr<SomeType> &);
bool IsFunctionDesignator(const Expr<SomeType> &);
bool IsPointer(const Expr<SomeType> &);
bool IsProcedurePointer(const Expr<SomeType> &);
bool IsProcedure(const Expr<SomeType> &);
bool IsProcedurePointerTarget(const Expr<SomeType> &);
bool IsBareNullPointer(const Expr<SomeType> *); // NULL() w/o MOLD= or type
bool IsNullObjectPointer(const Expr<SomeType> &);
Expand Down
5 changes: 5 additions & 0 deletions flang/lib/Evaluate/intrinsics.cpp
Original file line number Diff line number Diff line change
Expand Up @@ -1808,7 +1808,12 @@ std::optional<SpecificCall> 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);
Expand Down
8 changes: 6 additions & 2 deletions flang/lib/Evaluate/tools.cpp
Original file line number Diff line number Diff line change
Expand Up @@ -818,10 +818,10 @@ bool IsCoarray(const Symbol &symbol) {
return GetAssociationRoot(symbol).Corank() > 0;
}

bool IsProcedure(const Expr<SomeType> &expr) {
bool IsProcedureDesignator(const Expr<SomeType> &expr) {
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)};
return designator && designator->GetType().has_value();
}
Expand All @@ -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) {
return common::visit(common::visitors{
[](const NullPointer &) { return true; },
Expand Down
3 changes: 2 additions & 1 deletion flang/lib/Lower/Bridge.cpp
Original file line number Diff line number Diff line change
Expand Up @@ -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(
Expand Down
4 changes: 2 additions & 2 deletions flang/lib/Semantics/data-to-inits.cpp
Original file line number Diff line number Diff line change
Expand Up @@ -387,7 +387,7 @@ bool DataInitializationCompiler<DSV>::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)) {
Expand Down Expand Up @@ -419,7 +419,7 @@ bool DataInitializationCompiler<DSV>::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()}) {
Expand Down
7 changes: 4 additions & 3 deletions flang/lib/Semantics/expression.cpp
Original file line number Diff line number Diff line change
Expand Up @@ -4608,14 +4608,15 @@ std::optional<ActualArgument> 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;
}
Expand Down
7 changes: 7 additions & 0 deletions flang/test/Semantics/resolve09.f90
Original file line number Diff line number Diff line change
Expand Up @@ -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
Loading