[flang] Initial support for storage conflict check

[peixin]

Summary

This checks the storage conflict in arguments of elemental call. It is
dangerous to use in that way, so try to report one warning. The dynamic
analysis for pointers and non-compile time array indices is not covered.
Also, do not check the array indices since it is not easy to know if
the arguments use different slices.

[peixin]

program m
  integer :: x, y, z = 1
  equivalence(x, y)
  call sub3(x, y, z)
  print *, x
contains
  subroutine sub3(a, b, c)
    integer :: a, b, c
    a = c
    b = c + 1
  end
end

In the long term, there should be warnings for the scenarios such as the above test case. Although this is not one priority work, it seems that we should have one storage conflict static check finally. Is this right?

[kiranchandramohan]

You will probably have to wait till WARNINGs support is enabled in test_errors.py (https://reviews.llvm.org/D125804).

[peixin]

In D125891#3531477, @kiranchandramohan wrote:

You will probably have to wait till WARNINGs support is enabled in test_errors.py (https://reviews.llvm.org/D125804).

Thanks for the notice. I didn't notice the warnings are not checked for the tests under /semantics.

[peixin]

Rebase and use FileCheck for test case to proceed for review.

[peixin]

Chang i++ into ++i.

flang/include/flang/Evaluate/tools.h

 std::optional<Expr<SomeType>> DataConstantConversionExtension(
     FoldingContext &, const DynamicType &, const Expr<SomeType> &);
 
 // Convert Hollerith or short character to a another type as if the
 // Hollerith data had been BOZ.
 std::optional<Expr<SomeType>> HollerithToBOZ(
     FoldingContext &, const Expr<SomeType> &, const DynamicType &);
 
+/// Is this a variable wrapped in parentheses?
+template <typename A> bool IsParenthesizedVariable(const A &) { return false; }
+template <typename T> bool IsParenthesizedVariable(const Expr<T> &expr) {
+  if constexpr (common::HasMember<Parentheses<T>, decltype(Expr<T>::u)>) {
+    if (const auto *parentheses = std::get_if<Parentheses<T>>(&expr.u))
+      return IsVariable(parentheses->left());
+    return false;
+  } else {
+    return std::visit(
+        [&](const auto &x) { return IsParenthesizedVariable(x); }, expr.u);
+  }
+}
+
+/// Is there at least an array arugment?
+bool HasArrayArgs(ActualArguments &);
+
+/// Check if the two variables has conflict storage by static analysis. This
+/// does not cover the dynamic analysis such as pointer variables or non-compile
+/// time indices of array.
+/// FIXME: Support indirect storage conflict such as checking the conflict of x
+/// and y when x and a are equivalenced and y is associated with a.
+bool HasStorageConflict(const Symbol &, const Symbol &);
+template <typename A, typename B>
+bool HasStorageConflict(const A &x, const B &y) {
+  if (IsParenthesizedVariable(x) || IsParenthesizedVariable(y)) {
+    return false;
+  }
+  if (const Symbol * xSym{GetLastSymbol(x)}) {
+    if (const Symbol * ySym{GetLastSymbol(y)}) {
+      return HasStorageConflict(*xSym, *ySym);
+    }
+  }
+  return false;
+}
+
 } // namespace Fortran::evaluate
 
 namespace Fortran::semantics {
 
 class Scope;
 
 // If a symbol represents an ENTRY, return the symbol of the main entry
 // point to its subprogram.

flang/lib/Evaluate/tools.cpp

for (std::size_t j{0}; j < bytes; ++j) {
       bits = bits.IOR(chBOZ.SHIFTL(8 * j));
     }
     return ConvertToType(type, Expr<SomeType>{bits});
   } else {
     return std::nullopt;
   }
 }
 
+bool HasArrayArgs(ActualArguments &actuals) {
+  for (const auto &arg : actuals) {
+    if (arg && arg.value().Rank() > 0) {
+      return true;
+    }
+  }
+  return false;
+}
+
+bool HasStorageConflict(const Symbol &x, const Symbol &y) {
+  if (x.GetUltimate() == y.GetUltimate() ||
+      semantics::ResolveAssociations(x) == semantics::ResolveAssociations(y)) {
+    return true;
+  }
+  auto checkEquivalence = [&](const Symbol &a, const Symbol &b) -> bool {
+    if (const semantics::EquivalenceSet *
+        set{semantics::FindEquivalenceSet(a)}) {
+      for (const semantics::EquivalenceObject &object : *set) {
+        if (object.symbol.GetUltimate() == b.GetUltimate()) {
+          return true;
+        }
+      }
+    }
+    return false;
+  };
+  if (checkEquivalence(x, y) || checkEquivalence(y, x)) {
+    return true;
+  }
+  if (const Symbol * blockX{semantics::FindCommonBlockContaining(x)}) {
+    if (const Symbol * blockY{semantics::FindCommonBlockContaining(y)}) {
+      if (blockX->name() == blockY->name()) {
+        std::function<const Symbol &(const Symbol &)> getRootUseSymbol =
+            [&](const Symbol &sym) -> const Symbol & {
+          if (const auto *useSym{sym.detailsIf<semantics::UseDetails>()}) {
+            return getRootUseSymbol(useSym->symbol());
+          }
+          return sym;
+        };
+        if (getRootUseSymbol(x).offset() == getRootUseSymbol(y).offset()) {
+          return true;
+        }
+      }
+    }
+  }
+  return false;
+}
+
 } // namespace Fortran::evaluate
 
 namespace Fortran::semantics {
 
 const Symbol &ResolveAssociations(const Symbol &original) {
   const Symbol &symbol{original.GetUltimate()};
   if (const auto *details{symbol.detailsIf<AssocEntityDetails>()}) {
     if (const Symbol * nested{UnwrapWholeSymbolDataRef(details->expr())}) {

flang/lib/Lower/ConvertExpr.cpp

 }
 
 // An expression with non-zero rank is an array expression.
 template <typename A>
 static bool isArray(const A &x) {
   return x.Rank() != 0;
 }
 
-/// Is this a variable wrapped in parentheses?
-template <typename A>
-static bool isParenthesizedVariable(const A &) {
-  return false;
-}
-template <typename T>
-static bool isParenthesizedVariable(const Fortran::evaluate::Expr<T> &expr) {
-  using ExprVariant = decltype(Fortran::evaluate::Expr<T>::u);
-  using Parentheses = Fortran::evaluate::Parentheses<T>;
-  if constexpr (Fortran::common::HasMember<Parentheses, ExprVariant>) {
-    if (const auto *parentheses = std::get_if<Parentheses>(&expr.u))
-      return Fortran::evaluate::IsVariable(parentheses->left());
-    return false;
-  } else {
-    return std::visit([&](const auto &x) { return isParenthesizedVariable(x); },
-                      expr.u);
-  }
-}
-
 /// Does \p expr only refer to symbols that are mapped to IR values in \p symMap
 /// ?
 static bool allSymbolsInExprPresentInMap(const Fortran::lower::SomeExpr &expr,
                                          Fortran::lower::SymMap &symMap) {
   for (const auto &sym : Fortran::evaluate::CollectSymbols(expr))
     if (!symMap.lookupSymbol(sym))
       return false;
   return true;

   ExtValue genTempExtAddr(const Fortran::lower::SomeExpr &expr) {
     // In general, genExtAddr might not create a temp for variable inside
     // parentheses to avoid creating array temporary in sub-expressions. It only
     // ensures the sub-expression is not re-associated with other parts of the
     // expression. In the call semantics, there is a difference between expr and
     // variable (see R1524). For expressions, a variable storage must not be
     // argument associated since it could be modified inside the call, or the
     // variable could also be modified by other means during the call.
-    if (!isParenthesizedVariable(expr))
+    if (!Fortran::evaluate::IsParenthesizedVariable(expr))
       return genExtAddr(expr);
     if (expr.Rank() > 0)
       return asArray(expr);
     mlir::Location loc = getLoc();
     return genExtValue(expr).match(
         [&](const fir::CharBoxValue &boxChar) -> ExtValue {
           return fir::factory::CharacterExprHelper{builder, loc}.createTempFrom(
               boxChar);
CC genElementalArgument(const A &x) {
     // Ensure the returned element is in memory if this is what was requested.
     if ((semant == ConstituentSemantics::RefOpaque ||
          semant == ConstituentSemantics::DataAddr ||
          semant == ConstituentSemantics::ByValueArg)) {
       if (!Fortran::evaluate::IsVariable(x)) {
         PushSemantics(ConstituentSemantics::DataValue);
         CC cc = genarr(x);
         mlir::Location loc = getLoc();
-        if (isParenthesizedVariable(x)) {
+        if (Fortran::evaluate::IsParenthesizedVariable(x)) {
           // Parenthesised variables are lowered to a reference to the variable
           // storage. When passing it as an argument, a copy must be passed.
           return [=](IterSpace iters) -> ExtValue {
             return createInMemoryScalarCopy(builder, loc, cc(iters));
           };
         }
         mlir::Type storageType =
             fir::unwrapSequenceType(converter.genType(toEvExpr(x)));

flang/lib/Semantics/check-call.cpp

 // INTENT(INOUT) dummy argument shall be an array. The actual argument to an
 // ELEMENTAL procedure must conform.
 static bool CheckElementalConformance(parser::ContextualMessages &messages,
     const characteristics::Procedure &proc, evaluate::ActualArguments &actuals,
     evaluate::FoldingContext &context) {
   std::optional<evaluate::Shape> shape;
   std::string shapeName;
   int index{0};
-  bool hasArrayArg{false};
-  for (const auto &arg : actuals) {
-    if (arg && arg.value().Rank() > 0) {
-      hasArrayArg = true;
-      break;
-    }
-  }
+  bool hasArrayArg{evaluate::HasArrayArgs(actuals)};
   for (const auto &arg : actuals) {
     const auto &dummy{proc.dummyArguments.at(index++)};
     if (arg) {
       if (const auto *expr{arg->UnwrapExpr()}) {
         if (auto argShape{evaluate::GetShape(context, *expr)}) {
           if (GetRank(*argShape) > 0) {
             std::string argName{"actual argument ("s + expr->AsFortran() +
                 ") corresponding to dummy argument #" + std::to_string(index) +
if (treatingExternalAsImplicit && !buffer.empty()) {
               "If the procedure's interface were explicit, this reference would be in error:"_warn_en_US)}) {
         buffer.AttachTo(*msg, parser::Severity::Because);
       }
     }
     if (auto *msgs{messages.messages()}) {
       msgs->Annex(std::move(buffer));
     }
   }
+  if (proc.IsElemental() && evaluate::HasArrayArgs(actuals) &&
+      (messages.empty() || !messages.messages()->AnyFatalError())) {
+    for (int i = 0; i < (int)actuals.size(); ++i) {
+      for (int j = i + 1; j < (int)actuals.size(); ++j) {
+        if (actuals[i].has_value() && actuals[j].has_value()) {
+          evaluate::ActualArgument &arg1{actuals[i].value()};
+          evaluate::ActualArgument &arg2{actuals[j].value()};
+          auto *expr1{arg1.UnwrapExpr()};
+          auto *expr2{arg2.UnwrapExpr()};
+          if (arg1.dummyIntent() == common::Intent::Out ||
+              arg1.dummyIntent() == common::Intent::InOut ||
+              arg2.dummyIntent() == common::Intent::Out ||
+              arg2.dummyIntent() == common::Intent::InOut) {
+            if (evaluate::HasStorageConflict(*expr1, *expr2)) {
+              messages.Say(
+                  "Actual argument %s might interfere with actual argument %s"_warn_en_US,
+                  expr1->AsFortran(), expr2->AsFortran());
+            }
+          }
+        }
+      }
+    }
+  }
 }
 } // namespace Fortran::semantics

flang/test/Semantics/call27.f90

+! RUN: %flang_fc1 -fopenmp %s 2>&1 | FileCheck %s
+
+! Test the storage conflict of elemental procedure
+
+subroutine sub0()
+  integer :: a(3), b(3), x(3), y(3)
+  common /blk/ a, b
+  common /blk/ x, y
+
+  call elemsub(x, a(3:1:-1), b, y(3:1:-1)) ! no warning
+contains
+ elemental subroutine elemsub(a, b, c, d)
+   integer, intent(in) :: b, d
+   integer, intent(out) :: a, c
+   a = b + 1
+   c = d + 1
+ end
+end
+
+module mod1
+  integer :: a(3), b(3)
+  common /blk2/ a, b
+end
+
+subroutine sub1()
+  use mod1
+  integer :: x(3), y(3)
+  common /blk2/ x, y
+
+  !CHECK: warning: Actual argument x might interfere with actual argument a(3_8:1_8:-1_8)
+  !CHECK: warning: Actual argument b might interfere with actual argument y(3_8:1_8:-1_8)
+  call elemsub(x, a(3:1:-1), b, y(3:1:-1))
+contains
+ elemental subroutine elemsub(a, b, c, d)
+   integer, intent(in) :: b, d
+   integer, intent(out) :: a, c
+   a = b + 1
+   c = d + 1
+ end
+end
+
+module mod2
+  use mod1
+  integer :: x(3), y(3)
+  common /blk2/ x, y
+end
+
+subroutine sub2()
+  use mod2
+
+  !CHECK: warning: Actual argument x might interfere with actual argument a(3_8:1_8:-1_8)
+  !CHECK: warning: Actual argument b might interfere with actual argument y(3_8:1_8:-1_8)
+  call elemsub(x, a(3:1:-1), b, y(3:1:-1))
+contains
+ elemental subroutine elemsub(a, b, c, d)
+   integer, intent(in) :: b, d
+   integer, intent(out) :: a, c
+   a = b + 1
+   c = d + 1
+ end
+end
+
+subroutine sub3()
+  integer :: array(3) = (/1,2,3/), array2(3) = (/1,2,3/)
+  associate (arr => array, arr2 => array2)
+    !CHECK: warning: Actual argument array might interfere with actual argument arr(3_8:1_8:-1_8)
+    !CHECK: warning: Actual argument arr2 might interfere with actual argument array2(3_8:1_8:-1_8)
+    call elemsub(array, arr(3:1:-1), arr2, array2(3:1:-1))
+  end associate
+contains
+  elemental subroutine elemsub(a, b, c, d)
+    integer, intent(in) :: b, d
+    integer, intent(out) :: a, c
+    a = b + 1
+    c = d + 1
+  end
+end
+
+subroutine sub4()
+  integer :: array(3) = (/1,2,3/), array2(3) = (/1,2,3/)
+  integer :: arr(3), arr2(3)
+  equivalence(array, arr)
+  equivalence(array2, arr2)
+
+  !CHECK: warning: Actual argument array might interfere with actual argument arr(3_8:1_8:-1_8)
+  !CHECK: warning: Actual argument arr2 might interfere with actual argument array2(3_8:1_8:-1_8)
+  call elemsub(array, arr(3:1:-1), arr2, array2(3:1:-1))
+contains
+  elemental subroutine elemsub(a, b, c, d)
+    integer, intent(in) :: b, d
+    integer, intent(out) :: a, c
+    a = b + 1
+    c = d + 1
+  end
+end
+
+subroutine sub5()
+  integer :: array(3) = (/1,2,3/), array2(3) = (/1,2,3/)
+
+  !CHECK: warning: Actual argument array might interfere with actual argument array(3_8:1_8:-1_8)
+  !CHECK: warning: Actual argument array2 might interfere with actual argument array2(3_8:1_8:-1_8)
+  call elemsub(array, array(3:1:-1), array2, array2(3:1:-1))
+contains
+  elemental subroutine elemsub(a, b, c, d)
+    integer, intent(in) :: b, d
+    integer, intent(out) :: a, c
+    a = b + 1
+    c = d + 1
+  end
+end