maxjhandsome
/
llvm-project
forked from OSchip/llvm-project
1
0
Fork 0
Code Issues Pull Requests Packages Releases Wiki Activity

[flang] More precise checks for NULL() operands 

Improve checking for NULL() and NULL(MOLD=) when used as
variables and expressions outside the few contexts where
a disassociated pointer can be valid.  There were both
inappropriate errors and missing checks.

Differential Revision: https://reviews.llvm.org/D109905
This commit is contained in:
peter klausler 2021-09-07 12:17:31 -07:00
parent 0e36288318
commit d9195d6603
6 changed files with 288 additions and 167 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
flang/include/flang/Evaluate/expression.h
View File

@ -847,6 +847,8 @@ struct GenericExprWrapper {
struct GenericAssignmentWrapper { struct GenericAssignmentWrapper {
GenericAssignmentWrapper() {} GenericAssignmentWrapper() {}
explicit GenericAssignmentWrapper(Assignment &&x) : v{std::move(x)} {} explicit GenericAssignmentWrapper(Assignment &&x) : v{std::move(x)} {}
explicit GenericAssignmentWrapper(std::optional<Assignment> &&x)
: v{std::move(x)} {}
~GenericAssignmentWrapper(); ~GenericAssignmentWrapper();
static void Deleter(GenericAssignmentWrapper *); static void Deleter(GenericAssignmentWrapper *);
std::optional<Assignment> v; // vacant if error std::optional<Assignment> v; // vacant if error

17
flang/lib/Evaluate/tools.cpp
View File

@ -735,18 +735,23 @@ bool IsObjectPointer(const Expr<SomeType> &expr, FoldingContext &context) {
} }
// IsNullPointer() // IsNullPointer()
struct IsNullPointerHelper : public AllTraverse<IsNullPointerHelper, false> { struct IsNullPointerHelper {
using Base = AllTraverse<IsNullPointerHelper, false>; template <typename A> bool operator()(const A &) const { return false; }
IsNullPointerHelper() : Base(*this) {} template <typename T> bool operator()(const FunctionRef<T> &call) const {
using Base::operator(); const auto *intrinsic{call.proc().GetSpecificIntrinsic()};
bool operator()(const ProcedureRef &call) const {
auto *intrinsic{call.proc().GetSpecificIntrinsic()};
return intrinsic && return intrinsic &&
intrinsic->characteristics.value().attrs.test( intrinsic->characteristics.value().attrs.test(
characteristics::Procedure::Attr::NullPointer); characteristics::Procedure::Attr::NullPointer);
} }
bool operator()(const NullPointer &) const { return true; } bool operator()(const NullPointer &) const { return true; }
template <typename T> bool operator()(const Parentheses<T> &x) const {
return (*this)(x.left());
}
template <typename T> bool operator()(const Expr<T> &x) const {
return std::visit(*this, x.u);
}
}; };
bool IsNullPointer(const Expr<SomeType> &expr) { bool IsNullPointer(const Expr<SomeType> &expr) {
return IsNullPointerHelper{}(expr); return IsNullPointerHelper{}(expr);
} }

4
flang/lib/Semantics/check-call.cpp
View File

@ -764,8 +764,8 @@ parser::Messages CheckExplicitInterface(const characteristics::Procedure &proc,
bool CheckInterfaceForGeneric(const characteristics::Procedure &proc, bool CheckInterfaceForGeneric(const characteristics::Procedure &proc,
evaluate::ActualArguments &actuals, evaluate::ActualArguments &actuals,
const evaluate::FoldingContext &context) { const evaluate::FoldingContext &context) {
return CheckExplicitInterface(proc, actuals, context, nullptr, nullptr) return !CheckExplicitInterface(proc, actuals, context, nullptr, nullptr)
.empty(); .AnyFatalError();
} }
void CheckArguments(const characteristics::Procedure &proc, void CheckArguments(const characteristics::Procedure &proc,

14
flang/lib/Semantics/check-omp-structure.cpp
View File

@ -52,12 +52,14 @@ public:
const auto &expr{std::get<parser::Expr>(assignment.t)}; const auto &expr{std::get<parser::Expr>(assignment.t)};
const auto *lhs{GetExpr(var)}; const auto *lhs{GetExpr(var)};
const auto *rhs{GetExpr(expr)}; const auto *rhs{GetExpr(expr)};
Tristate isDefined{semantics::IsDefinedAssignment( if (lhs && rhs) {
lhs->GetType(), lhs->Rank(), rhs->GetType(), rhs->Rank())}; Tristate isDefined{semantics::IsDefinedAssignment(
if (isDefined == Tristate::Yes) { lhs->GetType(), lhs->Rank(), rhs->GetType(), rhs->Rank())};
context_.Say(expr.source, if (isDefined == Tristate::Yes) {
"Defined assignment statement is not " context_.Say(expr.source,
"allowed in a WORKSHARE construct"_err_en_US); "Defined assignment statement is not "
"allowed in a WORKSHARE construct"_err_en_US);
}
} }
return true; return true;
} }

357
flang/lib/Semantics/expression.cpp
View File

@ -120,23 +120,26 @@ public:
} }
void Analyze(const parser::Variable &); void Analyze(const parser::Variable &);
void Analyze(const parser::ActualArgSpec &, bool isSubroutine); void Analyze(const parser::ActualArgSpec &, bool isSubroutine);
void ConvertBOZ(std::size_t i, std::optional<DynamicType> otherType); void ConvertBOZ(std::optional<DynamicType> &thisType, std::size_t i,
std::optional<DynamicType> otherType);
bool IsIntrinsicRelational(RelationalOperator) const; bool IsIntrinsicRelational(
RelationalOperator, const DynamicType &, const DynamicType &) const;
bool IsIntrinsicLogical() const; bool IsIntrinsicLogical() const;
bool IsIntrinsicNumeric(NumericOperator) const; bool IsIntrinsicNumeric(NumericOperator) const;
bool IsIntrinsicConcat() const; bool IsIntrinsicConcat() const;
bool CheckConformance() const; bool CheckConformance();
bool CheckForNullPointer(const char *where = "as an operand");
// Find and return a user-defined operator or report an error. // Find and return a user-defined operator or report an error.
// The provided message is used if there is no such operator. // The provided message is used if there is no such operator.
MaybeExpr TryDefinedOp( MaybeExpr TryDefinedOp(const char *, parser::MessageFixedText,
const char *, parser::MessageFixedText &&, bool isUserOp = false); const Symbol **definedOpSymbolPtr = nullptr, bool isUserOp = false);
template <typename E> template <typename E>
MaybeExpr TryDefinedOp(E opr, parser::MessageFixedText &&msg) { MaybeExpr TryDefinedOp(E opr, parser::MessageFixedText msg) {
return TryDefinedOp( return TryDefinedOp(
context_.context().languageFeatures().GetNames(opr), std::move(msg)); context_.context().languageFeatures().GetNames(opr), msg);
} }
// Find and return a user-defined assignment // Find and return a user-defined assignment
std::optional<ProcedureRef> TryDefinedAssignment(); std::optional<ProcedureRef> TryDefinedAssignment();
@ -145,13 +148,13 @@ public:
void Dump(llvm::raw_ostream &); void Dump(llvm::raw_ostream &);
private: private:
MaybeExpr TryDefinedOp( MaybeExpr TryDefinedOp(std::vector<const char *>, parser::MessageFixedText);
std::vector<const char *>, parser::MessageFixedText &&);
MaybeExpr TryBoundOp(const Symbol &, int passIndex); MaybeExpr TryBoundOp(const Symbol &, int passIndex);
std::optional<ActualArgument> AnalyzeExpr(const parser::Expr &); std::optional<ActualArgument> AnalyzeExpr(const parser::Expr &);
MaybeExpr AnalyzeExprOrWholeAssumedSizeArray(const parser::Expr &); MaybeExpr AnalyzeExprOrWholeAssumedSizeArray(const parser::Expr &);
bool AreConformable() const; bool AreConformable() const;
const Symbol *FindBoundOp(parser::CharBlock, int passIndex); const Symbol *FindBoundOp(
parser::CharBlock, int passIndex, const Symbol *&definedOp);
void AddAssignmentConversion( void AddAssignmentConversion(
const DynamicType &lhsType, const DynamicType &rhsType); const DynamicType &lhsType, const DynamicType &rhsType);
bool OkLogicalIntegerAssignment(TypeCategory lhs, TypeCategory rhs); bool OkLogicalIntegerAssignment(TypeCategory lhs, TypeCategory rhs);
@ -162,13 +165,13 @@ private:
void SayNoMatch(const std::string &, bool isAssignment = false); void SayNoMatch(const std::string &, bool isAssignment = false);
std::string TypeAsFortran(std::size_t); std::string TypeAsFortran(std::size_t);
bool AnyUntypedOrMissingOperand(); bool AnyUntypedOrMissingOperand();
bool CheckForUntypedNullPointer();
ExpressionAnalyzer &context_; ExpressionAnalyzer &context_;
ActualArguments actuals_; ActualArguments actuals_;
parser::CharBlock source_; parser::CharBlock source_;
bool fatalErrors_{false}; bool fatalErrors_{false};
const bool isProcedureCall_; // false for user-defined op or assignment const bool isProcedureCall_; // false for user-defined op or assignment
const Symbol *sawDefinedOp_{nullptr};
}; };
// Wraps a data reference in a typed Designator<>, and a procedure // Wraps a data reference in a typed Designator<>, and a procedure
@ -2354,19 +2357,20 @@ const Assignment *ExpressionAnalyzer::Analyze(const parser::AssignmentStmt &x) {
ArgumentAnalyzer analyzer{*this}; ArgumentAnalyzer analyzer{*this};
analyzer.Analyze(std::get<parser::Variable>(x.t)); analyzer.Analyze(std::get<parser::Variable>(x.t));
analyzer.Analyze(std::get<parser::Expr>(x.t)); analyzer.Analyze(std::get<parser::Expr>(x.t));
if (analyzer.fatalErrors()) { std::optional<Assignment> assignment;
x.typedAssignment.Reset( if (!analyzer.fatalErrors()) {
new GenericAssignmentWrapper{}, GenericAssignmentWrapper::Deleter);
} else {
std::optional<ProcedureRef> procRef{analyzer.TryDefinedAssignment()}; std::optional<ProcedureRef> procRef{analyzer.TryDefinedAssignment()};
Assignment assignment{analyzer.MoveExpr(0), analyzer.MoveExpr(1)}; if (!procRef) {
if (procRef) { analyzer.CheckForNullPointer(
assignment.u = std::move(*procRef); "in a non-pointer intrinsic assignment statement");
}
assignment.emplace(analyzer.MoveExpr(0), analyzer.MoveExpr(1));
if (procRef) {
assignment->u = std::move(*procRef);
} }
x.typedAssignment.Reset(
new GenericAssignmentWrapper{std::move(assignment)},
GenericAssignmentWrapper::Deleter);
} }
x.typedAssignment.Reset(new GenericAssignmentWrapper{std::move(assignment)},
GenericAssignmentWrapper::Deleter);
} }
return common::GetPtrFromOptional(x.typedAssignment->v); return common::GetPtrFromOptional(x.typedAssignment->v);
} }
@ -2485,18 +2489,20 @@ static MaybeExpr NumericUnaryHelper(ExpressionAnalyzer &context,
NumericOperator opr, const parser::Expr::IntrinsicUnary &x) { NumericOperator opr, const parser::Expr::IntrinsicUnary &x) {
ArgumentAnalyzer analyzer{context}; ArgumentAnalyzer analyzer{context};
analyzer.Analyze(x.v); analyzer.Analyze(x.v);
if (analyzer.fatalErrors()) { if (!analyzer.fatalErrors()) {
return std::nullopt; if (analyzer.IsIntrinsicNumeric(opr)) {
} else if (analyzer.IsIntrinsicNumeric(opr)) { analyzer.CheckForNullPointer();
if (opr == NumericOperator::Add) { if (opr == NumericOperator::Add) {
return analyzer.MoveExpr(0); return analyzer.MoveExpr(0);
} else {
return Negation(context.GetContextualMessages(), analyzer.MoveExpr(0));
}
} else { } else {
return Negation(context.GetContextualMessages(), analyzer.MoveExpr(0)); return analyzer.TryDefinedOp(AsFortran(opr),
"Operand of unary %s must be numeric; have %s"_err_en_US);
} }
} else {
return analyzer.TryDefinedOp(AsFortran(opr),
"Operand of unary %s must be numeric; have %s"_err_en_US);
} }
return std::nullopt;
} }
MaybeExpr ExpressionAnalyzer::Analyze(const parser::Expr::UnaryPlus &x) { MaybeExpr ExpressionAnalyzer::Analyze(const parser::Expr::UnaryPlus &x) {
@ -2510,15 +2516,17 @@ MaybeExpr ExpressionAnalyzer::Analyze(const parser::Expr::Negate &x) {
MaybeExpr ExpressionAnalyzer::Analyze(const parser::Expr::NOT &x) { MaybeExpr ExpressionAnalyzer::Analyze(const parser::Expr::NOT &x) {
ArgumentAnalyzer analyzer{*this}; ArgumentAnalyzer analyzer{*this};
analyzer.Analyze(x.v); analyzer.Analyze(x.v);
if (analyzer.fatalErrors()) { if (!analyzer.fatalErrors()) {
return std::nullopt; if (analyzer.IsIntrinsicLogical()) {
} else if (analyzer.IsIntrinsicLogical()) { analyzer.CheckForNullPointer();
return AsGenericExpr( return AsGenericExpr(
LogicalNegation(std::get<Expr<SomeLogical>>(analyzer.MoveExpr(0).u))); LogicalNegation(std::get<Expr<SomeLogical>>(analyzer.MoveExpr(0).u)));
} else { } else {
return analyzer.TryDefinedOp(LogicalOperator::Not, return analyzer.TryDefinedOp(LogicalOperator::Not,
"Operand of %s must be LOGICAL; have %s"_err_en_US); "Operand of %s must be LOGICAL; have %s"_err_en_US);
}
} }
return std::nullopt;
} }
MaybeExpr ExpressionAnalyzer::Analyze(const parser::Expr::PercentLoc &x) { MaybeExpr ExpressionAnalyzer::Analyze(const parser::Expr::PercentLoc &x) {
@ -2545,7 +2553,7 @@ MaybeExpr ExpressionAnalyzer::Analyze(const parser::Expr::DefinedUnary &x) {
ArgumentAnalyzer analyzer{*this, name.source}; ArgumentAnalyzer analyzer{*this, name.source};
analyzer.Analyze(std::get<1>(x.t)); analyzer.Analyze(std::get<1>(x.t));
return analyzer.TryDefinedOp(name.source.ToString().c_str(), return analyzer.TryDefinedOp(name.source.ToString().c_str(),
"No operator %s defined for %s"_err_en_US, true); "No operator %s defined for %s"_err_en_US, nullptr, true);
} }
// Binary (dyadic) operations // Binary (dyadic) operations
@ -2556,17 +2564,19 @@ MaybeExpr NumericBinaryHelper(ExpressionAnalyzer &context, NumericOperator opr,
ArgumentAnalyzer analyzer{context}; ArgumentAnalyzer analyzer{context};
analyzer.Analyze(std::get<0>(x.t)); analyzer.Analyze(std::get<0>(x.t));
analyzer.Analyze(std::get<1>(x.t)); analyzer.Analyze(std::get<1>(x.t));
if (analyzer.fatalErrors()) { if (!analyzer.fatalErrors()) {
return std::nullopt; if (analyzer.IsIntrinsicNumeric(opr)) {
} else if (analyzer.IsIntrinsicNumeric(opr)) { analyzer.CheckForNullPointer();
analyzer.CheckConformance(); analyzer.CheckConformance();
return NumericOperation<OPR>(context.GetContextualMessages(), return NumericOperation<OPR>(context.GetContextualMessages(),
analyzer.MoveExpr(0), analyzer.MoveExpr(1), analyzer.MoveExpr(0), analyzer.MoveExpr(1),
context.GetDefaultKind(TypeCategory::Real)); context.GetDefaultKind(TypeCategory::Real));
} else { } else {
return analyzer.TryDefinedOp(AsFortran(opr), return analyzer.TryDefinedOp(AsFortran(opr),
"Operands of %s must be numeric; have %s and %s"_err_en_US); "Operands of %s must be numeric; have %s and %s"_err_en_US);
}
} }
return std::nullopt;
} }
MaybeExpr ExpressionAnalyzer::Analyze(const parser::Expr::Power &x) { MaybeExpr ExpressionAnalyzer::Analyze(const parser::Expr::Power &x) {
@ -2604,24 +2614,26 @@ MaybeExpr ExpressionAnalyzer::Analyze(const parser::Expr::Concat &x) {
ArgumentAnalyzer analyzer{*this}; ArgumentAnalyzer analyzer{*this};
analyzer.Analyze(std::get<0>(x.t)); analyzer.Analyze(std::get<0>(x.t));
analyzer.Analyze(std::get<1>(x.t)); analyzer.Analyze(std::get<1>(x.t));
if (analyzer.fatalErrors()) { if (!analyzer.fatalErrors()) {
return std::nullopt; if (analyzer.IsIntrinsicConcat()) {
} else if (analyzer.IsIntrinsicConcat()) { analyzer.CheckForNullPointer();
return std::visit( return std::visit(
[&](auto &&x, auto &&y) -> MaybeExpr { [&](auto &&x, auto &&y) -> MaybeExpr {
using T = ResultType<decltype(x)>; using T = ResultType<decltype(x)>;
if constexpr (std::is_same_v<T, ResultType<decltype(y)>>) { if constexpr (std::is_same_v<T, ResultType<decltype(y)>>) {
return AsGenericExpr(Concat<T::kind>{std::move(x), std::move(y)}); return AsGenericExpr(Concat<T::kind>{std::move(x), std::move(y)});
} else { } else {
DIE("different types for intrinsic concat"); DIE("different types for intrinsic concat");
} }
}, },
std::move(std::get<Expr<SomeCharacter>>(analyzer.MoveExpr(0).u).u), std::move(std::get<Expr<SomeCharacter>>(analyzer.MoveExpr(0).u).u),
std::move(std::get<Expr<SomeCharacter>>(analyzer.MoveExpr(1).u).u)); std::move(std::get<Expr<SomeCharacter>>(analyzer.MoveExpr(1).u).u));
} else { } else {
return analyzer.TryDefinedOp("//", return analyzer.TryDefinedOp("//",
"Operands of %s must be CHARACTER with the same kind; have %s and %s"_err_en_US); "Operands of %s must be CHARACTER with the same kind; have %s and %s"_err_en_US);
}
} }
return std::nullopt;
} }
// The Name represents a user-defined intrinsic operator. // The Name represents a user-defined intrinsic operator.
@ -2644,32 +2656,25 @@ MaybeExpr RelationHelper(ExpressionAnalyzer &context, RelationalOperator opr,
ArgumentAnalyzer analyzer{context}; ArgumentAnalyzer analyzer{context};
analyzer.Analyze(std::get<0>(x.t)); analyzer.Analyze(std::get<0>(x.t));
analyzer.Analyze(std::get<1>(x.t)); analyzer.Analyze(std::get<1>(x.t));
if (analyzer.fatalErrors()) { if (!analyzer.fatalErrors()) {
return std::nullopt;
} else {
if (IsNullPointer(analyzer.GetExpr(0)) ||
IsNullPointer(analyzer.GetExpr(1))) {
context.Say("NULL() not allowed as an operand of a relational "
"operator"_err_en_US);
return std::nullopt;
}
std::optional<DynamicType> leftType{analyzer.GetType(0)}; std::optional<DynamicType> leftType{analyzer.GetType(0)};
std::optional<DynamicType> rightType{analyzer.GetType(1)}; std::optional<DynamicType> rightType{analyzer.GetType(1)};
analyzer.ConvertBOZ(0, rightType); analyzer.ConvertBOZ(leftType, 0, rightType);
analyzer.ConvertBOZ(1, leftType); analyzer.ConvertBOZ(rightType, 1, leftType);
if (analyzer.IsIntrinsicRelational(opr)) { if (leftType && rightType &&
analyzer.IsIntrinsicRelational(opr, *leftType, *rightType)) {
analyzer.CheckForNullPointer("as a relational operand");
return AsMaybeExpr(Relate(context.GetContextualMessages(), opr, return AsMaybeExpr(Relate(context.GetContextualMessages(), opr,
analyzer.MoveExpr(0), analyzer.MoveExpr(1))); analyzer.MoveExpr(0), analyzer.MoveExpr(1)));
} else if (leftType && leftType->category() == TypeCategory::Logical &&
rightType && rightType->category() == TypeCategory::Logical) {
context.Say("LOGICAL operands must be compared using .EQV. or "
".NEQV."_err_en_US);
return std::nullopt;
} else { } else {
return analyzer.TryDefinedOp(opr, return analyzer.TryDefinedOp(opr,
"Operands of %s must have comparable types; have %s and %s"_err_en_US); leftType && leftType->category() == TypeCategory::Logical &&
rightType && rightType->category() == TypeCategory::Logical
? "LOGICAL operands must be compared using .EQV. or .NEQV."_err_en_US
: "Operands of %s must have comparable types; have %s and %s"_err_en_US);
} }
} }
return std::nullopt;
} }
MaybeExpr ExpressionAnalyzer::Analyze(const parser::Expr::LT &x) { MaybeExpr ExpressionAnalyzer::Analyze(const parser::Expr::LT &x) {
@ -2701,16 +2706,18 @@ MaybeExpr LogicalBinaryHelper(ExpressionAnalyzer &context, LogicalOperator opr,
ArgumentAnalyzer analyzer{context}; ArgumentAnalyzer analyzer{context};
analyzer.Analyze(std::get<0>(x.t)); analyzer.Analyze(std::get<0>(x.t));
analyzer.Analyze(std::get<1>(x.t)); analyzer.Analyze(std::get<1>(x.t));
if (analyzer.fatalErrors()) { if (!analyzer.fatalErrors()) {
return std::nullopt; if (analyzer.IsIntrinsicLogical()) {
} else if (analyzer.IsIntrinsicLogical()) { analyzer.CheckForNullPointer("as a logical operand");
return AsGenericExpr(BinaryLogicalOperation(opr, return AsGenericExpr(BinaryLogicalOperation(opr,
std::get<Expr<SomeLogical>>(analyzer.MoveExpr(0).u), std::get<Expr<SomeLogical>>(analyzer.MoveExpr(0).u),
std::get<Expr<SomeLogical>>(analyzer.MoveExpr(1).u))); std::get<Expr<SomeLogical>>(analyzer.MoveExpr(1).u)));
} else { } else {
return analyzer.TryDefinedOp( return analyzer.TryDefinedOp(
opr, "Operands of %s must be LOGICAL; have %s and %s"_err_en_US); opr, "Operands of %s must be LOGICAL; have %s and %s"_err_en_US);
}
} }
return std::nullopt;
} }
MaybeExpr ExpressionAnalyzer::Analyze(const parser::Expr::AND &x) { MaybeExpr ExpressionAnalyzer::Analyze(const parser::Expr::AND &x) {
@ -2735,7 +2742,7 @@ MaybeExpr ExpressionAnalyzer::Analyze(const parser::Expr::DefinedBinary &x) {
analyzer.Analyze(std::get<1>(x.t)); analyzer.Analyze(std::get<1>(x.t));
analyzer.Analyze(std::get<2>(x.t)); analyzer.Analyze(std::get<2>(x.t));
return analyzer.TryDefinedOp(name.source.ToString().c_str(), return analyzer.TryDefinedOp(name.source.ToString().c_str(),
"No operator %s defined for %s and %s"_err_en_US, true); "No operator %s defined for %s and %s"_err_en_US, nullptr, true);
} }
static void CheckFuncRefToArrayElementRefHasSubscripts( static void CheckFuncRefToArrayElementRefHasSubscripts(
@ -2770,7 +2777,7 @@ static void CheckFuncRefToArrayElementRefHasSubscripts(
// Converts, if appropriate, an original misparse of ambiguous syntax like // Converts, if appropriate, an original misparse of ambiguous syntax like
// A(1) as a function reference into an array reference. // A(1) as a function reference into an array reference.
// Misparse structure constructors are detected elsewhere after generic // Misparsed structure constructors are detected elsewhere after generic
// function call resolution fails. // function call resolution fails.
template <typename... A> template <typename... A>
static void FixMisparsedFunctionReference( static void FixMisparsedFunctionReference(
@ -3148,51 +3155,60 @@ void ArgumentAnalyzer::Analyze(
} }
} }
bool ArgumentAnalyzer::IsIntrinsicRelational(RelationalOperator opr) const { bool ArgumentAnalyzer::IsIntrinsicRelational(RelationalOperator opr,
const DynamicType &leftType, const DynamicType &rightType) const {
CHECK(actuals_.size() == 2); CHECK(actuals_.size() == 2);
return semantics::IsIntrinsicRelational( return semantics::IsIntrinsicRelational(
opr, *GetType(0), GetRank(0), *GetType(1), GetRank(1)); opr, leftType, GetRank(0), rightType, GetRank(1));
} }
bool ArgumentAnalyzer::IsIntrinsicNumeric(NumericOperator opr) const { bool ArgumentAnalyzer::IsIntrinsicNumeric(NumericOperator opr) const {
std::optional<DynamicType> type0{GetType(0)}; std::optional<DynamicType> leftType{GetType(0)};
if (actuals_.size() == 1) { if (actuals_.size() == 1) {
if (IsBOZLiteral(0)) { if (IsBOZLiteral(0)) {
return opr == NumericOperator::Add; return opr == NumericOperator::Add; // unary '+'
} else { } else {
return type0 && semantics::IsIntrinsicNumeric(*type0); return leftType && semantics::IsIntrinsicNumeric(*leftType);
} }
} else { } else {
std::optional<DynamicType> type1{GetType(1)}; std::optional<DynamicType> rightType{GetType(1)};
if (IsBOZLiteral(0) && type1) { if (IsBOZLiteral(0) && rightType) { // BOZ opr Integer/Real
auto cat1{type1->category()}; auto cat1{rightType->category()};
return cat1 == TypeCategory::Integer || cat1 == TypeCategory::Real; return cat1 == TypeCategory::Integer || cat1 == TypeCategory::Real;
} else if (IsBOZLiteral(1) && type0) { // Integer/Real opr BOZ } else if (IsBOZLiteral(1) && leftType) { // Integer/Real opr BOZ
auto cat0{type0->category()}; auto cat0{leftType->category()};
return cat0 == TypeCategory::Integer || cat0 == TypeCategory::Real; return cat0 == TypeCategory::Integer || cat0 == TypeCategory::Real;
} else { } else {
return type0 && type1 && return leftType && rightType &&
semantics::IsIntrinsicNumeric(*type0, GetRank(0), *type1, GetRank(1)); semantics::IsIntrinsicNumeric(
*leftType, GetRank(0), *rightType, GetRank(1));
} }
} }
} }
bool ArgumentAnalyzer::IsIntrinsicLogical() const { bool ArgumentAnalyzer::IsIntrinsicLogical() const {
if (actuals_.size() == 1) { if (std::optional<DynamicType> leftType{GetType(0)}) {
return semantics::IsIntrinsicLogical(*GetType(0)); if (actuals_.size() == 1) {
return GetType(0)->category() == TypeCategory::Logical; return semantics::IsIntrinsicLogical(*leftType);
} else { } else if (std::optional<DynamicType> rightType{GetType(1)}) {
return semantics::IsIntrinsicLogical( return semantics::IsIntrinsicLogical(
*GetType(0), GetRank(0), *GetType(1), GetRank(1)); *leftType, GetRank(0), *rightType, GetRank(1));
}
} }
return false;
} }
bool ArgumentAnalyzer::IsIntrinsicConcat() const { bool ArgumentAnalyzer::IsIntrinsicConcat() const {
return semantics::IsIntrinsicConcat( if (std::optional<DynamicType> leftType{GetType(0)}) {
*GetType(0), GetRank(0), *GetType(1), GetRank(1)); if (std::optional<DynamicType> rightType{GetType(1)}) {
return semantics::IsIntrinsicConcat(
*leftType, GetRank(0), *rightType, GetRank(1));
}
}
return false;
} }
bool ArgumentAnalyzer::CheckConformance() const { bool ArgumentAnalyzer::CheckConformance() {
if (actuals_.size() == 2) { if (actuals_.size() == 2) {
const auto *lhs{actuals_.at(0).value().UnwrapExpr()}; const auto *lhs{actuals_.at(0).value().UnwrapExpr()};
const auto *rhs{actuals_.at(1).value().UnwrapExpr()}; const auto *rhs{actuals_.at(1).value().UnwrapExpr()};
@ -3201,23 +3217,49 @@ bool ArgumentAnalyzer::CheckConformance() const {
auto lhShape{GetShape(foldingContext, *lhs)}; auto lhShape{GetShape(foldingContext, *lhs)};
auto rhShape{GetShape(foldingContext, *rhs)}; auto rhShape{GetShape(foldingContext, *rhs)};
if (lhShape && rhShape) { if (lhShape && rhShape) {
return evaluate::CheckConformance(foldingContext.messages(), *lhShape, if (!evaluate::CheckConformance(foldingContext.messages(), *lhShape,
*rhShape, CheckConformanceFlags::EitherScalarExpandable, *rhShape, CheckConformanceFlags::EitherScalarExpandable,
"left operand", "right operand") "left operand", "right operand")
.value_or(false /*fail when conformance is not known now*/); .value_or(false /*fail when conformance is not known now*/)) {
fatalErrors_ = true;
return false;
}
} }
} }
} }
return true; // no proven problem return true; // no proven problem
} }
MaybeExpr ArgumentAnalyzer::TryDefinedOp( bool ArgumentAnalyzer::CheckForNullPointer(const char *where) {
const char *opr, parser::MessageFixedText &&error, bool isUserOp) { for (const std::optional<ActualArgument> &arg : actuals_) {
if (AnyUntypedOrMissingOperand()) { if (arg) {
context_.Say( if (const Expr<SomeType> *expr{arg->UnwrapExpr()}) {
std::move(error), ToUpperCase(opr), TypeAsFortran(0), TypeAsFortran(1)); if (IsNullPointer(*expr)) {
context_.Say(
source_, "A NULL() pointer is not allowed %s"_err_en_US, where);
fatalErrors_ = true;
return false;
}
}
}
}
return true;
}
MaybeExpr ArgumentAnalyzer::TryDefinedOp(const char *opr,
parser::MessageFixedText error, const Symbol **definedOpSymbolPtr,
bool isUserOp) {
if (!CheckForUntypedNullPointer()) {
return std::nullopt; return std::nullopt;
} }
if (AnyUntypedOrMissingOperand()) {
context_.Say(error, ToUpperCase(opr), TypeAsFortran(0), TypeAsFortran(1));
return std::nullopt;
}
const Symbol *localDefinedOpSymbolPtr{nullptr};
if (!definedOpSymbolPtr) {
definedOpSymbolPtr = &localDefinedOpSymbolPtr;
}
{ {
auto restorer{context_.GetContextualMessages().DiscardMessages()}; auto restorer{context_.GetContextualMessages().DiscardMessages()};
std::string oprNameString{ std::string oprNameString{
@ -3225,25 +3267,27 @@ MaybeExpr ArgumentAnalyzer::TryDefinedOp(
parser::CharBlock oprName{oprNameString}; parser::CharBlock oprName{oprNameString};
const auto &scope{context_.context().FindScope(source_)}; const auto &scope{context_.context().FindScope(source_)};
if (Symbol * symbol{scope.FindSymbol(oprName)}) { if (Symbol * symbol{scope.FindSymbol(oprName)}) {
*definedOpSymbolPtr = symbol;
parser::Name name{symbol->name(), symbol}; parser::Name name{symbol->name(), symbol};
if (auto result{context_.AnalyzeDefinedOp(name, GetActuals())}) { if (auto result{context_.AnalyzeDefinedOp(name, GetActuals())}) {
return result; return result;
} }
sawDefinedOp_ = symbol;
} }
for (std::size_t passIndex{0}; passIndex < actuals_.size(); ++passIndex) { for (std::size_t passIndex{0}; passIndex < actuals_.size(); ++passIndex) {
if (const Symbol * symbol{FindBoundOp(oprName, passIndex)}) { if (const Symbol *
symbol{FindBoundOp(oprName, passIndex, *definedOpSymbolPtr)}) {
if (MaybeExpr result{TryBoundOp(*symbol, passIndex)}) { if (MaybeExpr result{TryBoundOp(*symbol, passIndex)}) {
return result; return result;
} }
} }
} }
} }
if (sawDefinedOp_) { if (*definedOpSymbolPtr) {
SayNoMatch(ToUpperCase(sawDefinedOp_->name().ToString())); SayNoMatch(ToUpperCase((*definedOpSymbolPtr)->name().ToString()));
} else if (actuals_.size() == 1 || AreConformable()) { } else if (actuals_.size() == 1 || AreConformable()) {
context_.Say( if (CheckForNullPointer()) {
std::move(error), ToUpperCase(opr), TypeAsFortran(0), TypeAsFortran(1)); context_.Say(error, ToUpperCase(opr), TypeAsFortran(0), TypeAsFortran(1));
}
} else { } else {
context_.Say( context_.Say(
"Operands of %s are not conformable; have rank %d and rank %d"_err_en_US, "Operands of %s are not conformable; have rank %d and rank %d"_err_en_US,
@ -3253,14 +3297,15 @@ MaybeExpr ArgumentAnalyzer::TryDefinedOp(
} }
MaybeExpr ArgumentAnalyzer::TryDefinedOp( MaybeExpr ArgumentAnalyzer::TryDefinedOp(
std::vector<const char *> oprs, parser::MessageFixedText &&error) { std::vector<const char *> oprs, parser::MessageFixedText error) {
const Symbol *definedOpSymbolPtr{nullptr};
for (std::size_t i{1}; i < oprs.size(); ++i) { for (std::size_t i{1}; i < oprs.size(); ++i) {
auto restorer{context_.GetContextualMessages().DiscardMessages()}; auto restorer{context_.GetContextualMessages().DiscardMessages()};
if (auto result{TryDefinedOp(oprs[i], std::move(error))}) { if (auto result{TryDefinedOp(oprs[i], error, &definedOpSymbolPtr)}) {
return result; return result;
} }
} }
return TryDefinedOp(oprs[0], std::move(error)); return TryDefinedOp(oprs[0], error, &definedOpSymbolPtr);
} }
MaybeExpr ArgumentAnalyzer::TryBoundOp(const Symbol &symbol, int passIndex) { MaybeExpr ArgumentAnalyzer::TryBoundOp(const Symbol &symbol, int passIndex) {
@ -3344,8 +3389,9 @@ std::optional<ProcedureRef> ArgumentAnalyzer::GetDefinedAssignmentProc() {
} }
} }
int passedObjectIndex{-1}; int passedObjectIndex{-1};
const Symbol *definedOpSymbol{nullptr};
for (std::size_t i{0}; i < actuals_.size(); ++i) { for (std::size_t i{0}; i < actuals_.size(); ++i) {
if (const Symbol * specific{FindBoundOp(oprName, i)}) { if (const Symbol * specific{FindBoundOp(oprName, i, definedOpSymbol)}) {
if (const Symbol * if (const Symbol *
resolution{GetBindingResolution(GetType(i), *specific)}) { resolution{GetBindingResolution(GetType(i), *specific)}) {
proc = resolution; proc = resolution;
@ -3418,13 +3464,14 @@ MaybeExpr ArgumentAnalyzer::AnalyzeExprOrWholeAssumedSizeArray(
} }
bool ArgumentAnalyzer::AreConformable() const { bool ArgumentAnalyzer::AreConformable() const {
CHECK(!fatalErrors_ && actuals_.size() == 2); CHECK(actuals_.size() == 2);
return evaluate::AreConformable(*actuals_[0], *actuals_[1]); return actuals_[0] && actuals_[1] &&
evaluate::AreConformable(*actuals_[0], *actuals_[1]);
} }
// Look for a type-bound operator in the type of arg number passIndex. // Look for a type-bound operator in the type of arg number passIndex.
const Symbol *ArgumentAnalyzer::FindBoundOp( const Symbol *ArgumentAnalyzer::FindBoundOp(
parser::CharBlock oprName, int passIndex) { parser::CharBlock oprName, int passIndex, const Symbol *&definedOp) {
const auto *type{GetDerivedTypeSpec(GetType(passIndex))}; const auto *type{GetDerivedTypeSpec(GetType(passIndex))};
if (!type || !type->scope()) { if (!type || !type->scope()) {
return nullptr; return nullptr;
@ -3433,7 +3480,7 @@ const Symbol *ArgumentAnalyzer::FindBoundOp(
if (!symbol) { if (!symbol) {
return nullptr; return nullptr;
} }
sawDefinedOp_ = symbol; definedOp = symbol;
ExpressionAnalyzer::AdjustActuals adjustment{ ExpressionAnalyzer::AdjustActuals adjustment{
[&](const Symbol &proc, ActualArguments &) { [&](const Symbol &proc, ActualArguments &) {
return passIndex == GetPassIndex(proc); return passIndex == GetPassIndex(proc);
@ -3469,21 +3516,23 @@ int ArgumentAnalyzer::GetRank(std::size_t i) const {
// otherType. If it's REAL convert to REAL, otherwise convert to INTEGER. // otherType. If it's REAL convert to REAL, otherwise convert to INTEGER.
// Note that IBM supports comparing BOZ literals to CHARACTER operands. That // Note that IBM supports comparing BOZ literals to CHARACTER operands. That
// is not currently supported. // is not currently supported.
void ArgumentAnalyzer::ConvertBOZ( void ArgumentAnalyzer::ConvertBOZ(std::optional<DynamicType> &thisType,
std::size_t i, std::optional<DynamicType> otherType) { std::size_t i, std::optional<DynamicType> otherType) {
if (IsBOZLiteral(i)) { if (IsBOZLiteral(i)) {
Expr<SomeType> &&argExpr{MoveExpr(i)}; Expr<SomeType> &&argExpr{MoveExpr(i)};
auto *boz{std::get_if<BOZLiteralConstant>(&argExpr.u)}; auto *boz{std::get_if<BOZLiteralConstant>(&argExpr.u)};
if (otherType && otherType->category() == TypeCategory::Real) { if (otherType && otherType->category() == TypeCategory::Real) {
MaybeExpr realExpr{ConvertToKind<TypeCategory::Real>( int kind{context_.context().GetDefaultKind(TypeCategory::Real)};
context_.context().GetDefaultKind(TypeCategory::Real), MaybeExpr realExpr{
std::move(*boz))}; ConvertToKind<TypeCategory::Real>(kind, std::move(*boz))};
actuals_[i] = std::move(*realExpr); actuals_[i] = std::move(*realExpr);
thisType.emplace(TypeCategory::Real, kind);
} else { } else {
MaybeExpr intExpr{ConvertToKind<TypeCategory::Integer>( int kind{context_.context().GetDefaultKind(TypeCategory::Integer)};
context_.context().GetDefaultKind(TypeCategory::Integer), MaybeExpr intExpr{
std::move(*boz))}; ConvertToKind<TypeCategory::Integer>(kind, std::move(*boz))};
actuals_[i] = std::move(*intExpr); actuals_[i] = std::move(*intExpr);
thisType.emplace(TypeCategory::Integer, kind);
} }
} }
} }
@ -3550,6 +3599,22 @@ bool ArgumentAnalyzer::AnyUntypedOrMissingOperand() {
return false; return false;
} }
bool ArgumentAnalyzer::CheckForUntypedNullPointer() {
for (const std::optional<ActualArgument> &arg : actuals_) {
if (arg) {
if (const Expr<SomeType> *expr{arg->UnwrapExpr()}) {
if (std::holds_alternative<NullPointer>(expr->u)) {
context_.Say(source_,
"A typeless NULL() pointer is not allowed as an operand"_err_en_US);
fatalErrors_ = true;
return false;
}
}
}
}
return true;
}
} // namespace Fortran::evaluate } // namespace Fortran::evaluate
namespace Fortran::semantics { namespace Fortran::semantics {

61
flang/test/Semantics/resolve63.f90
View File

@ -158,7 +158,7 @@ module m3
end end
end interface end interface
contains contains
subroutine s1(x, y) subroutine s1(x, y)
logical :: x logical :: x
integer :: y integer :: y
integer, pointer :: px integer, pointer :: px
@ -172,17 +172,17 @@ contains
y = -z'1' y = -z'1'
!ERROR: Operands of + must be numeric; have LOGICAL(4) and untyped !ERROR: Operands of + must be numeric; have LOGICAL(4) and untyped
y = x + z'1' y = x + z'1'
!ERROR: NULL() not allowed as an operand of a relational operator !ERROR: A typeless NULL() pointer is not allowed as an operand
l = x /= null() l = x /= null()
!ERROR: NULL() not allowed as an operand of a relational operator !ERROR: A NULL() pointer is not allowed as a relational operand
l = null(px) /= null(px) l = null(px) /= null(px)
!ERROR: NULL() not allowed as an operand of a relational operator !ERROR: A NULL() pointer is not allowed as an operand
l = x /= null(px) l = x /= null(px)
!ERROR: NULL() not allowed as an operand of a relational operator !ERROR: A typeless NULL() pointer is not allowed as an operand
l = px /= null() l = px /= null()
!ERROR: NULL() not allowed as an operand of a relational operator !ERROR: A NULL() pointer is not allowed as a relational operand
l = px /= null(px) l = px /= null(px)
!ERROR: NULL() not allowed as an operand of a relational operator !ERROR: A typeless NULL() pointer is not allowed as an operand
l = null() /= null() l = null() /= null()
end end
end end
@ -271,3 +271,50 @@ contains
i = i + x i = i + x
end end
end end
! Some cases where NULL is acceptable - ensure no false errors
module m7
implicit none
type :: t1
contains
procedure :: s1
generic :: operator(/) => s1
end type
interface operator(-)
module procedure s2
end interface
contains
integer function s1(x, y)
class(t1), intent(in) :: x
class(t1), intent(in), pointer :: y
s1 = 1
end
integer function s2(x, y)
type(t1), intent(in), pointer :: x, y
s2 = 2
end
subroutine test
integer :: j
type(t1), pointer :: x1
allocate(x1)
! These cases are fine.
j = x1 - x1
j = x1 - null(mold=x1)
j = null(mold=x1) - null(mold=x1)
j = null(mold=x1) - x1
j = x1 / x1
j = x1 / null(mold=x1)
!ERROR: A typeless NULL() pointer is not allowed as an operand
j = null() - null(mold=x1)
!ERROR: A typeless NULL() pointer is not allowed as an operand
j = null(mold=x1) - null()
!ERROR: A typeless NULL() pointer is not allowed as an operand
j = null() - null()
!ERROR: A typeless NULL() pointer is not allowed as an operand
j = null() / null(mold=x1)
!ERROR: A typeless NULL() pointer is not allowed as an operand
j = null(mold=x1) / null()
!ERROR: A typeless NULL() pointer is not allowed as an operand
j = null() / null()
end
end