[flang] Warn about defined operator with too few/many dummy arguments

A function in a defined operator generic interface will syntactically
have one or two arguments.  If a defined operator includes a specific
function with 0 or more than 2 dummy arguments, there's no way that it
could be invoked by way of the interface.  Emit a warning.

Differential Revision: https://reviews.llvm.org/D142762

flang/include/flang/Parser/message.h

@@ -59,7 +59,7 @@ public:
     severity_ = severity;
     return *this;
   }
-  bool isFatal() const {
+  bool IsFatal() const {
     return severity_ == Severity::Error || severity_ == Severity::Todo;
   }
 
@@ -111,7 +111,7 @@ public:
   MessageFormattedText &operator=(const MessageFormattedText &) = default;
   MessageFormattedText &operator=(MessageFormattedText &&) = default;
   const std::string &string() const { return string_; }
-  bool isFatal() const {
+  bool IsFatal() const {
     return severity_ == Severity::Error || severity_ == Severity::Todo;
   }
   Severity severity() const { return severity_; }

flang/lib/Semantics/check-declarations.cpp

@@ -1451,9 +1451,12 @@ bool CheckHelper::CheckDefinedOperator(SourceName opName, GenericKind kind,
   } else {
     return true; // OK
   }
+  bool isFatal{msg->IsFatal()};
   SayWithDeclaration(
       specific, std::move(*msg), MakeOpName(opName), specific.name());
-  context_.SetError(specific);
+  if (isFatal) {
+    context_.SetError(specific);
+  }
   return false;
 }
 
@@ -1462,6 +1465,9 @@ bool CheckHelper::CheckDefinedOperator(SourceName opName, GenericKind kind,
 std::optional<parser::MessageFixedText> CheckHelper::CheckNumberOfArgs(
     const GenericKind &kind, std::size_t nargs) {
   if (!kind.IsIntrinsicOperator()) {
+    if (nargs < 1 || nargs > 2) {
+      return "%s function '%s' should have 1 or 2 dummy arguments"_warn_en_US;
+    }
     return std::nullopt;
   }
   std::size_t min{2}, max{2}; // allowed number of args; default is binary

flang/lib/Semantics/resolve-names.cpp

@@ -2155,19 +2155,21 @@ void ScopeHandler::SayAlreadyDeclared(
 
 void ScopeHandler::SayWithReason(const parser::Name &name, Symbol &symbol,
     MessageFixedText &&msg1, Message &&msg2) {
+  bool isFatal{msg1.IsFatal()};
   Say(name, std::move(msg1), symbol.name()).Attach(std::move(msg2));
-  context().SetError(symbol, msg1.isFatal());
+  context().SetError(symbol, isFatal);
 }
 
 void ScopeHandler::SayWithDecl(
     const parser::Name &name, Symbol &symbol, MessageFixedText &&msg) {
+  bool isFatal{msg.IsFatal()};
   Say(name, std::move(msg), symbol.name())
       .Attach(Message{name.source,
           symbol.test(Symbol::Flag::Implicit)
               ? "Implicit declaration of '%s'"_en_US
               : "Declaration of '%s'"_en_US,
           name.source});
-  context().SetError(symbol, msg.isFatal());
+  context().SetError(symbol, isFatal);
 }
 
 void ScopeHandler::SayLocalMustBeVariable(
@@ -2190,13 +2192,15 @@ void ScopeHandler::Say2(const SourceName &name1, MessageFixedText &&msg1,
 }
 void ScopeHandler::Say2(const SourceName &name, MessageFixedText &&msg1,
     Symbol &symbol, MessageFixedText &&msg2) {
+  bool isFatal{msg1.IsFatal()};
   Say2(name, std::move(msg1), symbol.name(), std::move(msg2));
-  context().SetError(symbol, msg1.isFatal());
+  context().SetError(symbol, isFatal);
 }
 void ScopeHandler::Say2(const parser::Name &name, MessageFixedText &&msg1,
     Symbol &symbol, MessageFixedText &&msg2) {
+  bool isFatal{msg1.IsFatal()};
   Say2(name.source, std::move(msg1), symbol.name(), std::move(msg2));
-  context().SetError(symbol, msg1.isFatal());
+  context().SetError(symbol, isFatal);
 }
 
 // This is essentially GetProgramUnitContaining(), but it can return

flang/test/Semantics/generic04.f90

@@ -0,0 +1,28 @@
+! RUN: %python %S/test_errors.py %s %flang_fc1
+! Warn about inaccessible specific procedures in a generic defined operator
+module m
+  interface operator (.foo.)
+    !WARN: OPERATOR(.foo.) function 'noargs' must have 1 or 2 dummy arguments
+    module procedure noargs
+    !WARN: OPERATOR(.foo.) function 'noargs' must have 1 or 2 dummy arguments
+    module procedure threeargs
+  end interface
+  type t
+   contains
+    procedure :: bad
+    !WARN: OPERATOR(.bar.) function 'bad' should have 1 or 2 dummy arguments
+    generic :: operator (.bar.) => bad
+  end type
+ contains
+  real function noargs()
+    noargs = 0.
+  end
+  real function threeargs(fee,fie,foe)
+    real, intent(in) :: fee, fie, foe
+  end
+  function bad(this,x,y)
+    type(t) :: bad
+    class(t), intent(in) :: this, x, y
+    bad = x
+  end
+end