[flang] Silence impossible error about SMP interface incompatibility

[klausler]

It is possible for the compiler to emit an impossible error message about dummy argument character length incompatibility in the case of a MODULE SUBROUTINE or FUNCTION defined later in a submodule with MODULE PROCEDURE, when the character length is defined by USE association in its interface. The checking for separate module procedure interface compatibility needs to use a more flexible check than just operator== on a semantics::ParamValue.

[llvmbot]

@llvm/pr-subscribers-flang-semantics

Author: Peter Klausler (klausler)

Changes

It is possible for the compiler to emit an impossible error message about dummy argument character length incompatibility in the case of a MODULE SUBROUTINE or FUNCTION defined later in a submodule with MODULE PROCEDURE, when the character length is defined by USE association in its interface. The checking for separate module procedure interface compatibility needs to use a more flexible check than just operator== on a semantics::ParamValue.

---

Full diff: https://github.com/llvm/llvm-project/pull/112054.diff

6 Files Affected:

• (modified) flang/include/flang/Evaluate/tools.h (+5-1)
• (modified) flang/include/flang/Semantics/type.h (+1)
• (modified) flang/lib/Evaluate/tools.cpp (+14-2)
• (modified) flang/lib/Evaluate/type.cpp (+4-1)
• (modified) flang/lib/Semantics/type.cpp (+6)
• (added) flang/test/Semantics/smp-def01.f90 (+23)

diff --git a/flang/include/flang/Evaluate/tools.h b/flang/include/flang/Evaluate/tools.h
index d2887b69cc6de1..f547138f5a116c 100644
--- a/flang/include/flang/Evaluate/tools.h
+++ b/flang/include/flang/Evaluate/tools.h
@@ -1252,8 +1252,12 @@ class ArrayConstantBoundChanger {
 // Predicate: should two expressions be considered identical for the purposes
 // of determining whether two procedure interfaces are compatible, modulo
 // naming of corresponding dummy arguments?
-std::optional<bool> AreEquivalentInInterface(
+template <typename T>
+std::optional<bool> AreEquivalentInInterface(const Expr<T> &, const Expr<T> &);
+extern template std::optional<bool> AreEquivalentInInterface<SubscriptInteger>(
     const Expr<SubscriptInteger> &, const Expr<SubscriptInteger> &);
+extern template std::optional<bool> AreEquivalentInInterface<SomeInteger>(
+    const Expr<SomeInteger> &, const Expr<SomeInteger> &);
 
 bool CheckForCoindexedObject(parser::ContextualMessages &,
     const std::optional<ActualArgument> &, const std::string &procName,
diff --git a/flang/include/flang/Semantics/type.h b/flang/include/flang/Semantics/type.h
index e2131e7e160cb6..1292c381b65f72 100644
--- a/flang/include/flang/Semantics/type.h
+++ b/flang/include/flang/Semantics/type.h
@@ -110,6 +110,7 @@ class ParamValue {
     return category_ == that.category_ && expr_ == that.expr_;
   }
   bool operator!=(const ParamValue &that) const { return !(*this == that); }
+  bool IsEquivalentInInterface(const ParamValue &) const;
   std::string AsFortran() const;
 
 private:
diff --git a/flang/lib/Evaluate/tools.cpp b/flang/lib/Evaluate/tools.cpp
index c2545a87099426..4d98220a7065ca 100644
--- a/flang/lib/Evaluate/tools.cpp
+++ b/flang/lib/Evaluate/tools.cpp
@@ -1320,8 +1320,10 @@ std::optional<Expr<SomeType>> HollerithToBOZ(FoldingContext &context,
 
 // Extracts a whole symbol being used as a bound of a dummy argument,
 // possibly wrapped with parentheses or MAX(0, ...).
+// Works with any integer expression.
+template <typename T> const Symbol *GetBoundSymbol(const Expr<T> &);
 template <int KIND>
-static const Symbol *GetBoundSymbol(
+const Symbol *GetBoundSymbol(
     const Expr<Type<TypeCategory::Integer, KIND>> &expr) {
   using T = Type<TypeCategory::Integer, KIND>;
   return common::visit(
@@ -1358,9 +1360,15 @@ static const Symbol *GetBoundSymbol(
       },
       expr.u);
 }
+template <>
+const Symbol *GetBoundSymbol<SomeInteger>(const Expr<SomeInteger> &expr) {
+  return common::visit(
+      [](const auto &kindExpr) { return GetBoundSymbol(kindExpr); }, expr.u);
+}
 
+template <typename T>
 std::optional<bool> AreEquivalentInInterface(
-    const Expr<SubscriptInteger> &x, const Expr<SubscriptInteger> &y) {
+    const Expr<T> &x, const Expr<T> &y) {
   auto xVal{ToInt64(x)};
   auto yVal{ToInt64(y)};
   if (xVal && yVal) {
@@ -1394,6 +1402,10 @@ std::optional<bool> AreEquivalentInInterface(
     return std::nullopt; // not sure
   }
 }
+template std::optional<bool> AreEquivalentInInterface<SubscriptInteger>(
+    const Expr<SubscriptInteger> &, const Expr<SubscriptInteger> &);
+template std::optional<bool> AreEquivalentInInterface<SomeInteger>(
+    const Expr<SomeInteger> &, const Expr<SomeInteger> &);
 
 bool CheckForCoindexedObject(parser::ContextualMessages &messages,
     const std::optional<ActualArgument> &arg, const std::string &procName,
diff --git a/flang/lib/Evaluate/type.cpp b/flang/lib/Evaluate/type.cpp
index a1df40667471ad..c00688853cd006 100644
--- a/flang/lib/Evaluate/type.cpp
+++ b/flang/lib/Evaluate/type.cpp
@@ -518,7 +518,10 @@ static bool AreSameDerivedType(
 
 bool DynamicType::IsEquivalentTo(const DynamicType &that) const {
   return category_ == that.category_ && kind_ == that.kind_ &&
-      PointeeComparison(charLengthParamValue_, that.charLengthParamValue_) &&
+      (charLengthParamValue_ == that.charLengthParamValue_ ||
+          (charLengthParamValue_ && that.charLengthParamValue_ &&
+              charLengthParamValue_->IsEquivalentInInterface(
+                  *that.charLengthParamValue_))) &&
       knownLength().has_value() == that.knownLength().has_value() &&
       (!knownLength() || *knownLength() == *that.knownLength()) &&
       AreSameDerivedType(derived_, that.derived_);
diff --git a/flang/lib/Semantics/type.cpp b/flang/lib/Semantics/type.cpp
index e867d7ad6e2536..7f5f4e98a7d6c1 100644
--- a/flang/lib/Semantics/type.cpp
+++ b/flang/lib/Semantics/type.cpp
@@ -758,6 +758,12 @@ void ParamValue::SetExplicit(SomeIntExpr &&x) {
   expr_ = std::move(x);
 }
 
+bool ParamValue::IsEquivalentInInterface(const ParamValue &that) const {
+  return (category_ == that.category_ &&
+      expr_.has_value() == that.expr_.has_value() &&
+      (!expr_ || evaluate::AreEquivalentInInterface(*expr_, *that.expr_)));
+}
+
 std::string ParamValue::AsFortran() const {
   switch (category_) {
     SWITCH_COVERS_ALL_CASES
diff --git a/flang/test/Semantics/smp-def01.f90 b/flang/test/Semantics/smp-def01.f90
new file mode 100644
index 00000000000000..7169bba4509990
--- /dev/null
+++ b/flang/test/Semantics/smp-def01.f90
@@ -0,0 +1,23 @@
+!RUN: %flang -fsyntax-only %s 2>&1 | FileCheck --allow-empty %s
+!Ensure no bogus error message about incompatible character length
+!CHECK-NOT: error
+
+module m1
+  integer :: n = 1
+end
+
+module m2
+  interface
+    module subroutine s(a,b)
+      use m1
+      character(n) :: a
+      character(n) :: b
+    end
+  end interface
+end
+
+submodule(m2) m2s1
+ contains
+  module procedure s
+  end
+end

[clementval]

LGTM