[flang] More precise checks for NULL() operands

[klausler]

Summary

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.

[PeteSteinfeld]

All looks good.

flang/lib/Semantics/check-omp-structure.cpp

55–62

This change doesn't seem related to everything else (although it looks good). Did you mean to include it?

[klausler]

flang/lib/Semantics/check-omp-structure.cpp

55–62

Yes, I do. It avoids a crash that I ran into while testing some earlier forms of my patch, and it seemed worth keeping to avoid having to change it again in the future.

flang/include/flang/Evaluate/expression.h

struct GenericExprWrapper {
   static void Deleter(GenericExprWrapper *);
   std::optional<Expr<SomeType>> v; // vacant if error
 };
 
 // Like GenericExprWrapper but for analyzed assignments
 struct GenericAssignmentWrapper {
   GenericAssignmentWrapper() {}
   explicit GenericAssignmentWrapper(Assignment &&x) : v{std::move(x)} {}
+  explicit GenericAssignmentWrapper(std::optional<Assignment> &&x)
+      : v{std::move(x)} {}
   ~GenericAssignmentWrapper();
   static void Deleter(GenericAssignmentWrapper *);
   std::optional<Assignment> v; // vacant if error
 };
 
 FOR_EACH_CATEGORY_TYPE(extern template class Expr, )
 FOR_EACH_TYPE_AND_KIND(extern template class ExpressionBase, )
 FOR_EACH_INTRINSIC_KIND(extern template class ArrayConstructorValues, )

flang/lib/Evaluate/tools.cpp

bool IsObjectPointer(const Expr<SomeType> &expr, FoldingContext &context) {
   } else if (const Symbol * symbol{GetLastSymbol(expr)}) {
     return IsPointer(symbol->GetUltimate());
   } else {
     return false;
   }
 }
 
 // IsNullPointer()
-struct IsNullPointerHelper : public AllTraverse<IsNullPointerHelper, false> {
-  using Base = AllTraverse<IsNullPointerHelper, false>;
-  IsNullPointerHelper() : Base(*this) {}
-  using Base::operator();
-  bool operator()(const ProcedureRef &call) const {
-    auto *intrinsic{call.proc().GetSpecificIntrinsic()};
+struct IsNullPointerHelper {
+  template <typename A> bool operator()(const A &) const { return false; }
+  template <typename T> bool operator()(const FunctionRef<T> &call) const {
+    const auto *intrinsic{call.proc().GetSpecificIntrinsic()};
     return intrinsic &&
         intrinsic->characteristics.value().attrs.test(
             characteristics::Procedure::Attr::NullPointer);
   }
   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) {
   return IsNullPointerHelper{}(expr);
 }
 
 // GetSymbolVector()
 auto GetSymbolVectorHelper::operator()(const Symbol &x) const -> Result {
   if (const auto *details{x.detailsIf<semantics::AssocEntityDetails>()}) {
     return (*this)(details->expr());

flang/lib/Semantics/check-call.cpp

parser::Messages CheckExplicitInterface(const characteristics::Procedure &proc,
     evaluate::ActualArguments &actuals, const evaluate::FoldingContext &context,
     const Scope &scope, const evaluate::SpecificIntrinsic *intrinsic) {
   return CheckExplicitInterface(proc, actuals, context, &scope, intrinsic);
 }
 
 bool CheckInterfaceForGeneric(const characteristics::Procedure &proc,
     evaluate::ActualArguments &actuals,
     const evaluate::FoldingContext &context) {
-  return CheckExplicitInterface(proc, actuals, context, nullptr, nullptr)
-      .empty();
+  return !CheckExplicitInterface(proc, actuals, context, nullptr, nullptr)
+              .AnyFatalError();
 }
 
 void CheckArguments(const characteristics::Procedure &proc,
     evaluate::ActualArguments &actuals, evaluate::FoldingContext &context,
     const Scope &scope, bool treatingExternalAsImplicit,
     const evaluate::SpecificIntrinsic *intrinsic) {
   bool explicitInterface{proc.HasExplicitInterface()};
   if (explicitInterface) {

flang/lib/Semantics/check-omp-structure.cpp

public:
   template <typename T> bool Pre(const T &) { return true; }
   template <typename T> void Post(const T &) {}
 
   bool Pre(const parser::AssignmentStmt &assignment) {
     const auto &var{std::get<parser::Variable>(assignment.t)};
     const auto &expr{std::get<parser::Expr>(assignment.t)};
     const auto *lhs{GetExpr(var)};
     const auto *rhs{GetExpr(expr)};
+    if (lhs && rhs) {
       Tristate isDefined{semantics::IsDefinedAssignment(
           lhs->GetType(), lhs->Rank(), rhs->GetType(), rhs->Rank())};
       if (isDefined == Tristate::Yes) {
         context_.Say(expr.source,
             "Defined assignment statement is not "
             "allowed in a WORKSHARE construct"_err_en_US);
       }
+    }
     return true;
   }
 
   bool Pre(const parser::Expr &expr) {
     if (const auto *e{GetExpr(expr)}) {
       for (const Symbol &symbol : evaluate::CollectSymbols(*e)) {
         const Symbol &root{GetAssociationRoot(symbol)};
         if (IsFunction(root) &&

flang/lib/Semantics/expression.cpp

void Analyze(const common::Indirection<parser::Expr> &x) {
     Analyze(x.value());
   }
   void Analyze(const parser::Expr &x) {
     actuals_.emplace_back(AnalyzeExpr(x));
     fatalErrors_ |= !actuals_.back();
   }
   void Analyze(const parser::Variable &);
   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 IsIntrinsicNumeric(NumericOperator) 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.
   // 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,
+      const Symbol **definedOpSymbolPtr = nullptr, bool isUserOp = false);
   template <typename E>
-  MaybeExpr TryDefinedOp(E opr, parser::MessageFixedText &&msg) {
+  MaybeExpr TryDefinedOp(E opr, parser::MessageFixedText msg) {
     return TryDefinedOp(
-        context_.context().languageFeatures().GetNames(opr), std::move(msg));
+        context_.context().languageFeatures().GetNames(opr), msg);
   }
   // Find and return a user-defined assignment
   std::optional<ProcedureRef> TryDefinedAssignment();
   std::optional<ProcedureRef> GetDefinedAssignmentProc();
   std::optional<DynamicType> GetType(std::size_t) const;
   void Dump(llvm::raw_ostream &);
 
 private:
-  MaybeExpr TryDefinedOp(
-      std::vector<const char *>, parser::MessageFixedText &&);
+  MaybeExpr TryDefinedOp(std::vector<const char *>, parser::MessageFixedText);
   MaybeExpr TryBoundOp(const Symbol &, int passIndex);
   std::optional<ActualArgument> AnalyzeExpr(const parser::Expr &);
   MaybeExpr AnalyzeExprOrWholeAssumedSizeArray(const parser::Expr &);
   bool AreConformable() const;
-  const Symbol *FindBoundOp(parser::CharBlock, int passIndex);
+  const Symbol *FindBoundOp(
+      parser::CharBlock, int passIndex, const Symbol *&definedOp);
   void AddAssignmentConversion(
       const DynamicType &lhsType, const DynamicType &rhsType);
   bool OkLogicalIntegerAssignment(TypeCategory lhs, TypeCategory rhs);
   int GetRank(std::size_t) const;
   bool IsBOZLiteral(std::size_t i) const {
     return evaluate::IsBOZLiteral(GetExpr(i));
   }
   void SayNoMatch(const std::string &, bool isAssignment = false);
   std::string TypeAsFortran(std::size_t);
   bool AnyUntypedOrMissingOperand();
+  bool CheckForUntypedNullPointer();
 
   ExpressionAnalyzer &context_;
   ActualArguments actuals_;
   parser::CharBlock source_;
   bool fatalErrors_{false};
   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
 // or procedure pointer reference in a ProcedureDesignator.
 MaybeExpr ExpressionAnalyzer::Designate(DataRef &&ref) {
   const Symbol &last{ref.GetLastSymbol()};
   const Symbol &symbol{BypassGeneric(last).GetUltimate()};
   if (semantics::IsProcedure(symbol)) {
void ExpressionAnalyzer::Analyze(const parser::CallStmt &callStmt) {
   }
 }
 
 const Assignment *ExpressionAnalyzer::Analyze(const parser::AssignmentStmt &x) {
   if (!x.typedAssignment) {
     ArgumentAnalyzer analyzer{*this};
     analyzer.Analyze(std::get<parser::Variable>(x.t));
     analyzer.Analyze(std::get<parser::Expr>(x.t));
-    if (analyzer.fatalErrors()) {
-      x.typedAssignment.Reset(
-          new GenericAssignmentWrapper{}, GenericAssignmentWrapper::Deleter);
-    } else {
+    std::optional<Assignment> assignment;
+    if (!analyzer.fatalErrors()) {
       std::optional<ProcedureRef> procRef{analyzer.TryDefinedAssignment()};
-      Assignment assignment{analyzer.MoveExpr(0), analyzer.MoveExpr(1)};
+      if (!procRef) {
+        analyzer.CheckForNullPointer(
+            "in a non-pointer intrinsic assignment statement");
+      }
+      assignment.emplace(analyzer.MoveExpr(0), analyzer.MoveExpr(1));
       if (procRef) {
-        assignment.u = std::move(*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);
 }
 
 const Assignment *ExpressionAnalyzer::Analyze(
     const parser::PointerAssignmentStmt &x) {
   if (!x.typedAssignment) {
     MaybeExpr lhs{Analyze(std::get<parser::DataRef>(x.t))};
MaybeExpr ExpressionAnalyzer::Analyze(const parser::Expr::Parentheses &x) {
   }
   return std::nullopt;
 }
 
 static MaybeExpr NumericUnaryHelper(ExpressionAnalyzer &context,
     NumericOperator opr, const parser::Expr::IntrinsicUnary &x) {
   ArgumentAnalyzer analyzer{context};
   analyzer.Analyze(x.v);
-  if (analyzer.fatalErrors()) {
-    return std::nullopt;
-  } else if (analyzer.IsIntrinsicNumeric(opr)) {
+  if (!analyzer.fatalErrors()) {
+    if (analyzer.IsIntrinsicNumeric(opr)) {
+      analyzer.CheckForNullPointer();
       if (opr == NumericOperator::Add) {
         return analyzer.MoveExpr(0);
       } else {
         return Negation(context.GetContextualMessages(), analyzer.MoveExpr(0));
       }
     } 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) {
   return NumericUnaryHelper(*this, NumericOperator::Add, x);
 }
 
 MaybeExpr ExpressionAnalyzer::Analyze(const parser::Expr::Negate &x) {
   return NumericUnaryHelper(*this, NumericOperator::Subtract, x);
 }
 
 MaybeExpr ExpressionAnalyzer::Analyze(const parser::Expr::NOT &x) {
   ArgumentAnalyzer analyzer{*this};
   analyzer.Analyze(x.v);
-  if (analyzer.fatalErrors()) {
-    return std::nullopt;
-  } else if (analyzer.IsIntrinsicLogical()) {
+  if (!analyzer.fatalErrors()) {
+    if (analyzer.IsIntrinsicLogical()) {
+      analyzer.CheckForNullPointer();
       return AsGenericExpr(
           LogicalNegation(std::get<Expr<SomeLogical>>(analyzer.MoveExpr(0).u)));
     } else {
       return analyzer.TryDefinedOp(LogicalOperator::Not,
           "Operand of %s must be LOGICAL; have %s"_err_en_US);
     }
   }
+  return std::nullopt;
+}
 
 MaybeExpr ExpressionAnalyzer::Analyze(const parser::Expr::PercentLoc &x) {
   // Represent %LOC() exactly as if it had been a call to the LOC() extension
   // intrinsic function.
   // Use the actual source for the name of the call for error reporting.
   std::optional<ActualArgument> arg;
   if (const Symbol * assumedTypeDummy{AssumedTypeDummy(x.v.value())}) {
     arg = ActualArgument{ActualArgument::AssumedType{*assumedTypeDummy}};
MaybeExpr ExpressionAnalyzer::Analyze(const parser::Expr::PercentLoc &x) {
   return MakeFunctionRef(loc, ActualArguments{std::move(*arg)});
 }
 
 MaybeExpr ExpressionAnalyzer::Analyze(const parser::Expr::DefinedUnary &x) {
   const auto &name{std::get<parser::DefinedOpName>(x.t).v};
   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, nullptr, true);
 }
 
 // Binary (dyadic) operations
 
 template <template <typename> class OPR>
 MaybeExpr NumericBinaryHelper(ExpressionAnalyzer &context, NumericOperator opr,
     const parser::Expr::IntrinsicBinary &x) {
   ArgumentAnalyzer analyzer{context};
   analyzer.Analyze(std::get<0>(x.t));
   analyzer.Analyze(std::get<1>(x.t));
-  if (analyzer.fatalErrors()) {
-    return std::nullopt;
-  } else if (analyzer.IsIntrinsicNumeric(opr)) {
+  if (!analyzer.fatalErrors()) {
+    if (analyzer.IsIntrinsicNumeric(opr)) {
+      analyzer.CheckForNullPointer();
       analyzer.CheckConformance();
       return NumericOperation<OPR>(context.GetContextualMessages(),
           analyzer.MoveExpr(0), analyzer.MoveExpr(1),
           context.GetDefaultKind(TypeCategory::Real));
     } else {
       return analyzer.TryDefinedOp(AsFortran(opr),
           "Operands of %s must be numeric; have %s and %s"_err_en_US);
     }
   }
+  return std::nullopt;
+}
 
 MaybeExpr ExpressionAnalyzer::Analyze(const parser::Expr::Power &x) {
   return NumericBinaryHelper<Power>(*this, NumericOperator::Power, x);
 }
 
 MaybeExpr ExpressionAnalyzer::Analyze(const parser::Expr::Multiply &x) {
   return NumericBinaryHelper<Multiply>(*this, NumericOperator::Multiply, x);
 }
MaybeExpr ExpressionAnalyzer::Analyze(
   return AsMaybeExpr(ConstructComplex(GetContextualMessages(), std::move(re),
       std::move(im), GetDefaultKind(TypeCategory::Real)));
 }
 
 MaybeExpr ExpressionAnalyzer::Analyze(const parser::Expr::Concat &x) {
   ArgumentAnalyzer analyzer{*this};
   analyzer.Analyze(std::get<0>(x.t));
   analyzer.Analyze(std::get<1>(x.t));
-  if (analyzer.fatalErrors()) {
-    return std::nullopt;
-  } else if (analyzer.IsIntrinsicConcat()) {
+  if (!analyzer.fatalErrors()) {
+    if (analyzer.IsIntrinsicConcat()) {
+      analyzer.CheckForNullPointer();
       return std::visit(
           [&](auto &&x, auto &&y) -> MaybeExpr {
             using T = ResultType<decltype(x)>;
             if constexpr (std::is_same_v<T, ResultType<decltype(y)>>) {
               return AsGenericExpr(Concat<T::kind>{std::move(x), std::move(y)});
             } else {
               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(1).u).u));
     } else {
       return analyzer.TryDefinedOp("//",
           "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.
 // If the actuals match one of the specific procedures, return a function ref.
 // Otherwise report the error in messages.
 MaybeExpr ExpressionAnalyzer::AnalyzeDefinedOp(
     const parser::Name &name, ActualArguments &&actuals) {
   if (auto callee{GetCalleeAndArguments(name, std::move(actuals))}) {
     CHECK(std::holds_alternative<ProcedureDesignator>(callee->u));
     return MakeFunctionRef(name.source,
         std::move(std::get<ProcedureDesignator>(callee->u)),
         std::move(callee->arguments));
   } else {
     return std::nullopt;
   }
 }
 
 MaybeExpr RelationHelper(ExpressionAnalyzer &context, RelationalOperator opr,
     const parser::Expr::IntrinsicBinary &x) {
   ArgumentAnalyzer analyzer{context};
   analyzer.Analyze(std::get<0>(x.t));
   analyzer.Analyze(std::get<1>(x.t));
-  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;
-    }
+  if (!analyzer.fatalErrors()) {
     std::optional<DynamicType> leftType{analyzer.GetType(0)};
     std::optional<DynamicType> rightType{analyzer.GetType(1)};
-    analyzer.ConvertBOZ(0, rightType);
-    analyzer.ConvertBOZ(1, leftType);
-    if (analyzer.IsIntrinsicRelational(opr)) {
+    analyzer.ConvertBOZ(leftType, 0, rightType);
+    analyzer.ConvertBOZ(rightType, 1, leftType);
+    if (leftType && rightType &&
+        analyzer.IsIntrinsicRelational(opr, *leftType, *rightType)) {
+      analyzer.CheckForNullPointer("as a relational operand");
       return AsMaybeExpr(Relate(context.GetContextualMessages(), opr,
           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 {
       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) {
   return RelationHelper(*this, RelationalOperator::LT, x);
 }
 
 MaybeExpr ExpressionAnalyzer::Analyze(const parser::Expr::LE &x) {
   return RelationHelper(*this, RelationalOperator::LE, x);
MaybeExpr ExpressionAnalyzer::Analyze(const parser::Expr::GT &x) {
   return RelationHelper(*this, RelationalOperator::GT, x);
 }
 
 MaybeExpr LogicalBinaryHelper(ExpressionAnalyzer &context, LogicalOperator opr,
     const parser::Expr::IntrinsicBinary &x) {
   ArgumentAnalyzer analyzer{context};
   analyzer.Analyze(std::get<0>(x.t));
   analyzer.Analyze(std::get<1>(x.t));
-  if (analyzer.fatalErrors()) {
-    return std::nullopt;
-  } else if (analyzer.IsIntrinsicLogical()) {
+  if (!analyzer.fatalErrors()) {
+    if (analyzer.IsIntrinsicLogical()) {
+      analyzer.CheckForNullPointer("as a logical operand");
       return AsGenericExpr(BinaryLogicalOperation(opr,
           std::get<Expr<SomeLogical>>(analyzer.MoveExpr(0).u),
           std::get<Expr<SomeLogical>>(analyzer.MoveExpr(1).u)));
     } else {
       return analyzer.TryDefinedOp(
           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) {
   return LogicalBinaryHelper(*this, LogicalOperator::And, x);
 }
 
 MaybeExpr ExpressionAnalyzer::Analyze(const parser::Expr::OR &x) {
   return LogicalBinaryHelper(*this, LogicalOperator::Or, x);
 }
 
 MaybeExpr ExpressionAnalyzer::Analyze(const parser::Expr::EQV &x) {
   return LogicalBinaryHelper(*this, LogicalOperator::Eqv, x);
 }
 
 MaybeExpr ExpressionAnalyzer::Analyze(const parser::Expr::NEQV &x) {
   return LogicalBinaryHelper(*this, LogicalOperator::Neqv, x);
 }
 
 MaybeExpr ExpressionAnalyzer::Analyze(const parser::Expr::DefinedBinary &x) {
   const auto &name{std::get<parser::DefinedOpName>(x.t).v};
   ArgumentAnalyzer analyzer{*this, name.source};
   analyzer.Analyze(std::get<1>(x.t));
   analyzer.Analyze(std::get<2>(x.t));
   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(
     semantics::SemanticsContext &context,
     const parser::FunctionReference &funcRef) {
   // Emit message if the function reference fix will end up an array element
   // reference with no subscripts because it will not be possible to later tell
   // the difference in expressions between empty subscript list due to bad
if (name->symbol) {
         AttachDeclaration(&msg, *name->symbol);
       }
     }
   }
 }
 
 // Converts, if appropriate, an original misparse of ambiguous syntax like
 // 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.
 template <typename... A>
 static void FixMisparsedFunctionReference(
     semantics::SemanticsContext &context, const std::variant<A...> &constU) {
   // The parse tree is updated in situ when resolving an ambiguous parse.
   using uType = std::decay_t<decltype(constU)>;
   auto &u{const_cast<uType &>(constU)};
   if (auto *func{
if (const auto &argKW{std::get<std::optional<parser::Keyword>>(arg.t)}) {
       actual->set_keyword(argKW->v.source);
     }
     actuals_.emplace_back(std::move(*actual));
   } else {
     fatalErrors_ = true;
   }
 }
 
-bool ArgumentAnalyzer::IsIntrinsicRelational(RelationalOperator opr) const {
+bool ArgumentAnalyzer::IsIntrinsicRelational(RelationalOperator opr,
+    const DynamicType &leftType, const DynamicType &rightType) const {
   CHECK(actuals_.size() == 2);
   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 {
-  std::optional<DynamicType> type0{GetType(0)};
+  std::optional<DynamicType> leftType{GetType(0)};
   if (actuals_.size() == 1) {
     if (IsBOZLiteral(0)) {
-      return opr == NumericOperator::Add;
+      return opr == NumericOperator::Add; // unary '+'
     } else {
-      return type0 && semantics::IsIntrinsicNumeric(*type0);
+      return leftType && semantics::IsIntrinsicNumeric(*leftType);
     }
   } else {
-    std::optional<DynamicType> type1{GetType(1)};
-    if (IsBOZLiteral(0) && type1) {
-      auto cat1{type1->category()};
+    std::optional<DynamicType> rightType{GetType(1)};
+    if (IsBOZLiteral(0) && rightType) { // BOZ opr Integer/Real
+      auto cat1{rightType->category()};
       return cat1 == TypeCategory::Integer || cat1 == TypeCategory::Real;
-    } else if (IsBOZLiteral(1) && type0) { // Integer/Real opr BOZ
-      auto cat0{type0->category()};
+    } else if (IsBOZLiteral(1) && leftType) { // Integer/Real opr BOZ
+      auto cat0{leftType->category()};
       return cat0 == TypeCategory::Integer || cat0 == TypeCategory::Real;
     } else {
-      return type0 && type1 &&
-          semantics::IsIntrinsicNumeric(*type0, GetRank(0), *type1, GetRank(1));
+      return leftType && rightType &&
+          semantics::IsIntrinsicNumeric(
+              *leftType, GetRank(0), *rightType, GetRank(1));
     }
   }
 }
 
 bool ArgumentAnalyzer::IsIntrinsicLogical() const {
+  if (std::optional<DynamicType> leftType{GetType(0)}) {
     if (actuals_.size() == 1) {
-    return semantics::IsIntrinsicLogical(*GetType(0));
-    return GetType(0)->category() == TypeCategory::Logical;
-  } else {
+      return semantics::IsIntrinsicLogical(*leftType);
+    } else if (std::optional<DynamicType> rightType{GetType(1)}) {
       return semantics::IsIntrinsicLogical(
-        *GetType(0), GetRank(0), *GetType(1), GetRank(1));
+          *leftType, GetRank(0), *rightType, GetRank(1));
+    }
   }
+  return false;
 }
 
 bool ArgumentAnalyzer::IsIntrinsicConcat() const {
+  if (std::optional<DynamicType> leftType{GetType(0)}) {
+    if (std::optional<DynamicType> rightType{GetType(1)}) {
       return semantics::IsIntrinsicConcat(
-      *GetType(0), GetRank(0), *GetType(1), GetRank(1));
+          *leftType, GetRank(0), *rightType, GetRank(1));
+    }
+  }
+  return false;
 }
 
-bool ArgumentAnalyzer::CheckConformance() const {
+bool ArgumentAnalyzer::CheckConformance() {
   if (actuals_.size() == 2) {
     const auto *lhs{actuals_.at(0).value().UnwrapExpr()};
     const auto *rhs{actuals_.at(1).value().UnwrapExpr()};
     if (lhs && rhs) {
       auto &foldingContext{context_.GetFoldingContext()};
       auto lhShape{GetShape(foldingContext, *lhs)};
       auto rhShape{GetShape(foldingContext, *rhs)};
       if (lhShape && rhShape) {
-        return evaluate::CheckConformance(foldingContext.messages(), *lhShape,
+        if (!evaluate::CheckConformance(foldingContext.messages(), *lhShape,
                 *rhShape, CheckConformanceFlags::EitherScalarExpandable,
                 "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
 }
 
-MaybeExpr ArgumentAnalyzer::TryDefinedOp(
-    const char *opr, parser::MessageFixedText &&error, bool isUserOp) {
-  if (AnyUntypedOrMissingOperand()) {
+bool ArgumentAnalyzer::CheckForNullPointer(const char *where) {
+  for (const std::optional<ActualArgument> &arg : actuals_) {
+    if (arg) {
+      if (const Expr<SomeType> *expr{arg->UnwrapExpr()}) {
+        if (IsNullPointer(*expr)) {
           context_.Say(
-        std::move(error), ToUpperCase(opr), TypeAsFortran(0), TypeAsFortran(1));
+              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;
+  }
+  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()};
     std::string oprNameString{
         isUserOp ? std::string{opr} : "operator("s + opr + ')'};
     parser::CharBlock oprName{oprNameString};
     const auto &scope{context_.context().FindScope(source_)};
     if (Symbol * symbol{scope.FindSymbol(oprName)}) {
+      *definedOpSymbolPtr = symbol;
       parser::Name name{symbol->name(), symbol};
       if (auto result{context_.AnalyzeDefinedOp(name, GetActuals())}) {
         return result;
       }
-      sawDefinedOp_ = symbol;
     }
     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)}) {
           return result;
         }
       }
     }
   }
-  if (sawDefinedOp_) {
-    SayNoMatch(ToUpperCase(sawDefinedOp_->name().ToString()));
+  if (*definedOpSymbolPtr) {
+    SayNoMatch(ToUpperCase((*definedOpSymbolPtr)->name().ToString()));
   } else if (actuals_.size() == 1 || AreConformable()) {
-    context_.Say(
-        std::move(error), ToUpperCase(opr), TypeAsFortran(0), TypeAsFortran(1));
+    if (CheckForNullPointer()) {
+      context_.Say(error, ToUpperCase(opr), TypeAsFortran(0), TypeAsFortran(1));
+    }
   } else {
     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());
   }
   return std::nullopt;
 }
 
 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) {
     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 TryDefinedOp(oprs[0], std::move(error));
+  return TryDefinedOp(oprs[0], error, &definedOpSymbolPtr);
 }
 
 MaybeExpr ArgumentAnalyzer::TryBoundOp(const Symbol &symbol, int passIndex) {
   ActualArguments localActuals{actuals_};
   const Symbol *proc{GetBindingResolution(GetType(passIndex), symbol)};
   if (!proc) {
     proc = &symbol;
     localActuals.at(passIndex).value().set_isPassedObject();
if (const Symbol * symbol{scope.FindSymbol(oprName)}) {
     if (const Symbol *
         specific{context_.ResolveGeneric(*symbol, actuals_, noAdjustment)}) {
       proc = specific;
     } else {
       context_.EmitGenericResolutionError(*symbol);
     }
   }
   int passedObjectIndex{-1};
+  const Symbol *definedOpSymbol{nullptr};
   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 *
           resolution{GetBindingResolution(GetType(i), *specific)}) {
         proc = resolution;
       } else {
         proc = specific;
         passedObjectIndex = i;
       }
     }
if (name->symbol && semantics::IsAssumedSizeArray(*name->symbol)) {
       auto restorer{context_.AllowWholeAssumedSizeArray()};
       return context_.Analyze(expr);
     }
   }
   return context_.Analyze(expr);
 }
 
 bool ArgumentAnalyzer::AreConformable() const {
-  CHECK(!fatalErrors_ && actuals_.size() == 2);
-  return evaluate::AreConformable(*actuals_[0], *actuals_[1]);
+  CHECK(actuals_.size() == 2);
+  return actuals_[0] && actuals_[1] &&
+      evaluate::AreConformable(*actuals_[0], *actuals_[1]);
 }
 
 // Look for a type-bound operator in the type of arg number passIndex.
 const Symbol *ArgumentAnalyzer::FindBoundOp(
-    parser::CharBlock oprName, int passIndex) {
+    parser::CharBlock oprName, int passIndex, const Symbol *&definedOp) {
   const auto *type{GetDerivedTypeSpec(GetType(passIndex))};
   if (!type || !type->scope()) {
     return nullptr;
   }
   const Symbol *symbol{type->scope()->FindComponent(oprName)};
   if (!symbol) {
     return nullptr;
   }
-  sawDefinedOp_ = symbol;
+  definedOp = symbol;
   ExpressionAnalyzer::AdjustActuals adjustment{
       [&](const Symbol &proc, ActualArguments &) {
         return passIndex == GetPassIndex(proc);
       }};
   const Symbol *result{context_.ResolveGeneric(*symbol, actuals_, adjustment)};
   if (!result) {
     context_.EmitGenericResolutionError(*symbol);
   }

 int ArgumentAnalyzer::GetRank(std::size_t i) const {
   return i < actuals_.size() ? actuals_[i].value().Rank() : 0;
 }
 
 // If the argument at index i is a BOZ literal, convert its type to match the
 // otherType.  If it's REAL convert to REAL, otherwise convert to INTEGER.
 // Note that IBM supports comparing BOZ literals to CHARACTER operands.  That
 // is not currently supported.
-void ArgumentAnalyzer::ConvertBOZ(
+void ArgumentAnalyzer::ConvertBOZ(std::optional<DynamicType> &thisType,
     std::size_t i, std::optional<DynamicType> otherType) {
   if (IsBOZLiteral(i)) {
     Expr<SomeType> &&argExpr{MoveExpr(i)};
     auto *boz{std::get_if<BOZLiteralConstant>(&argExpr.u)};
     if (otherType && otherType->category() == TypeCategory::Real) {
-      MaybeExpr realExpr{ConvertToKind<TypeCategory::Real>(
-          context_.context().GetDefaultKind(TypeCategory::Real),
-          std::move(*boz))};
+      int kind{context_.context().GetDefaultKind(TypeCategory::Real)};
+      MaybeExpr realExpr{
+          ConvertToKind<TypeCategory::Real>(kind, std::move(*boz))};
       actuals_[i] = std::move(*realExpr);
+      thisType.emplace(TypeCategory::Real, kind);
     } else {
-      MaybeExpr intExpr{ConvertToKind<TypeCategory::Integer>(
-          context_.context().GetDefaultKind(TypeCategory::Integer),
-          std::move(*boz))};
+      int kind{context_.context().GetDefaultKind(TypeCategory::Integer)};
+      MaybeExpr intExpr{
+          ConvertToKind<TypeCategory::Integer>(kind, std::move(*boz))};
       actuals_[i] = std::move(*intExpr);
+      thisType.emplace(TypeCategory::Integer, kind);
     }
   }
 }
 
 // Report error resolving opr when there is a user-defined one available
 void ArgumentAnalyzer::SayNoMatch(const std::string &opr, bool isAssignment) {
   std::string type0{TypeAsFortran(0)};
   auto rank0{actuals_[0]->Rank()};
bool ArgumentAnalyzer::AnyUntypedOrMissingOperand() {
   for (const auto &actual : actuals_) {
     if (!actual || !actual->GetType()) {
       return true;
     }
   }
   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::semantics {
 evaluate::Expr<evaluate::SubscriptInteger> AnalyzeKindSelector(
     SemanticsContext &context, common::TypeCategory category,
     const std::optional<parser::KindSelector> &selector) {
   evaluate::ExpressionAnalyzer analyzer{context};
   auto restorer{

flang/test/Semantics/resolve63.f90

 module m3
   interface operator(+)
     logical function add(x, y)
       logical, intent(in) :: x
       integer, value :: y
     end
   end interface
 contains
-  subroutine s1(x, y) 
+  subroutine s1(x, y)
     logical :: x
     integer :: y
     integer, pointer :: px
     logical :: l
     complex :: z
     y = y + z'1'  !OK
     !ERROR: Operands of + must be numeric; have 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'
-    !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()
-    !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)
-    !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)
-    !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()
-    !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)
-    !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()
   end
 end
 
 ! Test alternate operators. They aren't enabled by default so should be
 ! treated as defined operators, not intrinsic ones.
 module m4
 contains
subroutine test(x, y, z)
     i = x + i
     i = y + i
     !ERROR: No intrinsic or user-defined OPERATOR(+) matches operand types TYPE(t2) and TYPE(t1)
     i = y + x
     !ERROR: No intrinsic or user-defined OPERATOR(+) matches operand types INTEGER(4) and TYPE(t1)
     i = i + x
   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