[flang] Avoid spurious error message in function result compatibility

[klausler]

Summary

When checking function interface compatibility for procedure pointer
assignment/initialization or actual/dummy procedure association, don't
emit a diagnositic about function result shape incompatibility unless
the interfaces differ in rank or have distinct constant extents on a
dimension. Function results whose dimensions are determined by dummy
arguments or host-associated variables are not necessarily incompatible.

[jpenix-quic]

flang/lib/Evaluate/characteristics.cpp

878–893

Does this differ from what ShapesAreCompatible does (characteristics.cpp:41-57)? They seem like they are doing the same thing, but I might be misunderstanding something (and apologies in advance if so!).

Either way, FWIW I think this should fix https://github.com/llvm/llvm-project/issues/57204 as well--thanks!

[klausler]

flang/lib/Evaluate/characteristics.cpp

878–893

ShapesAreCompatible() will return false when one corresponding dimensions is deferred but the other is not. AreCompatibleFunctionResultShapes will return false if corresponding dimensions have distinct explicit extents.

[jpenix-quic]

flang/lib/Evaluate/characteristics.cpp

878–893

Ahh, I see--thank you for clarifying for me!

Just to double check though, is the ShapesAreCompatible() behavior desirable here? For example, with this code (https://godbolt.org/z/x7srK54b7) where there is a mismatch between the interface and passed function having assumed or explicit extents, respectively, gfortran and ifort are both rejecting this code while flang using AreCompatibleFunctionResultShapes() accepts it. I tried looking through the standard to see what is correct, but I don't understand well enough to know for sure--is the bit about non-constant bounds in function result arrays in 15.3.3 relevant here?

[klausler]

flang/lib/Evaluate/characteristics.cpp

878–893

Exact characteristic equivalence checking for dummy/actual procedure interfaces is necessarily inexact. Array bounds and length type parameters can be specified by means of arbitrary specification expressions, including calls to PURE user functions, whose values cannot be computed and checked at compilation time; neither is it possible in general to prove at compilation time that two specification expressions will or will not produce identical values at run time. A symbolic algebra system might be employed to do better than what's presently done, but in general this is not a tractable problem. And it's not one that a Fortran compiler is required by the standard to solve, since there isn't a numbered constraint here, just "shall" language in the normative text.

So I've taken a conservative course that will *not* consider two procedure interfaces to be incompatible unless they blatantly are so in a way that might lead to incorrect code generation (e.g., 10 vs 20). In the example that you linked above, I think that gfortran's error could be inappropriate -- what if size(p) is always 10?

flang/lib/Evaluate/characteristics.cpp

if (typeAndShape->Rank() > 0) {
         return true;
       }
     }
   } else {
     return false; // 15.4.2.2(4)(b) - procedure pointer
   }
 }
 
+static bool AreCompatibleFunctionResultShapes(const Shape &x, const Shape &y) {
+  int rank{GetRank(x)};
+  if (GetRank(y) != rank) {
+    return false;
+  }
+  for (int j{0}; j < rank; ++j) {
+    if (auto xDim{ToInt64(x[j])}) {
+      if (auto yDim{ToInt64(y[j])}) {
+        if (*xDim != *yDim) {
+          return false;
+        }
+      }
+    }
+  }
+  return true;
+}
+
 bool FunctionResult::IsCompatibleWith(
     const FunctionResult &actual, std::string *whyNot) const {
   Attrs actualAttrs{actual.attrs};
   if (!attrs.test(Attr::Contiguous)) {
     actualAttrs.reset(Attr::Contiguous);
   }
   if (attrs != actualAttrs) {
     if (whyNot) {
       *whyNot = "function results have incompatible attributes";
     }
   } else if (const auto *ifaceTypeShape{std::get_if<TypeAndShape>(&u)}) {
     if (const auto *actualTypeShape{std::get_if<TypeAndShape>(&actual.u)}) {
       if (ifaceTypeShape->Rank() != actualTypeShape->Rank()) {
         if (whyNot) {
           *whyNot = "function results have distinct ranks";
         }
       } else if (!attrs.test(Attr::Allocatable) && !attrs.test(Attr::Pointer) &&
-          ifaceTypeShape->shape() != actualTypeShape->shape()) {
+          !AreCompatibleFunctionResultShapes(
+              ifaceTypeShape->shape(), actualTypeShape->shape())) {
         if (whyNot) {
-          *whyNot = "function results have distinct extents";
+          *whyNot = "function results have distinct constant extents";
         }
       } else if (!ifaceTypeShape->type().IsTkCompatibleWith(
                      actualTypeShape->type())) {
         if (whyNot) {
           *whyNot = "function results have incompatible types: "s +
               ifaceTypeShape->type().AsFortran() + " vs "s +
               actualTypeShape->type().AsFortran();
         }