[flang] Fix bogus error about procedure incompatbility

[klausler]

This was a subtle problem. When the shape of a function result is explicit but not constant, it is characterized with bounds expressions that use Extremum operations to force extents to 0 rather than be negative. These Extremum operations are formatted as "max()" intrinsic functions in the module file. Upon being read from the module file, they are not folded back into Extremum operations, but remain as function references; and this then leads to expressions not comparing equal when the procedure characteristics are compared to those of a local procedure declared identically.

The real fix here would be for folding to just always change max and min function references into Extremum<> operations, constant operands or not, and I tried that, but it lead to test failures and crashes in lowering that I couldn't resolve. So, until those can be fixed, here's a change that will read max/min operations in module file declarations back into Extremum operations to solve the compatibility checking problem, but leave other non-constant max/min operations as function calls.

[llvmbot]

@llvm/pr-subscribers-flang-semantics

Author: Peter Klausler (klausler)

Changes

This was a subtle problem. When the shape of a function result is explicit but not constant, it is characterized with bounds expressions that use Extremum<SubscriptInteger> operations to force extents to 0 rather than be negative. These Extremum operations are formatted as "max()" intrinsic functions in the module file. Upon being read from the module file, they are not folded back into Extremum operations, but remain as function references; and this then leads to expressions not comparing equal when the procedure characteristics are compared to those of a local procedure declared identically.

The real fix here would be for folding to just always change max and min function references into Extremum<> operations, constant operands or not, and I tried that, but it lead to test failures and crashes in lowering that I couldn't resolve. So, until those can be fixed, here's a change that will read max/min operations in module file declarations back into Extremum operations to solve the compatibility checking problem, but leave other non-constant max/min operations as function calls.

---

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

6 Files Affected:

• (modified) flang/include/flang/Evaluate/expression.h (+3)
• (modified) flang/include/flang/Evaluate/tools.h (+16)
• (modified) flang/lib/Evaluate/expression.cpp (+18-4)
• (modified) flang/lib/Evaluate/fold-implementation.h (+34-16)
• (added) flang/test/Semantics/Inputs/modfile67.mod (+16)
• (added) flang/test/Semantics/modfile67.f90 (+35)

diff --git a/flang/include/flang/Evaluate/expression.h b/flang/include/flang/Evaluate/expression.h
index 3ba46edba717b4..2a40193e32306b 100644
--- a/flang/include/flang/Evaluate/expression.h
+++ b/flang/include/flang/Evaluate/expression.h
@@ -342,6 +342,7 @@ template <typename A> struct Extremum : public Operation<Extremum<A>, A, A, A> {
       : Base{x, y}, ordering{ord} {}
   Extremum(Ordering ord, Expr<Operand> &&x, Expr<Operand> &&y)
       : Base{std::move(x), std::move(y)}, ordering{ord} {}
+  bool operator==(const Extremum &) const;
   Ordering ordering{Ordering::Greater};
 };
 
@@ -381,6 +382,7 @@ struct LogicalOperation
       : Base{x, y}, logicalOperator{opr} {}
   LogicalOperation(LogicalOperator opr, Expr<Operand> &&x, Expr<Operand> &&y)
       : Base{std::move(x), std::move(y)}, logicalOperator{opr} {}
+  bool operator==(const LogicalOperation &) const;
   LogicalOperator logicalOperator;
 };
 
@@ -634,6 +636,7 @@ class Relational : public Operation<Relational<T>, LogicalResult, T, T> {
       : Base{a, b}, opr{r} {}
   Relational(RelationalOperator r, Expr<Operand> &&a, Expr<Operand> &&b)
       : Base{std::move(a), std::move(b)}, opr{r} {}
+  bool operator==(const Relational &) const;
   RelationalOperator opr;
 };
 
diff --git a/flang/include/flang/Evaluate/tools.h b/flang/include/flang/Evaluate/tools.h
index 3675d9f924876a..a0487e399d936c 100644
--- a/flang/include/flang/Evaluate/tools.h
+++ b/flang/include/flang/Evaluate/tools.h
@@ -218,6 +218,22 @@ template <typename A, typename B> A *UnwrapExpr(std::optional<B> &x) {
   }
 }
 
+template <typename A, typename B> const A *UnwrapExpr(const B *x) {
+  if (x) {
+    return UnwrapExpr<A>(*x);
+  } else {
+    return nullptr;
+  }
+}
+
+template <typename A, typename B> A *UnwrapExpr(B *x) {
+  if (x) {
+    return UnwrapExpr<A>(*x);
+  } else {
+    return nullptr;
+  }
+}
+
 // A variant of UnwrapExpr above that also skips through (parentheses)
 // and conversions of kinds within a category.  Useful for extracting LEN
 // type parameter inquiries, at least.
diff --git a/flang/lib/Evaluate/expression.cpp b/flang/lib/Evaluate/expression.cpp
index 5b0bc14dc3e1b1..1a65d4c7362fea 100644
--- a/flang/lib/Evaluate/expression.cpp
+++ b/flang/lib/Evaluate/expression.cpp
@@ -125,6 +125,24 @@ template <typename A> LLVM_DUMP_METHOD void ExpressionBase<A>::dump() const {
 
 // Equality testing
 
+template <typename A> bool Extremum<A>::operator==(const Extremum &that) const {
+  return ordering == that.ordering && Base::operator==(that);
+}
+
+template <int KIND>
+bool LogicalOperation<KIND>::operator==(const LogicalOperation &that) const {
+  return logicalOperator == that.logicalOperator && Base::operator==(that);
+}
+
+template <typename A>
+bool Relational<A>::operator==(const Relational &that) const {
+  return opr == that.opr && Base::operator==(that);
+}
+
+bool Relational<SomeType>::operator==(const Relational &that) const {
+  return u == that.u;
+}
+
 bool ImpliedDoIndex::operator==(const ImpliedDoIndex &that) const {
   return name == that.name;
 }
@@ -181,10 +199,6 @@ bool StructureConstructor::operator==(const StructureConstructor &that) const {
   return result_ == that.result_ && values_ == that.values_;
 }
 
-bool Relational<SomeType>::operator==(const Relational<SomeType> &that) const {
-  return u == that.u;
-}
-
 template <int KIND>
 bool Expr<Type<TypeCategory::Integer, KIND>>::operator==(
     const Expr<Type<TypeCategory::Integer, KIND>> &that) const {
diff --git a/flang/lib/Evaluate/fold-implementation.h b/flang/lib/Evaluate/fold-implementation.h
index 9ce0edbdcb7796..1b14a305b87f4f 100644
--- a/flang/lib/Evaluate/fold-implementation.h
+++ b/flang/lib/Evaluate/fold-implementation.h
@@ -1088,24 +1088,42 @@ Expr<T> FoldMINorMAX(
   static_assert(T::category == TypeCategory::Integer ||
       T::category == TypeCategory::Real ||
       T::category == TypeCategory::Character);
-  std::vector<Constant<T> *> constantArgs;
-  // Call Folding on all arguments, even if some are not constant,
-  // to make operand promotion explicit.
-  for (auto &arg : funcRef.arguments()) {
-    if (auto *cst{Folder<T>{context}.Folding(arg)}) {
-      constantArgs.push_back(cst);
+  auto &args{funcRef.arguments()};
+  bool ok{true};
+  std::optional<Expr<T>> result;
+  Folder<T> folder{context};
+  for (std::optional<ActualArgument> &arg : args) {
+    // Call Folding on all arguments to make operand promotion explicit.
+    if (!folder.Folding(arg)) {
+      // TODO: Lowering can't handle having every FunctionRef for max and min
+      // being converted into Extremum<T>.  That needs fixing.  Until that
+      // is corrected, however, it is important that max and min references
+      // in module files be converted into Extremum<T> even when not constant;
+      // the Extremum<SubscriptInteger> operations created to normalize the
+      // values of array bounds are formatted as max operations in the
+      // declarations in modules, and need to be read back in as such in
+      // order for expression comparison to not produce false inequalities
+      // when checking function results for procedure interface compatibility.
+      if (!context.moduleFileName()) {
+        ok = false;
+      }
+    }
+    Expr<SomeType> *argExpr{arg ? arg->UnwrapExpr() : nullptr};
+    if (argExpr) {
+      *argExpr = Fold(context, std::move(*argExpr));
+    }
+    if (Expr<T> * tExpr{UnwrapExpr<Expr<T>>(argExpr)}) {
+      if (result) {
+        result = FoldOperation(
+            context, Extremum<T>{order, std::move(*result), Expr<T>{*tExpr}});
+      } else {
+        result = Expr<T>{*tExpr};
+      }
+    } else {
+      ok = false;
     }
   }
-  if (constantArgs.size() != funcRef.arguments().size()) {
-    return Expr<T>(std::move(funcRef));
-  }
-  CHECK(!constantArgs.empty());
-  Expr<T> result{std::move(*constantArgs[0])};
-  for (std::size_t i{1}; i < constantArgs.size(); ++i) {
-    Extremum<T> extremum{order, result, Expr<T>{std::move(*constantArgs[i])}};
-    result = FoldOperation(context, std::move(extremum));
-  }
-  return result;
+  return ok && result ? std::move(*result) : Expr<T>{std::move(funcRef)};
 }
 
 // For AMAX0, AMIN0, AMAX1, AMIN1, DMAX1, DMIN1, MAX0, MIN0, MAX1, and MIN1
diff --git a/flang/test/Semantics/Inputs/modfile67.mod b/flang/test/Semantics/Inputs/modfile67.mod
new file mode 100644
index 00000000000000..1aa0158e350895
--- /dev/null
+++ b/flang/test/Semantics/Inputs/modfile67.mod
@@ -0,0 +1,16 @@
+!mod$ v1 sum:37cfecee3234c8ab
+module modfile67
+type::t
+procedure(foo),nopass,pointer::p
+end type
+contains
+pure function foo(n,a) result(r)
+integer(4),intent(in)::n
+real(4),intent(in)::a(1_8:int(n,kind=8))
+logical(4)::r(1_8:int(int(max(0_8,int(n,kind=8)),kind=4),kind=8))
+end
+function fooptr(f)
+procedure(foo)::f
+type(t)::fooptr
+end
+end
diff --git a/flang/test/Semantics/modfile67.f90 b/flang/test/Semantics/modfile67.f90
new file mode 100644
index 00000000000000..18cf95bd42fbf0
--- /dev/null
+++ b/flang/test/Semantics/modfile67.f90
@@ -0,0 +1,35 @@
+!RUN: %flang_fc1 -fsyntax-only -J%S/Inputs %s
+
+#if 0
+!modfile67.mod was produced from this source, and must be read into this
+!compilation from its module file in order to truly test this fix.
+module modfile67
+  type t
+    procedure(foo), nopass, pointer :: p
+  end type
+ contains
+  pure function foo(n,a) result(r)
+    integer, intent(in) :: n
+    real, intent(in), dimension(n) :: a
+    logical, dimension(size(a)) :: r
+    r = .false.
+  end
+  type(t) function fooptr(f)
+    procedure(foo) f
+    fooptr%p => f
+  end
+end
+#endif
+
+program test
+  use modfile67
+  type(t) x
+  x = fooptr(bar) ! ensure no bogus error about procedure incompatibility
+ contains
+  pure function bar(n,a) result(r)
+    integer, intent(in) :: n
+    real, intent(in), dimension(n) :: a
+    logical, dimension(size(a)) :: r
+    r = .false.
+  end
+end

[jeanPerier]

Do you have sources for such cases. I wonder if this has to do with the handling of optional arguments to min/max that is not done for Extremum.

I am not sure the folding here would properly deal with such optional arguments anyway since max(a,b,c) is not equivalent to max(max(a,b), c) as far as optionals are concerned.

Extremum for characters is also unimplemented since it was not easily testable so far.

Otherwise, unconditional folding for numerical with two arguments should "just work", and it is indeed a bug if it does not.