[flang] fix IsSimplyContiguous with expressions

flang/include/flang/Evaluate/check-expression.h

@@ -99,29 +99,44 @@ extern template void CheckSpecificationExpr(
     FoldingContext &, bool forElementalFunctionResult);
 
 // Contiguity & "simple contiguity" (9.5.4)
+// Named constant sections are expressions, and as such their evaluation is
+// considered to be contiguous. This avoids funny situations where
+// IS_CONTIGUOUS(cst(1:10:2)) would fold to true because `cst(1:10:2)` is
+// folded into an array constructor literal, but IS_CONTIGUOUS(cst(i:i+9:2))
+// folds to false because the named constant reference cannot be folded.
+// Note that these IS_CONTIGUOUS usages are not portable (can probably be
+// considered to fall into F2023 8.5.7 (4)), and existing compilers are not
+// consistent here.
+// However, the compiler may very well decide to create a descriptor over
+// `cst(i:i+9:2)` when it can to avoid copies, and as such it needs internally
+// to be able to tell the actual contiguity of that array section over the
+// read-only data.
 template <typename A>
-std::optional<bool> IsContiguous(const A &, FoldingContext &);
+std::optional<bool> IsContiguous(const A &, FoldingContext &,
+    bool namedConstantSectionsAreContiguous = true);
+extern template std::optional<bool> IsContiguous(const Expr<SomeType> &,
+    FoldingContext &, bool namedConstantSectionsAreContiguous);
+extern template std::optional<bool> IsContiguous(const ArrayRef &,
+    FoldingContext &, bool namedConstantSectionsAreContiguous);
+extern template std::optional<bool> IsContiguous(const Substring &,
+    FoldingContext &, bool namedConstantSectionsAreContiguous);
+extern template std::optional<bool> IsContiguous(const Component &,
+    FoldingContext &, bool namedConstantSectionsAreContiguous);
+extern template std::optional<bool> IsContiguous(const ComplexPart &,
+    FoldingContext &, bool namedConstantSectionsAreContiguous);
+extern template std::optional<bool> IsContiguous(const CoarrayRef &,
+    FoldingContext &, bool namedConstantSectionsAreContiguous);
 extern template std::optional<bool> IsContiguous(
-    const Expr<SomeType> &, FoldingContext &);
-extern template std::optional<bool> IsContiguous(
-    const ArrayRef &, FoldingContext &);
-extern template std::optional<bool> IsContiguous(
-    const Substring &, FoldingContext &);
-extern template std::optional<bool> IsContiguous(
-    const Component &, FoldingContext &);
-extern template std::optional<bool> IsContiguous(
-    const ComplexPart &, FoldingContext &);
-extern template std::optional<bool> IsContiguous(
-    const CoarrayRef &, FoldingContext &);
-extern template std::optional<bool> IsContiguous(
-    const Symbol &, FoldingContext &);
-static inline std::optional<bool> IsContiguous(
-    const SymbolRef &s, FoldingContext &c) {
-  return IsContiguous(s.get(), c);
+    const Symbol &, FoldingContext &, bool namedConstantSectionsAreContiguous);
+static inline std::optional<bool> IsContiguous(const SymbolRef &s,
+    FoldingContext &c, bool namedConstantSectionsAreContiguous = true) {
+  return IsContiguous(s.get(), c, namedConstantSectionsAreContiguous);
 }
 template <typename A>
-bool IsSimplyContiguous(const A &x, FoldingContext &context) {
-  return IsContiguous(x, context).value_or(false);
+bool IsSimplyContiguous(const A &x, FoldingContext &context,
+    bool namedConstantSectionsAreContiguous = true) {
+  return IsContiguous(x, context, namedConstantSectionsAreContiguous)
+      .value_or(false);
 }
 
 template <typename A> bool IsErrorExpr(const A &);

flang/include/flang/Evaluate/tools.h

@@ -321,28 +321,38 @@ template <typename A> const Symbol *ExtractBareLenParameter(const A &expr) {
 // of a substring or complex part.
 template <typename A>
 common::IfNoLvalue<std::optional<DataRef>, A> ExtractDataRef(
-    const A &, bool intoSubstring, bool intoComplexPart) {
-  return std::nullopt; // default base case
+    const A &x, bool intoSubstring, bool intoComplexPart) {
+  if constexpr (common::HasMember<decltype(x), decltype(DataRef::u)>) {
+    return DataRef{x};
+  } else {
+    return std::nullopt; // default base case
+  }
+}
+
+std::optional<DataRef> ExtractSubstringBase(const Substring &);
+
+inline std::optional<DataRef> ExtractDataRef(const Substring &x,
+    bool intoSubstring = false, bool intoComplexPart = false) {
+  if (intoSubstring) {
+    return ExtractSubstringBase(x);
+  } else {
+    return std::nullopt;
+  }
+}
+inline std::optional<DataRef> ExtractDataRef(const ComplexPart &x,
+    bool intoSubstring = false, bool intoComplexPart = false) {
+  if (intoComplexPart) {
+    return x.complex();
+  } else {
+    return std::nullopt;
+  }
 }
 template <typename T>
 std::optional<DataRef> ExtractDataRef(const Designator<T> &d,
     bool intoSubstring = false, bool intoComplexPart = false) {
   return common::visit(
       [=](const auto &x) -> std::optional<DataRef> {
-        if constexpr (common::HasMember<decltype(x), decltype(DataRef::u)>) {
-          return DataRef{x};
-        }
-        if constexpr (std::is_same_v<std::decay_t<decltype(x)>, Substring>) {
-          if (intoSubstring) {
-            return ExtractSubstringBase(x);
-          }
-        }
-        if constexpr (std::is_same_v<std::decay_t<decltype(x)>, ComplexPart>) {
-          if (intoComplexPart) {
-            return x.complex();
-          }
-        }
-        return std::nullopt; // w/o "else" to dodge bogus g++ 8.1 warning
+        return ExtractDataRef(x, intoSubstring, intoComplexPart);
       },
       d.u);
 }
@@ -376,8 +386,6 @@ std::optional<DataRef> ExtractDataRef(
 std::optional<DataRef> ExtractDataRef(const ActualArgument &,
     bool intoSubstring = false, bool intoComplexPart = false);
 
-std::optional<DataRef> ExtractSubstringBase(const Substring &);
-
 // Predicate: is an expression is an array element reference?
 template <typename T>
 bool IsArrayElement(const Expr<T> &expr, bool intoSubstring = true,

flang/lib/Evaluate/check-expression.cpp

@@ -833,7 +833,10 @@ class IsContiguousHelper
 public:
   using Result = std::optional<bool>; // tri-state
   using Base = AnyTraverse<IsContiguousHelper, Result>;
-  explicit IsContiguousHelper(FoldingContext &c) : Base{*this}, context_{c} {}
+  explicit IsContiguousHelper(
+      FoldingContext &c, bool namedConstantSectionsAreContiguous)
+      : Base{*this}, context_{c}, namedConstantSectionsAreContiguous_{
+                                      namedConstantSectionsAreContiguous} {}
   using Base::operator();
 
   template <typename T> Result operator()(const Constant<T> &) const {
@@ -856,6 +859,11 @@ class IsContiguousHelper
       // RANK(*) associating entity is contiguous.
       if (details->IsAssumedSize()) {
         return true;
+      } else if (!IsVariable(details->expr()) &&
+          (namedConstantSectionsAreContiguous_ ||
+              !ExtractDataRef(details->expr(), true, true))) {
+        // Selector is associated to an expression value.
+        return true;
       } else {
         return Base::operator()(ultimate); // use expr
       }
@@ -1113,22 +1121,34 @@ class IsContiguousHelper
   }
 
   FoldingContext &context_;
+  bool namedConstantSectionsAreContiguous_{false};
 };
 
 template <typename A>
-std::optional<bool> IsContiguous(const A &x, FoldingContext &context) {
-  return IsContiguousHelper{context}(x);
+std::optional<bool> IsContiguous(const A &x, FoldingContext &context,
+    bool namedConstantSectionsAreContiguous) {
+  if (!IsVariable(x) &&
+      (namedConstantSectionsAreContiguous || !ExtractDataRef(x, true, true))) {
+    return true;
+  } else {
+    return IsContiguousHelper{context, namedConstantSectionsAreContiguous}(x);
+  }
 }
 
+template std::optional<bool> IsContiguous(const Expr<SomeType> &,
+    FoldingContext &, bool namedConstantSectionsAreContiguous);
+template std::optional<bool> IsContiguous(const ArrayRef &, FoldingContext &,
+    bool namedConstantSectionsAreContiguous);
+template std::optional<bool> IsContiguous(const Substring &, FoldingContext &,
+    bool namedConstantSectionsAreContiguous);
+template std::optional<bool> IsContiguous(const Component &, FoldingContext &,
+    bool namedConstantSectionsAreContiguous);
+template std::optional<bool> IsContiguous(const ComplexPart &, FoldingContext &,
+    bool namedConstantSectionsAreContiguous);
+template std::optional<bool> IsContiguous(const CoarrayRef &, FoldingContext &,
+    bool namedConstantSectionsAreContiguous);
 template std::optional<bool> IsContiguous(
-    const Expr<SomeType> &, FoldingContext &);
-template std::optional<bool> IsContiguous(const ArrayRef &, FoldingContext &);
-template std::optional<bool> IsContiguous(const Substring &, FoldingContext &);
-template std::optional<bool> IsContiguous(const Component &, FoldingContext &);
-template std::optional<bool> IsContiguous(
-    const ComplexPart &, FoldingContext &);
-template std::optional<bool> IsContiguous(const CoarrayRef &, FoldingContext &);
-template std::optional<bool> IsContiguous(const Symbol &, FoldingContext &);
+    const Symbol &, FoldingContext &, bool namedConstantSectionsAreContiguous);
 
 // IsErrorExpr()
 struct IsErrorExprHelper : public AnyTraverse<IsErrorExprHelper, bool> {

flang/lib/Lower/ConvertCall.cpp

@@ -32,6 +32,7 @@
 #include "flang/Optimizer/Dialect/FIROpsSupport.h"
 #include "flang/Optimizer/HLFIR/HLFIROps.h"
 #include "mlir/IR/IRMapping.h"
+#include "llvm/ADT/TypeSwitch.h"
 #include "llvm/Support/CommandLine.h"
 #include "llvm/Support/Debug.h"
 #include <optional>
@@ -1135,6 +1136,27 @@ isSimplyContiguous(const Fortran::evaluate::ActualArgument &arg,
          Fortran::evaluate::IsSimplyContiguous(*sym, foldingContext);
 }
 
+static bool isParameterObjectOrSubObject(hlfir::Entity entity) {
+  mlir::Value base = entity;
+  bool foundParameter = false;
+  while (mlir::Operation *op = base ? base.getDefiningOp() : nullptr) {
+    base =
+        llvm::TypeSwitch<mlir::Operation *, mlir::Value>(op)
+            .Case<hlfir::DeclareOp>([&](auto declare) -> mlir::Value {
+              foundParameter |= hlfir::Entity{declare}.isParameter();
+              return foundParameter ? mlir::Value{} : declare.getMemref();
+            })
+            .Case<hlfir::DesignateOp, hlfir::ParentComponentOp, fir::EmboxOp>(
+                [&](auto op) -> mlir::Value { return op.getMemref(); })
+            .Case<fir::ReboxOp>(
+                [&](auto rebox) -> mlir::Value { return rebox.getBox(); })
+            .Case<fir::ConvertOp>(
+                [&](auto convert) -> mlir::Value { return convert.getValue(); })
+            .Default([](mlir::Operation *) -> mlir::Value { return nullptr; });
+  }
+  return foundParameter;
+}
+
 /// When dummy is not ALLOCATABLE, POINTER and is not passed in register,
 /// prepare the actual argument according to the interface. Do as needed:
 /// - address element if this is an array argument in an elemental call.
@@ -1298,8 +1320,9 @@ static PreparedDummyArgument preparePresentUserCallActualArgument(
         // 'parameter' attribute. Even though the constant expressions
         // are not definable and explicit assignments to them are not
         // possible, we have to create a temporary copies when we pass
-        // them down the call stack.
-        entity.isParameter()) {
+        // them down the call stack because of potential compiler
+        // generated writes in copy-out.
+        isParameterObjectOrSubObject(entity)) {
       // Make a copy in a temporary.
       auto copy = builder.create<hlfir::AsExprOp>(loc, entity);
       mlir::Type storageType = entity.getType();

flang/lib/Lower/ConvertExprToHLFIR.cpp

@@ -21,6 +21,7 @@
 #include "flang/Lower/ConvertProcedureDesignator.h"
 #include "flang/Lower/ConvertType.h"
 #include "flang/Lower/ConvertVariable.h"
+#include "flang/Lower/DumpEvaluateExpr.h"
 #include "flang/Lower/StatementContext.h"
 #include "flang/Lower/SymbolMap.h"
 #include "flang/Optimizer/Builder/Complex.h"
@@ -220,7 +221,8 @@ class HlfirDesignatorBuilder {
     // Non simply contiguous ref require a fir.box to carry the byte stride.
     if (mlir::isa<fir::SequenceType>(resultValueType) &&
         !Fortran::evaluate::IsSimplyContiguous(
-            designatorNode, getConverter().getFoldingContext()))
+            designatorNode, getConverter().getFoldingContext(),
+            /*namedConstantSectionsAreAlwaysContiguous=*/false))
       return fir::BoxType::get(resultValueType);
     // Other designators can be handled as raw addresses.
     return fir::ReferenceType::get(resultValueType);

flang/test/Evaluate/folding09.f90

@@ -9,7 +9,7 @@ module m
   logical, parameter :: test_param1 = is_contiguous(cst(:,1))
   logical, parameter :: test_param2 = is_contiguous(cst(1,:))
   logical, parameter :: test_param3 = is_contiguous(cst(:,n))
-  logical, parameter :: test_param4 = .not. is_contiguous(cst(n,:))
+  logical, parameter :: test_param4 = is_contiguous(cst(n,:))
   logical, parameter :: test_param5 = is_contiguous(empty_cst(n,-1:n:2))
  contains
   function f()

flang/test/Lower/HLFIR/call-issue-124043.f90

@@ -0,0 +1,15 @@
+! Reproducer for https://github.com/llvm/llvm-project/issues/124043 lowering
+! crash.
+! RUN: bbc -emit-hlfir -o - %s | FileCheck %s
+
+subroutine repro(a)
+  integer a(10)
+  associate (b => a(::2)+1)
+    call bar(b)
+  end associate
+end
+! CHECK-LABEL:   func.func @_QPrepro(
+! CHECK:           %[[VAL_11:.*]] = hlfir.elemental
+! CHECK:           %[[VAL_16:.*]]:3 = hlfir.associate %[[VAL_11]]
+! CHECK:           %[[VAL_18:.*]]:2 = hlfir.declare %[[VAL_16]]#1
+! CHECK:           fir.call @_QPbar(%[[VAL_18]]#1)

flang/test/Lower/HLFIR/calls-constant-expr-arg.f90

@@ -62,3 +62,31 @@ end subroutine test
 ! CHECK:           hlfir.end_associate %[[VAL_7]]#1, %[[VAL_7]]#2 : !fir.ref<i32>, i1
 ! CHECK:           return
 ! CHECK:         }
+
+subroutine test_associate(i)
+  interface
+   subroutine foo(x)
+     real :: x(:)
+   end subroutine
+  end interface
+  real, parameter :: p(*) = [1.,2.,3.,4.]
+  integer(8) :: i
+  associate(a => p(1:i))
+    associate(b => a(1:1:2))
+      call foo(b)
+    end associate
+  end associate
+end subroutine
+! CHECK-LABEL:   func.func @_QPtest_associate(
+! CHECK:           %[[VAL_3:.*]] = fir.address_of(@_QFtest_associateECp) : !fir.ref<!fir.array<4xf32>>
+! CHECK:           %[[VAL_6:.*]]:2 = hlfir.declare %[[VAL_3]](%{{.*}}) {fortran_attrs = #fir.var_attrs<parameter>, uniq_name = "_QFtest_associateECp"} : (!fir.ref<!fir.array<4xf32>>, !fir.shape<1>) -> (!fir.ref<!fir.array<4xf32>>, !fir.ref<!fir.array<4xf32>>)
+! CHECK:           %[[VAL_18:.*]] = hlfir.designate %[[VAL_6]]#0 {{.*}}
+! CHECK:           %[[VAL_19:.*]]:2 = hlfir.declare %[[VAL_18]] {{.*}}
+! CHECK:           %[[VAL_25:.*]] = hlfir.designate %[[VAL_19]]#0 {{.*}}
+! CHECK:           %[[VAL_26:.*]]:2 = hlfir.declare %[[VAL_25]] {uniq_name = "_QFtest_associateEb"} : (!fir.box<!fir.array<1xf32>>) -> (!fir.box<!fir.array<1xf32>>, !fir.box<!fir.array<1xf32>>)
+! CHECK:           %[[VAL_27:.*]] = hlfir.as_expr %[[VAL_26]]#0 : (!fir.box<!fir.array<1xf32>>) -> !hlfir.expr<1xf32>
+! CHECK:           %[[VAL_30:.*]]:3 = hlfir.associate %[[VAL_27]]({{.*}}) {adapt.valuebyref} : (!hlfir.expr<1xf32>, !fir.shape<1>) -> (!fir.ref<!fir.array<1xf32>>, !fir.ref<!fir.array<1xf32>>, i1)
+! CHECK:           %[[VAL_31:.*]] = fir.embox %[[VAL_30]]
+! CHECK:           %[[VAL_32:.*]] = fir.convert %[[VAL_31]] : (!fir.box<!fir.array<1xf32>>) -> !fir.box<!fir.array<?xf32>>
+! CHECK:           fir.call @_QPfoo(%[[VAL_32]]) {{.*}} : (!fir.box<!fir.array<?xf32>>) -> ()
+! CHECK:           hlfir.end_associate %[[VAL_30]]#1, %[[VAL_30]]#2 : !fir.ref<!fir.array<1xf32>>, i1