[flang-commits] [flang] 35e8624 - [flang] Silence impossible error about SMP interface incompatibility (#112054)

[via flang-commits]

Author: Peter Klausler
Date: 2024-10-15T14:22:48-07:00
New Revision: 35e86245196df1e6a1cf3b023f13f075e2ac2794

URL: https://github.com/llvm/llvm-project/commit/35e86245196df1e6a1cf3b023f13f075e2ac2794
DIFF: https://github.com/llvm/llvm-project/commit/35e86245196df1e6a1cf3b023f13f075e2ac2794.diff

LOG: [flang] Silence impossible error about SMP interface incompatibility (#112054)

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.

Added: 
    flang/test/Semantics/smp-def01.f90

Modified: 
    flang/include/flang/Evaluate/tools.h
    flang/include/flang/Semantics/type.h
    flang/lib/Evaluate/tools.cpp
    flang/lib/Evaluate/type.cpp
    flang/lib/Semantics/type.cpp

Removed: 
    


################################################################################
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