[flang] Restore error status for many indistinguishable specifics (#79927)

A recent patch to allow pFUnit to compile softened the diagnostic about
indistinguishable specific procedures to a portability warning. It turns
out that this was overkill -- for specific procedures containing no
optional or unlimited polymorphic dummy data arguments, a diagnosis of
"indistinguishable" can still be a hard error.

So adjust the analysis to be tri-state: two procedures are either
definitely distinguishable, definitely indistinguishable without
optionals or unlimited polymorphics, or indeterminate. Emit errors as
before for the definitely indistinguishable cases; continue to emit
portability warnings for the indeterminate cases.

When this patch is merged, all but one of the dozen or so tests that I
disabled in llvm-test-suite can be re-enabled.

Author: klausler

flang/include/flang/Evaluate/characteristics.h

@@ -45,11 +45,12 @@ namespace Fortran::evaluate::characteristics {
 using common::CopyableIndirection;
 
 // Are these procedures distinguishable for a generic name or FINAL?
-bool Distinguishable(const common::LanguageFeatureControl &, const Procedure &,
-    const Procedure &);
-// Are these procedures distinguishable for a generic operator or assignment?
-bool DistinguishableOpOrAssign(const common::LanguageFeatureControl &,
+std::optional<bool> Distinguishable(const common::LanguageFeatureControl &,
     const Procedure &, const Procedure &);
+// Are these procedures distinguishable for a generic operator or assignment?
+std::optional<bool> DistinguishableOpOrAssign(
+    const common::LanguageFeatureControl &, const Procedure &,
+    const Procedure &);
 
 // Shapes of function results and dummy arguments have to have
 // the same rank, the same deferred dimensions, and the same

flang/lib/Evaluate/characteristics.cpp

@@ -1456,9 +1456,11 @@ class DistinguishUtils {
       : features_{features} {}
 
   // Are these procedures distinguishable for a generic name?
-  bool Distinguishable(const Procedure &, const Procedure &) const;
+  std::optional<bool> Distinguishable(
+      const Procedure &, const Procedure &) const;
   // Are these procedures distinguishable for a generic operator or assignment?
-  bool DistinguishableOpOrAssign(const Procedure &, const Procedure &) const;
+  std::optional<bool> DistinguishableOpOrAssign(
+      const Procedure &, const Procedure &) const;
 
 private:
   struct CountDummyProcedures {
@@ -1474,6 +1476,8 @@ class DistinguishUtils {
     int notOptional{0};
   };
 
+  bool AnyOptionalData(const DummyArguments &) const;
+  bool AnyUnlimitedPolymorphicData(const DummyArguments &) const;
   bool Rule3Distinguishable(const Procedure &, const Procedure &) const;
   const DummyArgument *Rule1DistinguishingArg(
       const DummyArguments &, const DummyArguments &) const;
@@ -1500,7 +1504,7 @@ class DistinguishUtils {
 };
 
 // Simpler distinguishability rules for operators and assignment
-bool DistinguishUtils::DistinguishableOpOrAssign(
+std::optional<bool> DistinguishUtils::DistinguishableOpOrAssign(
     const Procedure &proc1, const Procedure &proc2) const {
   if ((proc1.IsFunction() && proc2.IsSubroutine()) ||
       (proc1.IsSubroutine() && proc2.IsFunction())) {
@@ -1519,7 +1523,7 @@ bool DistinguishUtils::DistinguishableOpOrAssign(
   return false;
 }
 
-bool DistinguishUtils::Distinguishable(
+std::optional<bool> DistinguishUtils::Distinguishable(
     const Procedure &proc1, const Procedure &proc2) const {
   if ((proc1.IsFunction() && proc2.IsSubroutine()) ||
       (proc1.IsSubroutine() && proc2.IsFunction())) {
@@ -1551,6 +1555,35 @@ bool DistinguishUtils::Distinguishable(
   if (proc1.cudaSubprogramAttrs != proc2.cudaSubprogramAttrs) {
     return true;
   }
+  // If there are no optional or unlimited polymorphic dummy arguments,
+  // then we know the result for sure; otherwise, it's possible for
+  // the procedures to be unambiguous.
+  if ((AnyOptionalData(args1) || AnyUnlimitedPolymorphicData(args1)) &&
+      (AnyOptionalData(args2) || AnyUnlimitedPolymorphicData(args2))) {
+    return std::nullopt; // meaning "maybe"
+  } else {
+    return false;
+  }
+}
+
+bool DistinguishUtils::AnyOptionalData(const DummyArguments &args) const {
+  for (const auto &arg : args) {
+    if (std::holds_alternative<DummyDataObject>(arg.u) && arg.IsOptional()) {
+      return true;
+    }
+  }
+  return false;
+}
+
+bool DistinguishUtils::AnyUnlimitedPolymorphicData(
+    const DummyArguments &args) const {
+  for (const auto &arg : args) {
+    if (const auto *object{std::get_if<DummyDataObject>(&arg.u)}) {
+      if (object->type.type().IsUnlimitedPolymorphic()) {
+        return true;
+      }
+    }
+  }
   return false;
 }
 
@@ -1704,7 +1737,7 @@ bool DistinguishUtils::Distinguishable(
     const DummyProcedure &x, const DummyProcedure &y) const {
   const Procedure &xProc{x.procedure.value()};
   const Procedure &yProc{y.procedure.value()};
-  if (Distinguishable(xProc, yProc)) {
+  if (Distinguishable(xProc, yProc).value_or(false)) {
     return true;
   } else {
     const std::optional<FunctionResult> &xResult{xProc.functionResult};
@@ -1730,7 +1763,8 @@ bool DistinguishUtils::Distinguishable(
           },
           [&](const CopyableIndirection<Procedure> &z) {
             return Distinguishable(z.value(),
-                std::get<CopyableIndirection<Procedure>>(y.u).value());
+                std::get<CopyableIndirection<Procedure>>(y.u).value())
+                .value_or(false);
           },
       },
       x.u);
@@ -1795,13 +1829,15 @@ const DummyArgument *DistinguishUtils::GetPassArg(const Procedure &proc) const {
   return nullptr;
 }
 
-bool Distinguishable(const common::LanguageFeatureControl &features,
-    const Procedure &x, const Procedure &y) {
+std::optional<bool> Distinguishable(
+    const common::LanguageFeatureControl &features, const Procedure &x,
+    const Procedure &y) {
   return DistinguishUtils{features}.Distinguishable(x, y);
 }
 
-bool DistinguishableOpOrAssign(const common::LanguageFeatureControl &features,
-    const Procedure &x, const Procedure &y) {
+std::optional<bool> DistinguishableOpOrAssign(
+    const common::LanguageFeatureControl &features, const Procedure &x,
+    const Procedure &y) {
   return DistinguishUtils{features}.DistinguishableOpOrAssign(x, y);
 }
 

flang/lib/Semantics/check-declarations.cpp

@@ -192,7 +192,7 @@ class DistinguishabilityHelper {
 
 private:
   void SayNotDistinguishable(const Scope &, const SourceName &, GenericKind,
-      const Symbol &, const Symbol &);
+      const Symbol &, const Symbol &, bool isError);
   void AttachDeclaration(parser::Message &, const Scope &, const Symbol &);
 
   SemanticsContext &context_;
@@ -1704,8 +1704,9 @@ bool CheckHelper::CheckDistinguishableFinals(const Symbol &f1,
   const Procedure *p1{Characterize(f1)};
   const Procedure *p2{Characterize(f2)};
   if (p1 && p2) {
-    if (characteristics::Distinguishable(
-            context_.languageFeatures(), *p1, *p2)) {
+    std::optional<bool> areDistinct{characteristics::Distinguishable(
+        context_.languageFeatures(), *p1, *p2)};
+    if (areDistinct.value_or(false)) {
       return true;
     }
     if (auto *msg{messages_.Say(f1Name,
@@ -3519,10 +3520,11 @@ void DistinguishabilityHelper::Check(const Scope &scope) {
         auto distinguishable{kind.IsName()
                 ? evaluate::characteristics::Distinguishable
                 : evaluate::characteristics::DistinguishableOpOrAssign};
-        if (!distinguishable(
-                context_.languageFeatures(), proc, iter2->second.procedure)) {
+        std::optional<bool> distinct{distinguishable(
+            context_.languageFeatures(), proc, iter2->second.procedure)};
+        if (!distinct.value_or(false)) {
           SayNotDistinguishable(GetTopLevelUnitContaining(scope), name, kind,
-              *ultimate, *iter2->first);
+              *ultimate, *iter2->first, distinct.has_value());
         }
       }
     }
@@ -3531,15 +3533,15 @@ void DistinguishabilityHelper::Check(const Scope &scope) {
 
 void DistinguishabilityHelper::SayNotDistinguishable(const Scope &scope,
     const SourceName &name, GenericKind kind, const Symbol &proc1,
-    const Symbol &proc2) {
-  if (!context_.ShouldWarn(
+    const Symbol &proc2, bool isError) {
+  if (!isError &&
+      !context_.ShouldWarn(
           common::LanguageFeature::IndistinguishableSpecifics)) {
     // The rules for distinguishing specific procedures (F'2023 15.4.3.4.5)
-    // are inadequate for some real-world cases like pFUnit, which has
-    // some generic interfaces whose specific procedures are provably
-    // unambiguous, but fail all of the standard's criteria for being
-    // conformably distinct.  So the best we can do here is to emit optional
-    // portability warnings for such cases.
+    // are inadequate for some real-world cases like pFUnit.
+    // When there are optional dummy arguments or unlimited polymorphic
+    // dummy data object arguments, the best that we can do is emit an optional
+    // portability warning.
     return;
   }
   std::string name1{proc1.name().ToString()};
@@ -3556,11 +3558,15 @@ void DistinguishabilityHelper::SayNotDistinguishable(const Scope &scope,
   parser::Message *msg;
   if (scope.sourceRange().Contains(name)) {
     msg = &context_.Say(name,
-        "Generic '%s' should not have specific procedures '%s' and '%s' as their interfaces are not distinguishable by the incomplete rules in the standard"_port_en_US,
+        isError
+            ? "Generic '%s' may not have specific procedures '%s' and '%s' as their interfaces are not distinguishable"_err_en_US
+            : "Generic '%s' should not have specific procedures '%s' and '%s' as their interfaces are not distinguishable by the rules in the standard"_port_en_US,
         MakeOpName(name), name1, name2);
   } else {
     msg = &context_.Say(*GetTopLevelUnitContaining(proc1).GetName(),
-        "USE-associated generic '%s' should not have specific procedures '%s' and '%s' as their interfaces are not distinguishable by the incomplete rules in the standard"_port_en_US,
+        isError
+            ? "USE-associated generic '%s' may not have specific procedures '%s' and '%s' as their interfaces are not distinguishable"_err_en_US
+            : "USE-associated generic '%s' should not have specific procedures '%s' and '%s' as their interfaces are not distinguishable by the incomplete rules in the standard"_port_en_US,
         MakeOpName(name), name1, name2);
   }
   AttachDeclaration(*msg, scope, proc1);

flang/test/Semantics/generic05.F90

@@ -1,12 +1,12 @@
-! RUN: %python %S/test_errors.py %s %flang_fc1 -pedantic
+! RUN: %python %S/test_errors.py %s %flang_fc1
 ! Check for distinguishability of defined I/O procedures defined within
 ! and outside their types.
 module m1
   type t1
     integer n
    contains
     procedure :: readt1a, readt1b
-    !PORTABILITY: Generic 'read(unformatted)' should not have specific procedures 'readt1a' and 'readt1b' as their interfaces are not distinguishable by the incomplete rules in the standard
+    !ERROR: Generic 'read(unformatted)' may not have specific procedures 'readt1a' and 'readt1b' as their interfaces are not distinguishable
     generic :: read(unformatted) => readt1a, readt1b
   end type
   type t2
@@ -15,7 +15,7 @@ module m1
   type t3
     integer n
   end type
-  !PORTABILITY: Generic 'read(unformatted)' should not have specific procedures 'readt2a' and 'readt2b' as their interfaces are not distinguishable by the incomplete rules in the standard
+  !ERROR: Generic 'read(unformatted)' may not have specific procedures 'readt2a' and 'readt2b' as their interfaces are not distinguishable
   interface read(unformatted)
     module procedure :: readt1a, readt2a, readt2b, readt3
   end interface

flang/test/Semantics/generic07.f90

@@ -1,4 +1,4 @@
-! RUN: %python %S/test_errors.py %s %flang_fc1 -pedantic -Werror
+! RUN: %python %S/test_errors.py %s %flang_fc1
 module m1
   type :: t1
     sequence
@@ -74,7 +74,7 @@ program test
   interface distinguishable3
     procedure :: s1a, s1b
   end interface
-  !PORTABILITY: Generic 'indistinguishable' should not have specific procedures 's2b' and 's2a' as their interfaces are not distinguishable by the incomplete rules in the standard
+  !ERROR: Generic 'indistinguishable' may not have specific procedures 's2b' and 's2a' as their interfaces are not distinguishable
   interface indistinguishable
     procedure :: s2a, s2b
   end interface

flang/test/Semantics/resolve17.f90

@@ -96,7 +96,7 @@ subroutine sb(y)
   end
 end
 subroutine s6
-  !ERROR: Generic 'g' should not have specific procedures 'sa' and 'sb' as their interfaces are not distinguishable by the incomplete rules in the standard
+  !ERROR: Generic 'g' may not have specific procedures 'sa' and 'sb' as their interfaces are not distinguishable
   use m6a, g => gg
   use m6b, g => gg
 end
@@ -180,7 +180,7 @@ subroutine g()
   end
 end module
 subroutine s9
-  !PORTABILITY: USE-associated generic 'g' should not have specific procedures 'g' and 'g' as their interfaces are not distinguishable by the incomplete rules in the standard
+  !ERROR: USE-associated generic 'g' may not have specific procedures 'g' and 'g' as their interfaces are not distinguishable
   use m9a
   use m9b
 end
@@ -197,7 +197,7 @@ subroutine s(x)
 end
 module m10b
   use m10a
-  !PORTABILITY: Generic 'g' should not have specific procedures 's' and 's' as their interfaces are not distinguishable by the incomplete rules in the standard
+  !ERROR: Generic 'g' may not have specific procedures 's' and 's' as their interfaces are not distinguishable
   interface g
     module procedure s
   end interface