[flang] Procedure distinguishability rules for operators

Generic operators and assignment have different rules than generic
names for their procedures being distinguishable.

Implement those rules in `DistinguishableOpOrAssign`. The rules are
considerably simpler: they must have the name number of dummy arguments
and at least one pair in the same position must be distinguishable.

Fixes issue flang-compiler/f18#563.

Original-commit: flang-compiler/f18@276bb08206
Reviewed-on: https://github.com/flang-compiler/f18/pull/576

flang/lib/evaluate/characteristics.cc

@@ -448,8 +448,10 @@ std::ostream &Procedure::Dump(std::ostream &o) const {
 // Utility class to determine if Procedures, etc. are distinguishable
 class DistinguishUtils {
 public:
-  // Is x distinguishable from y
+  // Are these procedures distinguishable for a generic name?
   static bool Distinguishable(const Procedure &, const Procedure &);
+  // Are these procedures distinguishable for a generic operator or assignment?
+  static bool DistinguishableOpOrAssign(const Procedure &, const Procedure &);
 
 private:
   struct CountDummyProcedures {
@@ -487,6 +489,22 @@ private:
   static const DummyArgument *GetPassArg(const Procedure &);
 };
 
+// Simpler distinguishability rules for operators and assignment
+bool DistinguishUtils::DistinguishableOpOrAssign(
+    const Procedure &proc1, const Procedure &proc2) {
+  auto &args1{proc1.dummyArguments};
+  auto &args2{proc2.dummyArguments};
+  if (args1.size() != args2.size()) {
+    return true;  // C1511: distinguishable based on number of arguments
+  }
+  for (std::size_t i{0}; i < args1.size(); ++i) {
+    if (Distinguishable(args1[i], args2[i])) {
+      return true;  // C1511, C1512: distinguishable based on this arg
+    }
+  }
+  return false;
+}
+
 bool DistinguishUtils::Distinguishable(
     const Procedure &proc1, const Procedure &proc2) {
   auto &args1{proc1.dummyArguments};
@@ -722,6 +740,10 @@ bool Distinguishable(const Procedure &x, const Procedure &y) {
   return DistinguishUtils::Distinguishable(x, y);
 }
 
+bool DistinguishableOpOrAssign(const Procedure &x, const Procedure &y) {
+  return DistinguishUtils::DistinguishableOpOrAssign(x, y);
+}
+
 DEFINE_DEFAULT_CONSTRUCTORS_AND_ASSIGNMENTS(DummyArgument)
 DEFINE_DEFAULT_CONSTRUCTORS_AND_ASSIGNMENTS(DummyProcedure)
 DEFINE_DEFAULT_CONSTRUCTORS_AND_ASSIGNMENTS(FunctionResult)

flang/lib/evaluate/characteristics.h

@@ -47,8 +47,10 @@ namespace Fortran::evaluate::characteristics {
 
 using common::CopyableIndirection;
 
-// Can these two procedures be distinguished based on C1514.
+// Are these procedures distinguishable for a generic name?
 bool Distinguishable(const Procedure &, const Procedure &);
+// Are these procedures distinguishable for a generic operator or assignment?
+bool DistinguishableOpOrAssign(const Procedure &, const Procedure &);
 
 class TypeAndShape {
 public:
@@ -145,7 +147,7 @@ struct DummyArgument {
   bool IsOptional() const;
   void SetOptional(bool = true);
   std::ostream &Dump(std::ostream &) const;
-  // name and pass are not a characteristics and so does not participate in
+  // name and pass are not characteristics and so does not participate in
   // operator== but are needed to determine if procedures are distinguishable
   std::string name;
   bool pass{false};  // is this the PASS argument of its procedure

flang/lib/semantics/resolve-names.cc

@@ -2235,6 +2235,22 @@ void InterfaceVisitor::SayNotDistinguishable(
   }
 }
 
+static GenericKind GetGenericKind(const Symbol &generic) {
+  return std::visit(
+      common::visitors{
+          [&](const GenericDetails &x) { return x.kind(); },
+          [&](const GenericBindingDetails &x) { return x.kind(); },
+          [](auto &) -> GenericKind { DIE("not a generic"); },
+      },
+      generic.details());
+}
+
+static bool IsOperatorOrAssignment(const Symbol &generic) {
+  auto kind{GetGenericKind(generic)};
+  return kind == GenericKind::DefinedOp || kind == GenericKind::Assignment ||
+      (kind >= GenericKind::OpPower && kind <= GenericKind::OpNEQV);
+}
+
 // Check that the specifics of this generic are distinguishable from each other
 void InterfaceVisitor::CheckSpecificsAreDistinguishable(
     const Symbol &generic, const SymbolVector &specifics) {
@@ -2242,6 +2258,9 @@ void InterfaceVisitor::CheckSpecificsAreDistinguishable(
   if (specifics.size() < 2) {
     return;
   }
+  auto distinguishable{IsOperatorOrAssignment(generic)
+          ? evaluate::characteristics::DistinguishableOpOrAssign
+          : evaluate::characteristics::Distinguishable};
   using evaluate::characteristics::Procedure;
   std::vector<Procedure> procs;
   for (const Symbol *symbol : specifics) {
@@ -2255,7 +2274,7 @@ void InterfaceVisitor::CheckSpecificsAreDistinguishable(
     auto &proc1{procs[i1]};
     for (std::size_t i2{i1 + 1}; i2 < count; ++i2) {
       auto &proc2{procs[i2]};
-      if (!evaluate::characteristics::Distinguishable(proc1, proc2)) {
+      if (!distinguishable(proc1, proc2)) {
         SayNotDistinguishable(generic, *specifics[i1], *specifics[i2]);
       }
     }

flang/test/semantics/resolve53.f90

@@ -377,3 +377,50 @@ contains
     class(t(2)) :: y
   end
 end
+
+! C1512 - rules for assignment
+! s1 and s2 are not distinguishable for a generic name but they are
+! for assignment
+module m19
+  interface assignment(=)
+    module procedure s1
+    module procedure s2
+  end interface
+  !ERROR: Generic 'g' may not have specific procedures 's1' and 's2' as their interfaces are not distinguishable
+  interface g
+    module procedure s1
+    module procedure s2
+  end interface
+contains
+  subroutine s1(d, p)
+    real, intent(out) :: d
+    integer, intent(in) :: p
+  end subroutine
+  subroutine s2(p, d)
+    integer, intent(out) :: p
+    real, intent(in) :: d
+  end subroutine
+end module
+
+! C1511 - rules for operators
+module m20
+  interface operator(.foo.)
+    module procedure f1
+    module procedure f2
+  end interface
+  !ERROR: Generic operator '.bar.' may not have specific procedures 'f2' and 'f3' as their interfaces are not distinguishable
+  interface operator(.bar.)
+    module procedure f2
+    module procedure f3
+  end interface
+contains
+  integer function f1(i)
+    integer :: i
+  end
+  integer function f2(i, j)
+    integer :: i, j
+  end
+  integer function f3(i, j)
+    integer :: i, j
+  end
+end