[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:
parent
13f6797826
commit
c7593344f4
@ -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> &);
|
||||||
|
@ -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);
|
||||||
|
@ -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; },
|
||||||
|
@ -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(
|
||||||
|
@ -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()}) {
|
||||||
|
@ -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;
|
||||||
}
|
}
|
||||||
|
@ -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
|
||||||
|
Loading…
x
Reference in New Issue
Block a user