diff --git a/flang/lib/Semantics/expression.cpp b/flang/lib/Semantics/expression.cpp index 2feec98eead83..7864126af00e8 100644 --- a/flang/lib/Semantics/expression.cpp +++ b/flang/lib/Semantics/expression.cpp @@ -176,8 +176,8 @@ class ArgumentAnalyzer { // Find and return a user-defined operator or report an error. // The provided message is used if there is no such operator. - MaybeExpr TryDefinedOp( - const char *, parser::MessageFixedText, bool isUserOp = false); + MaybeExpr TryDefinedOp(const char *, parser::MessageFixedText, + bool isUserOp = false, bool checkForNullPointer = true); template MaybeExpr TryDefinedOp(E opr, parser::MessageFixedText msg) { return TryDefinedOp( @@ -211,7 +211,8 @@ class ArgumentAnalyzer { void SayNoMatch( const std::string &, bool isAssignment = false, bool isAmbiguous = false); std::string TypeAsFortran(std::size_t); - bool AnyUntypedOrMissingOperand() const; + bool AnyUntypedOperand() const; + bool AnyMissingOperand() const; ExpressionAnalyzer &context_; ActualArguments actuals_; @@ -3695,11 +3696,12 @@ std::optional ExpressionAnalyzer::CheckCall( MaybeExpr ExpressionAnalyzer::Analyze(const parser::Expr::Parentheses &x) { if (MaybeExpr operand{Analyze(x.v.value())}) { - if (const semantics::Symbol *symbol{GetLastSymbol(*operand)}) { + if (IsNullPointerOrAllocatable(&*operand)) { + Say("NULL() may not be parenthesized"_err_en_US); + } else if (const semantics::Symbol *symbol{GetLastSymbol(*operand)}) { if (const semantics::Symbol *result{FindFunctionResult(*symbol)}) { if (semantics::IsProcedurePointer(*result)) { - Say("A function reference that returns a procedure " - "pointer may not be parenthesized"_err_en_US); // C1003 + Say("A function reference that returns a procedure pointer may not be parenthesized"_err_en_US); // C1003 } } } @@ -3788,7 +3790,7 @@ MaybeExpr ExpressionAnalyzer::Analyze(const parser::Expr::DefinedUnary &x) { ArgumentAnalyzer analyzer{*this, name.source}; analyzer.Analyze(std::get<1>(x.t)); 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, /*isUserOp=*/true); } // Binary (dyadic) operations @@ -4176,15 +4178,23 @@ MaybeExpr ExpressionAnalyzer::IterativelyAnalyzeSubexpressions( } while (!queue.empty()); // Analyze the collected subexpressions in bottom-up order. // On an error, bail out and leave partial results in place. - MaybeExpr result; - for (auto riter{finish.rbegin()}; riter != finish.rend(); ++riter) { - const parser::Expr &expr{**riter}; - result = ExprOrVariable(expr, expr.source); - if (!result) { - return result; + if (finish.size() == 1) { + const parser::Expr &expr{DEREF(finish.front())}; + return ExprOrVariable(expr, expr.source); + } else { + // NULL() operand catching is deferred to operation analysis so + // that they can be accepted by defined operators. + auto restorer{AllowNullPointer()}; + MaybeExpr result; + for (auto riter{finish.rbegin()}; riter != finish.rend(); ++riter) { + const parser::Expr &expr{**riter}; + result = ExprOrVariable(expr, expr.source); + if (!result) { + return result; + } } + return result; // last value was from analysis of "top" } - return result; // last value was from analysis of "top" } MaybeExpr ExpressionAnalyzer::Analyze(const parser::Expr &expr) { @@ -4681,7 +4691,7 @@ bool ArgumentAnalyzer::AnyCUDADeviceData() const { // attribute. bool ArgumentAnalyzer::HasDeviceDefinedIntrinsicOpOverride( const char *opr) const { - if (AnyCUDADeviceData() && !AnyUntypedOrMissingOperand()) { + if (AnyCUDADeviceData() && !AnyUntypedOperand() && !AnyMissingOperand()) { std::string oprNameString{"operator("s + opr + ')'}; parser::CharBlock oprName{oprNameString}; parser::Messages buffer; @@ -4709,9 +4719,9 @@ bool ArgumentAnalyzer::HasDeviceDefinedIntrinsicOpOverride( return false; } -MaybeExpr ArgumentAnalyzer::TryDefinedOp( - const char *opr, parser::MessageFixedText error, bool isUserOp) { - if (AnyUntypedOrMissingOperand()) { +MaybeExpr ArgumentAnalyzer::TryDefinedOp(const char *opr, + parser::MessageFixedText error, bool isUserOp, bool checkForNullPointer) { + if (AnyMissingOperand()) { context_.Say(error, ToUpperCase(opr), TypeAsFortran(0), TypeAsFortran(1)); return std::nullopt; } @@ -4790,7 +4800,9 @@ MaybeExpr ArgumentAnalyzer::TryDefinedOp( context_.Say( "Operands of %s are not conformable; have rank %d and rank %d"_err_en_US, ToUpperCase(opr), actuals_[0]->Rank(), actuals_[1]->Rank()); - } else if (CheckForNullPointer() && CheckForAssumedRank()) { + } else if (!CheckForAssumedRank()) { + } else if (checkForNullPointer && !CheckForNullPointer()) { + } else { // use the supplied error context_.Say(error, ToUpperCase(opr), TypeAsFortran(0), TypeAsFortran(1)); } return result; @@ -4808,15 +4820,16 @@ MaybeExpr ArgumentAnalyzer::TryDefinedOp( for (std::size_t i{0}; i < oprs.size(); ++i) { parser::Messages buffer; auto restorer{context_.GetContextualMessages().SetMessages(buffer)}; - if (MaybeExpr thisResult{TryDefinedOp(oprs[i], error)}) { + if (MaybeExpr thisResult{TryDefinedOp(oprs[i], error, /*isUserOp=*/false, + /*checkForNullPointer=*/false)}) { result = std::move(thisResult); hit.push_back(oprs[i]); hitBuffer = std::move(buffer); } } } - if (hit.empty()) { // for the error - result = TryDefinedOp(oprs[0], error); + if (hit.empty()) { // run TryDefinedOp() again just to emit errors + CHECK(!TryDefinedOp(oprs[0], error).has_value()); } else if (hit.size() > 1) { context_.Say( "Matching accessible definitions were found with %zd variant spellings of the generic operator ('%s', '%s')"_err_en_US, @@ -5232,10 +5245,19 @@ std::string ArgumentAnalyzer::TypeAsFortran(std::size_t i) { } } -bool ArgumentAnalyzer::AnyUntypedOrMissingOperand() const { +bool ArgumentAnalyzer::AnyUntypedOperand() const { + for (const auto &actual : actuals_) { + if (actual && !actual->GetType() && + !IsBareNullPointer(actual->UnwrapExpr())) { + return true; + } + } + return false; +} + +bool ArgumentAnalyzer::AnyMissingOperand() const { for (const auto &actual : actuals_) { - if (!actual || - (!actual->GetType() && !IsBareNullPointer(actual->UnwrapExpr()))) { + if (!actual) { return true; } } diff --git a/flang/test/Semantics/bug163255.f90 b/flang/test/Semantics/bug163255.f90 new file mode 100644 index 0000000000000..e29322aae36a0 --- /dev/null +++ b/flang/test/Semantics/bug163255.f90 @@ -0,0 +1,21 @@ +!RUN: %flang_fc1 -fdebug-unparse %s | FileCheck %s +module m + type t + end type + interface operator (==) + module procedure equal + end interface + contains + logical function equal(b1, b2) + class(t), pointer, intent(in) :: b1, b2 + equal = associated(b1, b2) + end +end module + +program test + use m + type(t), target :: target + class(t), pointer :: p => target + !CHECK: IF (equal(p,null(p))) STOP + if (p == null(p)) stop +end diff --git a/flang/test/Semantics/resolve63.f90 b/flang/test/Semantics/resolve63.f90 index 1cb8a8584cc77..0c3df2e8724a0 100644 --- a/flang/test/Semantics/resolve63.f90 +++ b/flang/test/Semantics/resolve63.f90 @@ -165,13 +165,12 @@ subroutine s1(x, y) logical :: l complex :: z y = y + z'1' !OK - !ERROR: Operands of + must be numeric; have untyped and COMPLEX(4) + !ERROR: No intrinsic or user-defined OPERATOR(+) matches operand types untyped and COMPLEX(4) z = z'1' + z y = +z'1' !OK !ERROR: Operand of unary - must be numeric; have untyped y = -z'1' - !ERROR: Operands of + must be numeric; have LOGICAL(4) and untyped - y = x + z'1' + y = x + z'1' ! matches "add" with conversion of untyped to integer !ERROR: A NULL() pointer is not allowed as an operand here l = x /= null() !ERROR: A NULL() pointer is not allowed as a relational operand