[flang-commits] [flang] [flang] Set assumed-size last extent to -1 (PR #79156)

via flang-commits flang-commits at lists.llvm.org
Tue Jan 23 23:55:19 PST 2024


https://github.com/jeanPerier updated https://github.com/llvm/llvm-project/pull/79156

>From 109660c8d723bf17591834e822412d67ee8be58a Mon Sep 17 00:00:00 2001
From: Jean Perier <jperier at nvidia.com>
Date: Tue, 23 Jan 2024 00:52:47 -0800
Subject: [PATCH 1/2] [flang] Set assumed-size last extent to -1

Currently lowering sets the extents of assumed-size array to "undef"
which was OK as long as the value was not expected to be read.

But when interfacing with the runtime and when passing assumed-size
to assumed-rank, this last extent may be read and must be -1 as
specified in the BIND(C) case in 18.5.3 point 5.

Set this value to -1, and update all the lowering code that was looking
for an undef defining op to identify assumed-size: much safer to
propagate and use semantic info here, the previous check actually did not
work if the array was used in an internal procedure (defining op not
visible anymore).

Also disable allocation of cray pointee. This was never intended and
would now lead to crashes with the -1 value for assumed-size cray
pointee.
---
 flang/include/flang/Optimizer/Builder/Array.h | 27 --------
 .../flang/Optimizer/Builder/BoxValue.h        |  3 -
 flang/lib/Lower/ConvertVariable.cpp           | 25 ++++++--
 flang/lib/Lower/DirectivesCommon.h            | 29 ++++++---
 flang/lib/Lower/OpenMP.cpp                    |  7 ++-
 flang/lib/Optimizer/Builder/BoxValue.cpp      | 16 -----
 flang/lib/Optimizer/Builder/IntrinsicCall.cpp | 63 ++++++-------------
 .../Optimizer/Transforms/ArrayValueCopy.cpp   | 13 +++-
 .../Lower/HLFIR/assumed-size-cray-pointee.f90 | 14 +++++
 flang/test/Lower/HLFIR/cray-pointers.f90      |  6 --
 flang/test/Lower/Intrinsics/lbound.f90        |  2 +-
 flang/test/Lower/Intrinsics/ubound.f90        |  2 +-
 .../Lower/array-expression-assumed-size.f90   |  8 +--
 flang/test/Lower/cray-pointer.f90             |  6 --
 14 files changed, 97 insertions(+), 124 deletions(-)
 delete mode 100644 flang/include/flang/Optimizer/Builder/Array.h
 create mode 100644 flang/test/Lower/HLFIR/assumed-size-cray-pointee.f90

diff --git a/flang/include/flang/Optimizer/Builder/Array.h b/flang/include/flang/Optimizer/Builder/Array.h
deleted file mode 100644
index c508042bc20f2a1..000000000000000
--- a/flang/include/flang/Optimizer/Builder/Array.h
+++ /dev/null
@@ -1,27 +0,0 @@
-//===-- Array.h -------------------------------------------------*- C++ -*-===//
-//
-// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
-// See https://llvm.org/LICENSE.txt for license information.
-// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
-//
-//===----------------------------------------------------------------------===//
-
-#ifndef FORTRAN_OPTIMIZER_BUILDER_ARRAY_H
-#define FORTRAN_OPTIMIZER_BUILDER_ARRAY_H
-
-#include "flang/Optimizer/Dialect/FIROps.h"
-
-namespace fir::factory {
-
-/// Return true if and only if the extents are those of an assumed-size array.
-/// An assumed-size array in Fortran is declared with `*` as the upper bound of
-/// the last dimension of the array. Lowering converts the asterisk to an
-/// undefined value.
-inline bool isAssumedSize(const llvm::SmallVectorImpl<mlir::Value> &extents) {
-  return !extents.empty() &&
-         mlir::isa_and_nonnull<UndefOp>(extents.back().getDefiningOp());
-}
-
-} // namespace fir::factory
-
-#endif // FORTRAN_OPTIMIZER_BUILDER_ARRAY_H
diff --git a/flang/include/flang/Optimizer/Builder/BoxValue.h b/flang/include/flang/Optimizer/Builder/BoxValue.h
index 040555f3d907c9a..2fed2d48a7a080a 100644
--- a/flang/include/flang/Optimizer/Builder/BoxValue.h
+++ b/flang/include/flang/Optimizer/Builder/BoxValue.h
@@ -527,9 +527,6 @@ class ExtendedValue : public details::matcher<ExtendedValue> {
                  [](const auto &box) -> bool { return false; });
   }
 
-  /// Is this an assumed size array ?
-  bool isAssumedSize() const;
-
   /// LLVM style debugging of extended values
   LLVM_DUMP_METHOD void dump() const { llvm::errs() << *this << '\n'; }
 
diff --git a/flang/lib/Lower/ConvertVariable.cpp b/flang/lib/Lower/ConvertVariable.cpp
index dd024a0a1ec7927..02f63952a9aac07 100644
--- a/flang/lib/Lower/ConvertVariable.cpp
+++ b/flang/lib/Lower/ConvertVariable.cpp
@@ -684,6 +684,13 @@ static mlir::Value createNewLocal(Fortran::lower::AbstractConverter &converter,
   llvm::StringRef symNm = toStringRef(ultimateSymbol.name());
   bool isTarg = var.isTarget();
 
+  // Do not allocate storage for cray pointee. The address inside the cray
+  // pointer will be used instead when using the pointee. Allocating space
+  // would be a waste of space, and incorrect if the pointee is a non dummy
+  // assumed-size (possible with cray pointee).
+  if (ultimateSymbol.test(Fortran::semantics::Symbol::Flag::CrayPointee))
+    return builder.create<fir::ZeroOp>(loc, fir::ReferenceType::get(ty));
+
   // Let the builder do all the heavy lifting.
   if (!Fortran::semantics::IsProcedurePointer(ultimateSymbol))
     return builder.allocateLocal(loc, ty, nm, symNm, shape, lenParams, isTarg);
@@ -1454,6 +1461,15 @@ static void lowerExplicitLowerBounds(
   assert(result.empty() || result.size() == box.dynamicBound().size());
 }
 
+/// Return -1 for the last dimension extent/upper bound of assumed-size arrays.
+/// This value is required to fulfill the requirements for assumed-rank
+/// associated with assumed-size (see for instance UBOUND in 16.9.196, and
+/// CFI_desc_t requirements in 18.5.3 point 5.).
+static mlir::Value getAssumedSizeExtent(mlir::Location loc,
+                                        fir::FirOpBuilder &builder) {
+  return builder.createIntegerConstant(loc, builder.getIndexType(), -1);
+}
+
 /// Lower explicit extents into \p result if this is an explicit-shape or
 /// assumed-size array. Does nothing if this is not an explicit-shape or
 /// assumed-size array.
@@ -1485,7 +1501,8 @@ lowerExplicitExtents(Fortran::lower::AbstractConverter &converter,
             computeExtent(builder, loc, lowerBounds[spec.index()], ub));
     } else if (spec.value()->ubound().isStar()) {
       // Assumed extent is undefined. Must be provided by user's code.
-      result.emplace_back(builder.create<fir::UndefOp>(loc, idxTy));
+      // result.emplace_back(builder.create<fir::UndefOp>(loc, idxTy));
+      result.emplace_back(getAssumedSizeExtent(loc, builder));
     }
   }
   assert(result.empty() || result.size() == box.dynamicBound().size());
@@ -1521,7 +1538,7 @@ static mlir::Value genExtentValue(fir::FirOpBuilder &builder,
                                   long frontEndExtent) {
   if (frontEndExtent >= 0)
     return builder.createIntegerConstant(loc, idxTy, frontEndExtent);
-  return builder.create<fir::UndefOp>(loc, idxTy);
+  return getAssumedSizeExtent(loc, builder);
 }
 
 /// If a symbol is an array, it may have been declared with unknown extent
@@ -2000,7 +2017,7 @@ void Fortran::lower::mapSymbolAttributes(
             builder.create<fir::BoxDimsOp>(loc, idxTy, idxTy, idxTy, box, dim);
         shapes.emplace_back(dimInfo.getResult(1));
       } else if (spec->ubound().isStar()) {
-        shapes.emplace_back(builder.create<fir::UndefOp>(loc, idxTy));
+        shapes.emplace_back(getAssumedSizeExtent(loc, builder));
       } else {
         llvm::report_fatal_error("unknown bound category");
       }
@@ -2047,7 +2064,7 @@ void Fortran::lower::mapSymbolAttributes(
         } else {
           // An assumed size array. The extent is not computed.
           assert(spec->ubound().isStar() && "expected assumed size");
-          extents.emplace_back(builder.create<fir::UndefOp>(loc, idxTy));
+          extents.emplace_back(getAssumedSizeExtent(loc, builder));
         }
       }
     }
diff --git a/flang/lib/Lower/DirectivesCommon.h b/flang/lib/Lower/DirectivesCommon.h
index ffbd8ae1558ed5b..0920ff80f487b24 100644
--- a/flang/lib/Lower/DirectivesCommon.h
+++ b/flang/lib/Lower/DirectivesCommon.h
@@ -761,7 +761,7 @@ template <typename BoundsOp, typename BoundsType>
 llvm::SmallVector<mlir::Value>
 genBaseBoundsOps(fir::FirOpBuilder &builder, mlir::Location loc,
                  Fortran::lower::AbstractConverter &converter,
-                 fir::ExtendedValue dataExv) {
+                 fir::ExtendedValue dataExv, bool isAssumedSize) {
   mlir::Type idxTy = builder.getIndexType();
   mlir::Type boundTy = builder.getType<BoundsType>();
   llvm::SmallVector<mlir::Value> bounds;
@@ -770,14 +770,15 @@ genBaseBoundsOps(fir::FirOpBuilder &builder, mlir::Location loc,
     return bounds;
 
   mlir::Value one = builder.createIntegerConstant(loc, idxTy, 1);
-  for (std::size_t dim = 0; dim < dataExv.rank(); ++dim) {
+  const unsigned rank = dataExv.rank();
+  for (unsigned dim = 0; dim < rank; ++dim) {
     mlir::Value baseLb =
         fir::factory::readLowerBound(builder, loc, dataExv, dim, one);
     mlir::Value zero = builder.createIntegerConstant(loc, idxTy, 0);
     mlir::Value ub;
     mlir::Value lb = zero;
     mlir::Value ext = fir::factory::readExtent(builder, loc, dataExv, dim);
-    if (mlir::isa<fir::UndefOp>(ext.getDefiningOp())) {
+    if (isAssumedSize && dim + 1 == rank) {
       ext = zero;
       ub = lb;
     } else {
@@ -801,7 +802,8 @@ genBoundsOps(fir::FirOpBuilder &builder, mlir::Location loc,
              Fortran::lower::StatementContext &stmtCtx,
              const std::list<Fortran::parser::SectionSubscript> &subscripts,
              std::stringstream &asFortran, fir::ExtendedValue &dataExv,
-             mlir::Value baseAddr, bool treatIndexAsSection = false) {
+             bool dataExvIsAssumedSize, mlir::Value baseAddr,
+             bool treatIndexAsSection = false) {
   int dimension = 0;
   mlir::Type idxTy = builder.getIndexType();
   mlir::Type boundTy = builder.getType<BoundsType>();
@@ -809,6 +811,7 @@ genBoundsOps(fir::FirOpBuilder &builder, mlir::Location loc,
 
   mlir::Value zero = builder.createIntegerConstant(loc, idxTy, 0);
   mlir::Value one = builder.createIntegerConstant(loc, idxTy, 1);
+  const int dataExvRank = static_cast<int>(dataExv.rank());
   for (const auto &subscript : subscripts) {
     const auto *triplet{
         std::get_if<Fortran::parser::SubscriptTriplet>(&subscript.u)};
@@ -912,7 +915,7 @@ genBoundsOps(fir::FirOpBuilder &builder, mlir::Location loc,
         }
 
         extent = fir::factory::readExtent(builder, loc, dataExv, dimension);
-        if (mlir::isa<fir::UndefOp>(extent.getDefiningOp())) {
+        if (dataExvIsAssumedSize && dimension + 1 == dataExvRank) {
           extent = zero;
           if (ubound && lbound) {
             mlir::Value diff =
@@ -959,6 +962,7 @@ AddrAndBoundsInfo gatherDataOperandAddrAndBounds(
                 const auto *dataRef =
                     std::get_if<Fortran::parser::DataRef>(&designator.u);
                 fir::ExtendedValue dataExv;
+                bool dataExvIsAssumedSize = false;
                 if (Fortran::parser::Unwrap<
                         Fortran::parser::StructureComponent>(
                         arrayElement->base)) {
@@ -971,6 +975,8 @@ AddrAndBoundsInfo gatherDataOperandAddrAndBounds(
                 } else {
                   const Fortran::parser::Name &name =
                       Fortran::parser::GetLastName(*dataRef);
+                  dataExvIsAssumedSize = Fortran::semantics::IsAssumedSizeArray(
+                      name.symbol->GetUltimate());
                   info = getDataOperandBaseAddr(converter, builder,
                                                 *name.symbol, operandLocation);
                   dataExv = converter.getSymbolExtendedValue(*name.symbol);
@@ -981,8 +987,8 @@ AddrAndBoundsInfo gatherDataOperandAddrAndBounds(
                   asFortran << '(';
                   bounds = genBoundsOps<BoundsOp, BoundsType>(
                       builder, operandLocation, converter, stmtCtx,
-                      arrayElement->subscripts, asFortran, dataExv, info.addr,
-                      treatIndexAsSection);
+                      arrayElement->subscripts, asFortran, dataExv,
+                      dataExvIsAssumedSize, info.addr, treatIndexAsSection);
                 }
                 asFortran << ')';
               } else if (auto structComp = Fortran::parser::Unwrap<
@@ -993,7 +999,8 @@ AddrAndBoundsInfo gatherDataOperandAddrAndBounds(
                 if (fir::unwrapRefType(info.addr.getType())
                         .isa<fir::SequenceType>())
                   bounds = genBaseBoundsOps<BoundsOp, BoundsType>(
-                      builder, operandLocation, converter, compExv);
+                      builder, operandLocation, converter, compExv,
+                      /*isAssumedSize=*/false);
                 asFortran << (*expr).AsFortran();
 
                 bool isOptional = Fortran::semantics::IsOptional(
@@ -1047,10 +1054,14 @@ AddrAndBoundsInfo gatherDataOperandAddrAndBounds(
                     bounds = genBoundsOpsFromBox<BoundsOp, BoundsType>(
                         builder, operandLocation, converter, dataExv, info);
                   }
+                  bool dataExvIsAssumedSize =
+                      Fortran::semantics::IsAssumedSizeArray(
+                          name.symbol->GetUltimate());
                   if (fir::unwrapRefType(info.addr.getType())
                           .isa<fir::SequenceType>())
                     bounds = genBaseBoundsOps<BoundsOp, BoundsType>(
-                        builder, operandLocation, converter, dataExv);
+                        builder, operandLocation, converter, dataExv,
+                        dataExvIsAssumedSize);
                   asFortran << name.ToString();
                 } else { // Unsupported
                   llvm::report_fatal_error(
diff --git a/flang/lib/Lower/OpenMP.cpp b/flang/lib/Lower/OpenMP.cpp
index bebae92f2f9f0fd..d2215f4d1bf1ce3 100644
--- a/flang/lib/Lower/OpenMP.cpp
+++ b/flang/lib/Lower/OpenMP.cpp
@@ -2915,11 +2915,14 @@ genTargetOp(Fortran::lower::AbstractConverter &converter,
                                                   mlir::omp::DataBoundsType>(
                   converter.getFirOpBuilder(), converter.getCurrentLocation(),
                   converter, dataExv, info);
-        if (fir::unwrapRefType(info.addr.getType()).isa<fir::SequenceType>())
+        if (fir::unwrapRefType(info.addr.getType()).isa<fir::SequenceType>()) {
+          bool dataExvIsAssumedSize =
+              Fortran::semantics::IsAssumedSizeArray(sym.GetUltimate());
           bounds = Fortran::lower::genBaseBoundsOps<mlir::omp::DataBoundsOp,
                                                     mlir::omp::DataBoundsType>(
               converter.getFirOpBuilder(), converter.getCurrentLocation(),
-              converter, dataExv);
+              converter, dataExv, dataExvIsAssumedSize);
+        }
 
         llvm::omp::OpenMPOffloadMappingFlags mapFlag =
             llvm::omp::OpenMPOffloadMappingFlags::OMP_MAP_IMPLICIT;
diff --git a/flang/lib/Optimizer/Builder/BoxValue.cpp b/flang/lib/Optimizer/Builder/BoxValue.cpp
index ada315493ba456e..361fa59e2040377 100644
--- a/flang/lib/Optimizer/Builder/BoxValue.cpp
+++ b/flang/lib/Optimizer/Builder/BoxValue.cpp
@@ -232,19 +232,3 @@ mlir::Value fir::factory::getExtentAtDimension(mlir::Location loc,
     return extents[dim];
   return {};
 }
-
-static inline bool isUndefOp(mlir::Value v) {
-  return mlir::isa_and_nonnull<fir::UndefOp>(v.getDefiningOp());
-}
-
-bool fir::ExtendedValue::isAssumedSize() const {
-  return match(
-      [](const fir::ArrayBoxValue &box) -> bool {
-        return !box.getExtents().empty() && isUndefOp(box.getExtents().back());
-        ;
-      },
-      [](const fir::CharArrayBoxValue &box) -> bool {
-        return !box.getExtents().empty() && isUndefOp(box.getExtents().back());
-      },
-      [](const auto &box) -> bool { return false; });
-}
diff --git a/flang/lib/Optimizer/Builder/IntrinsicCall.cpp b/flang/lib/Optimizer/Builder/IntrinsicCall.cpp
index d7816500694421e..ff3a3da43c00a1d 100644
--- a/flang/lib/Optimizer/Builder/IntrinsicCall.cpp
+++ b/flang/lib/Optimizer/Builder/IntrinsicCall.cpp
@@ -5691,10 +5691,10 @@ static mlir::Value computeLBOUND(fir::FirOpBuilder &builder, mlir::Location loc,
   if (hasDefaultLowerBound(array))
     return one;
   mlir::Value lb = fir::factory::readLowerBound(builder, loc, array, dim, one);
-  if (dim + 1 == array.rank() && array.isAssumedSize())
-    return lb;
   mlir::Value extent = fir::factory::readExtent(builder, loc, array, dim);
   zero = builder.createConvert(loc, extent.getType(), zero);
+  // Note: for assumed size, the extent is -1, and the lower bound should
+  // be return. It is important to test extent == 0 and not extent > 0.
   auto dimIsEmpty = builder.create<mlir::arith::CmpIOp>(
       loc, mlir::arith::CmpIPredicate::eq, extent, zero);
   one = builder.createConvert(loc, lb.getType(), one);
@@ -5703,52 +5703,29 @@ static mlir::Value computeLBOUND(fir::FirOpBuilder &builder, mlir::Location loc,
 
 /// Create a fir.box to be passed to the LBOUND/UBOUND runtime.
 /// This ensure that local lower bounds of assumed shape are propagated and that
-/// a fir.box with equivalent LBOUNDs but an explicit shape is created for
-/// assumed size arrays to avoid undefined behaviors in codegen or the runtime.
+/// a fir.box with equivalent LBOUNDs.
 static mlir::Value
 createBoxForRuntimeBoundInquiry(mlir::Location loc, fir::FirOpBuilder &builder,
                                 const fir::ExtendedValue &array) {
-  if (!array.isAssumedSize())
-    return array.match(
-        [&](const fir::BoxValue &boxValue) -> mlir::Value {
-          // This entity is mapped to a fir.box that may not contain the local
-          // lower bound information if it is a dummy. Rebox it with the local
-          // shape information.
-          mlir::Value localShape = builder.createShape(loc, array);
-          mlir::Value oldBox = boxValue.getAddr();
-          return builder.create<fir::ReboxOp>(loc, oldBox.getType(), oldBox,
-                                              localShape,
-                                              /*slice=*/mlir::Value{});
-        },
-        [&](const auto &) -> mlir::Value {
-          // This a pointer/allocatable, or an entity not yet tracked with a
-          // fir.box. For pointer/allocatable, createBox will forward the
-          // descriptor that contains the correct lower bound information. For
-          // other entities, a new fir.box will be made with the local lower
-          // bounds.
-          return builder.createBox(loc, array);
-        });
-  // Assumed sized are not meant to be emboxed. This could cause the undefined
-  // extent cannot safely be understood by the runtime/codegen that will
-  // consider that the dimension is empty and that the related LBOUND value must
-  // be one. Pretend that the related extent is one to get the correct LBOUND
-  // value.
-  llvm::SmallVector<mlir::Value> shape =
-      fir::factory::getExtents(loc, builder, array);
-  assert(!shape.empty() && "assumed size must have at least one dimension");
-  shape.back() = builder.createIntegerConstant(loc, builder.getIndexType(), 1);
-  auto safeToEmbox = array.match(
-      [&](const fir::CharArrayBoxValue &x) -> fir::ExtendedValue {
-        return fir::CharArrayBoxValue{x.getAddr(), x.getLen(), shape,
-                                      x.getLBounds()};
-      },
-      [&](const fir::ArrayBoxValue &x) -> fir::ExtendedValue {
-        return fir::ArrayBoxValue{x.getAddr(), shape, x.getLBounds()};
+  return array.match(
+      [&](const fir::BoxValue &boxValue) -> mlir::Value {
+        // This entity is mapped to a fir.box that may not contain the local
+        // lower bound information if it is a dummy. Rebox it with the local
+        // shape information.
+        mlir::Value localShape = builder.createShape(loc, array);
+        mlir::Value oldBox = boxValue.getAddr();
+        return builder.create<fir::ReboxOp>(loc, oldBox.getType(), oldBox,
+                                            localShape,
+                                            /*slice=*/mlir::Value{});
       },
-      [&](const auto &) -> fir::ExtendedValue {
-        fir::emitFatalError(loc, "not an assumed size array");
+      [&](const auto &) -> mlir::Value {
+        // This a pointer/allocatable, or an entity not yet tracked with a
+        // fir.box. For pointer/allocatable, createBox will forward the
+        // descriptor that contains the correct lower bound information. For
+        // other entities, a new fir.box will be made with the local lower
+        // bounds.
+        return builder.createBox(loc, array);
       });
-  return builder.createBox(loc, safeToEmbox);
 }
 
 // LBOUND
diff --git a/flang/lib/Optimizer/Transforms/ArrayValueCopy.cpp b/flang/lib/Optimizer/Transforms/ArrayValueCopy.cpp
index 5a4997052b18a1d..7e77e4aaa746314 100644
--- a/flang/lib/Optimizer/Transforms/ArrayValueCopy.cpp
+++ b/flang/lib/Optimizer/Transforms/ArrayValueCopy.cpp
@@ -6,7 +6,6 @@
 //
 //===----------------------------------------------------------------------===//
 
-#include "flang/Optimizer/Builder/Array.h"
 #include "flang/Optimizer/Builder/BoxValue.h"
 #include "flang/Optimizer/Builder/FIRBuilder.h"
 #include "flang/Optimizer/Builder/Factory.h"
@@ -822,6 +821,16 @@ static mlir::Type getEleTy(mlir::Type ty) {
   return ReferenceType::get(eleTy);
 }
 
+// This is an unsafe safe way to deduce this (won't be true in internal
+// procedure or inside select-rank for assumed-size). Only here to satisfy
+// legacy code until removed.
+static bool isAssumedSize(llvm::SmallVectorImpl<mlir::Value> &extents) {
+  if (extents.empty())
+    return false;
+  auto cstLen = fir::getIntIfConstant(extents.back());
+  return cstLen.has_value() && *cstLen == -1;
+}
+
 // Extract extents from the ShapeOp/ShapeShiftOp into the result vector.
 static bool getAdjustedExtents(mlir::Location loc,
                                mlir::PatternRewriter &rewriter,
@@ -840,7 +849,7 @@ static bool getAdjustedExtents(mlir::Location loc,
     emitFatalError(loc, "not a fir.shape/fir.shape_shift op");
   }
   auto idxTy = rewriter.getIndexType();
-  if (factory::isAssumedSize(result)) {
+  if (isAssumedSize(result)) {
     // Use slice information to compute the extent of the column.
     auto one = rewriter.create<mlir::arith::ConstantIndexOp>(loc, 1);
     mlir::Value size = one;
diff --git a/flang/test/Lower/HLFIR/assumed-size-cray-pointee.f90 b/flang/test/Lower/HLFIR/assumed-size-cray-pointee.f90
new file mode 100644
index 000000000000000..6e3138fbe3f4dc3
--- /dev/null
+++ b/flang/test/Lower/HLFIR/assumed-size-cray-pointee.f90
@@ -0,0 +1,14 @@
+! Test lowering of assumed-size cray pointee. This is an
+! odd case where an assumed-size symbol is not a dummy.
+! Test that no bogus stack allocation is created for it
+! (it will take its address from the cray pointer when used).
+! RUN: bbc -emit-hlfir -o - %s | FileCheck %s
+
+subroutine assumed_size_cray_ptr
+  implicit none
+  pointer(ivar,var)
+  real :: var(*)
+end subroutine
+! CHECK-LABEL: func.func @_QPassumed_size_cray_ptr
+! CHECK-NOT: fir.alloca !fir.array<?xf32>
+! CHECK: return
diff --git a/flang/test/Lower/HLFIR/cray-pointers.f90 b/flang/test/Lower/HLFIR/cray-pointers.f90
index 1ee0b2e0b0b94a3..d1f1a5647ff1ca8 100644
--- a/flang/test/Lower/HLFIR/cray-pointers.f90
+++ b/flang/test/Lower/HLFIR/cray-pointers.f90
@@ -125,7 +125,6 @@ end subroutine test5
 ! CHECK:           %[[VAL_2:.*]]:2 = hlfir.declare %[[VAL_1]] {uniq_name = "_QFtest5Ecp"} : (!fir.ref<i64>) -> (!fir.ref<i64>, !fir.ref<i64>)
 ! CHECK:           %[[VAL_5:.*]] = arith.constant 3 : index
 ! CHECK:           %[[VAL_6:.*]] = arith.constant 9 : index
-! CHECK:           %[[VAL_7:.*]] = fir.alloca !fir.array<9x!fir.type<_QFtest5Tt{r:f32,i:i32}>> {bindc_name = "v", uniq_name = "_QFtest5Ev"}
 ! CHECK:           %[[VAL_8:.*]] = fir.shape_shift %[[VAL_5]], %[[VAL_6]] : (index, index) -> !fir.shapeshift<1>
 ! CHECK:           %[[VAL_13:.*]]:2 = hlfir.declare %[[VAL_0]] {fortran_attrs = #fir.var_attrs<pointer>, uniq_name = "_QFtest5Ev"} : (!fir.ref<!fir.box<!fir.ptr<!fir.array<?x!fir.type<_QFtest5Tt{r:f32,i:i32}>>>>>) -> (!fir.ref<!fir.box<!fir.ptr<!fir.array<?x!fir.type<_QFtest5Tt{r:f32,i:i32}>>>>>, !fir.ref<!fir.box<!fir.ptr<!fir.array<?x!fir.type<_QFtest5Tt{r:f32,i:i32}>>>>>)
 ! CHECK:           %[[VAL_14:.*]] = fir.zero_bits !fir.ptr<!fir.array<?x!fir.type<_QFtest5Tt{r:f32,i:i32}>>>
@@ -206,7 +205,6 @@ end subroutine test7
 ! CHECK:    %[[VAL_4:.*]] = fir.shape %[[VAL_2]] : (index) -> !fir.shape<1>
 ! CHECK:    %[[VAL_5:.*]]:2 = hlfir.declare %[[VAL_3]](%[[VAL_4]]) {uniq_name = "_QFtest7Earr"} : (!fir.ref<!fir.array<5xi32>>, !fir.shape<1>) -> (!fir.ref<!fir.array<5xi32>>, !fir.ref<!fir.array<5xi32>>)
 ! CHECK:    %[[VAL_6:.*]] = arith.constant 5 : index
-! CHECK:    %[[VAL_7:.*]] = fir.alloca !fir.array<5xi32> {bindc_name = "pte", uniq_name = "_QFtest7Epte"}
 ! CHECK:    %[[VAL_8:.*]] = fir.shape %[[VAL_6]] : (index) -> !fir.shape<1>
 ! CHECK:    %[[VAL_9:.*]]:2 = hlfir.declare %[[VAL_1]] {fortran_attrs = #fir.var_attrs<pointer>, uniq_name = "_QFtest7Epte"} : (!fir.ref<!fir.box<!fir.ptr<!fir.array<?xi32>>>>) -> (!fir.ref<!fir.box<!fir.ptr<!fir.array<?xi32>>>>, !fir.ref<!fir.box<!fir.ptr<!fir.array<?xi32>>>>)
 ! CHECK:    %[[VAL_10:.*]] = fir.zero_bits !fir.ptr<!fir.array<?xi32>>
@@ -229,7 +227,6 @@ end subroutine test8
 ! CHECK-LABEL:     func.func @_QPtest8(
 ! CHECK:    %[[VAL_1:.*]] = fir.alloca !fir.box<!fir.ptr<!fir.array<?xi32>>>
 ! CHECK:    %[[VAL_2:.*]] = arith.constant 5 : index
-! CHECK:    %[[VAL_3:.*]] = fir.alloca !fir.array<5xi32> {bindc_name = "pte", uniq_name = "_QFtest8Epte"}
 ! CHECK:    %[[VAL_4:.*]] = fir.shape %[[VAL_2]] : (index) -> !fir.shape<1>
 ! CHECK:    %[[VAL_5:.*]]:2 = hlfir.declare %[[VAL_1]] {fortran_attrs = #fir.var_attrs<pointer>, uniq_name = "_QFtest8Epte"} : (!fir.ref<!fir.box<!fir.ptr<!fir.array<?xi32>>>>) -> (!fir.ref<!fir.box<!fir.ptr<!fir.array<?xi32>>>>, !fir.ref<!fir.box<!fir.ptr<!fir.array<?xi32>>>>)
 ! CHECK:    %[[VAL_6:.*]] = fir.zero_bits !fir.ptr<!fir.array<?xi32>>
@@ -260,7 +257,6 @@ end subroutine test9
 ! CHECK-LABEL:     func.func @_QPtest9(
 ! CHECK:    %[[VAL_1:.*]] = fir.alloca !fir.box<!fir.ptr<!fir.array<?xi32>>>
 ! CHECK:    %[[VAL_2:.*]] = arith.constant 5 : index
-! CHECK:    %[[VAL_3:.*]] = fir.alloca !fir.array<5xi32> {bindc_name = "pte", uniq_name = "_QFtest9Epte"}
 ! CHECK:    %[[VAL_4:.*]] = fir.shape %[[VAL_2]] : (index) -> !fir.shape<1>
 ! CHECK:    %[[VAL_5:.*]]:2 = hlfir.declare %[[VAL_1]] {fortran_attrs = #fir.var_attrs<pointer>, uniq_name = "_QFtest9Epte"} : (!fir.ref<!fir.box<!fir.ptr<!fir.array<?xi32>>>>) -> (!fir.ref<!fir.box<!fir.ptr<!fir.array<?xi32>>>>, !fir.ref<!fir.box<!fir.ptr<!fir.array<?xi32>>>>)
 ! CHECK:    %[[VAL_6:.*]] = fir.zero_bits !fir.ptr<!fir.array<?xi32>>
@@ -291,7 +287,6 @@ subroutine test10()
 end subroutine test10
 ! CHECK-LABEL:  func.func @_QPtest10(
 ! CHECK:    %[[VAL_1:.*]] = fir.alloca !fir.box<!fir.ptr<i32>>
-! CHECK:    %[[VAL_2:.*]] = fir.alloca i32 {bindc_name = "pte", uniq_name = "_QFtest10Epte"}
 ! CHECK:    %[[VAL_3:.*]]:2 = hlfir.declare %[[VAL_1]] {fortran_attrs = #fir.var_attrs<pointer>, uniq_name = "_QFtest10Epte"} : (!fir.ref<!fir.box<!fir.ptr<i32>>>) -> (!fir.ref<!fir.box<!fir.ptr<i32>>>, !fir.ref<!fir.box<!fir.ptr<i32>>>)
 ! CHECK:    %[[VAL_4:.*]] = fir.zero_bits !fir.ptr<i32>
 ! CHECK:    %[[VAL_5:.*]] = fir.embox %[[VAL_4]] : (!fir.ptr<i32>) -> !fir.box<!fir.ptr<i32>>
@@ -320,7 +315,6 @@ subroutine sub2(x)
 end subroutine test11
 ! CHECK-LABEL:  func.func @_QPtest11(
 ! CHECK:    %[[VAL_1:.*]] = fir.alloca !fir.box<!fir.ptr<i32>>
-! CHECK:    %[[VAL_2:.*]] = fir.alloca i32 {bindc_name = "pte", uniq_name = "_QFtest11Epte"}
 ! CHECK:    %[[VAL_3:.*]]:2 = hlfir.declare %[[VAL_1]] {fortran_attrs = #fir.var_attrs<pointer>, uniq_name = "_QFtest11Epte"} : (!fir.ref<!fir.box<!fir.ptr<i32>>>) -> (!fir.ref<!fir.box<!fir.ptr<i32>>>, !fir.ref<!fir.box<!fir.ptr<i32>>>)
 ! CHECK:    %[[VAL_4:.*]] = fir.zero_bits !fir.ptr<i32>
 ! CHECK:    %[[VAL_5:.*]] = fir.embox %[[VAL_4]] : (!fir.ptr<i32>) -> !fir.box<!fir.ptr<i32>>
diff --git a/flang/test/Lower/Intrinsics/lbound.f90 b/flang/test/Lower/Intrinsics/lbound.f90
index 54d2683e14f1ce3..a5ca2d39a5ee474 100644
--- a/flang/test/Lower/Intrinsics/lbound.f90
+++ b/flang/test/Lower/Intrinsics/lbound.f90
@@ -40,8 +40,8 @@ subroutine lbound_test_2(a, dim, res)
 subroutine lbound_test_3(a, dim, res)
   real, dimension(2:10, 3:*) :: a
   integer(8):: dim, res
+! CHECK:  %[[VAL_0:.*]] = arith.constant -1 : index
 ! CHECK:  %[[VAL_1:.*]] = fir.load %arg1 : !fir.ref<i64>
-! CHECK:  %[[VAL_0:.*]] = arith.constant 1 : index
 ! CHECK:  %[[VAL_2:.*]] = fir.shape_shift %{{.*}}, %{{.*}}, %{{.*}}, %[[VAL_0]] : (index, index, index, index) -> !fir.shapeshift<2>
 ! CHECK:         %[[VAL_3:.*]] = fir.embox %arg0(%[[VAL_2]]) : (!fir.ref<!fir.array<9x?xf32>>, !fir.shapeshift<2>) -> !fir.box<!fir.array<9x?xf32>>
 ! CHECK:         %[[VAL_4:.*]] = fir.address_of(
diff --git a/flang/test/Lower/Intrinsics/ubound.f90 b/flang/test/Lower/Intrinsics/ubound.f90
index 889414d1dd76997..dae21acda170da1 100644
--- a/flang/test/Lower/Intrinsics/ubound.f90
+++ b/flang/test/Lower/Intrinsics/ubound.f90
@@ -48,7 +48,7 @@ subroutine ubound_test_2(a, dim, res)
 subroutine ubound_test_3(a, dim, res)
   real, dimension(10, 20, *) :: a
   integer(8):: dim, res
-! CHECK:         %[[VAL_0:.*]] = fir.undefined index
+! CHECK:         %[[VAL_0:.*]] = arith.constant -1 : index
 ! CHECK:         %[[VAL_1:.*]] = fir.shape %{{.*}}, %{{.*}}, %[[VAL_0]] : (index, index, index) -> !fir.shape<3>
 ! CHECK:         %[[VAL_2:.*]] = fir.embox %{{.*}}(%[[VAL_1]]) : (!fir.ref<!fir.array<10x20x?xf32>>, !fir.shape<3>) -> !fir.box<!fir.array<10x20x?xf32>>
 ! CHECK:         %[[VAL_3:.*]] = fir.load %{{.*}} : !fir.ref<i64>
diff --git a/flang/test/Lower/array-expression-assumed-size.f90 b/flang/test/Lower/array-expression-assumed-size.f90
index b5fd09103aa0b52..ae35da951538b8c 100644
--- a/flang/test/Lower/array-expression-assumed-size.f90
+++ b/flang/test/Lower/array-expression-assumed-size.f90
@@ -19,7 +19,7 @@ end subroutine assumed_size_forall_test
 ! CHECK:         %[[VAL_1A:.*]] = fir.convert %c10{{.*}} : (i64) -> index 
 ! CHECK:         %[[VAL_1B:.*]] = arith.cmpi sgt, %[[VAL_1A]], %c0{{.*}} : index 
 ! CHECK:         %[[VAL_1:.*]] = arith.select %[[VAL_1B]], %[[VAL_1A]], %c0{{.*}} : index
-! CHECK:         %[[VAL_2:.*]] = fir.undefined index
+! CHECK:         %[[VAL_2:.*]] = arith.constant -1 : index
 ! CHECK:         %[[VAL_3:.*]] = arith.constant 1 : index
 ! CHECK:         %[[VAL_4:.*]] = arith.constant 1 : i64
 ! CHECK:         %[[VAL_5:.*]] = fir.convert %[[VAL_4]] : (i64) -> index
@@ -82,7 +82,7 @@ end subroutine assumed_size_forall_test
 ! CHECK:         %[[VAL_2A:.*]] = fir.convert %c10{{.*}} : (i64) -> index 
 ! CHECK:         %[[VAL_2B:.*]] = arith.cmpi sgt, %[[VAL_2A]], %c0{{.*}} : index 
 ! CHECK:         %[[VAL_2:.*]] = arith.select %[[VAL_2B]], %[[VAL_2A]], %c0{{.*}} : index
-! CHECK:         %[[VAL_3:.*]] = fir.undefined index
+! CHECK:         %[[VAL_3:.*]] = arith.constant -1 : index
 ! CHECK:         %[[VAL_4:.*]] = arith.constant 2 : i32
 ! CHECK:         %[[VAL_5:.*]] = fir.convert %[[VAL_4]] : (i32) -> index
 ! CHECK:         %[[VAL_6:.*]] = arith.constant 6 : i32
@@ -149,7 +149,7 @@ end subroutine assumed_size_forall_test
 ! PostOpt-DAG:         %[[VAL_4:.*]] = arith.constant 0 : index
 ! PostOpt-DAG:         %[[VAL_5:.*]] = arith.constant 3 : index
 ! PostOpt-DAG:         %[[VAL_6:.*]] = arith.constant 4 : index
-! PostOpt:         %[[VAL_7:.*]] = fir.undefined index
+! PostOpt-DAG:         %[[VAL_7:.*]] = arith.constant -1 : index
 ! PostOpt:         %[[VAL_8:.*]] = fir.shape %[[VAL_1]], %[[VAL_7]] : (index, index) -> !fir.shape<2>
 ! PostOpt:         %[[VAL_9:.*]] = fir.slice %[[VAL_2]], %[[VAL_1]], %[[VAL_2]], %[[VAL_2]], %[[VAL_3]], %[[VAL_2]] : (index, index, index, index, index, index) -> !fir.slice<2>
 ! PostOpt:         %[[VAL_10:.*]] = fir.allocmem !fir.array<10x?xi32>, %[[VAL_3]]
@@ -227,8 +227,8 @@ end subroutine assumed_size_forall_test
 ! PostOpt-DAG:         %[[VAL_4:.*]] = arith.constant 1 : index
 ! PostOpt-DAG:         %[[VAL_5:.*]] = arith.constant 0 : index
 ! PostOpt-DAG:         %[[VAL_6:.*]] = arith.constant 5 : index
+! PostOpt-DAG:         %[[VAL_8:.*]] = arith.constant -1 : index
 ! PostOpt:         %[[VAL_7:.*]] = fir.alloca i32 {adapt.valuebyref, bindc_name = "i"}
-! PostOpt:         %[[VAL_8:.*]] = fir.undefined index
 ! PostOpt:         %[[VAL_9:.*]] = fir.shape %[[VAL_2]], %[[VAL_8]] : (index, index) -> !fir.shape<2>
 ! PostOpt:         %[[VAL_10:.*]] = fir.allocmem !fir.array<10x?xi32>, %[[VAL_4]]
 ! PostOpt:         br ^bb1(%[[VAL_5]], %[[VAL_4]] : index, index)
diff --git a/flang/test/Lower/cray-pointer.f90 b/flang/test/Lower/cray-pointer.f90
index d13d3c542e77148..4e9f49daab4e996 100644
--- a/flang/test/Lower/cray-pointer.f90
+++ b/flang/test/Lower/cray-pointer.f90
@@ -59,7 +59,6 @@ subroutine cray_derivedType()
 
 ! CHECK: %[[dt:.*]] = fir.alloca !fir.type<_QFcray_derivedtypeTdt{i:i32,j:i32}>
 ! CHECK: %[[k:.*]] = fir.alloca i32 {{.*}}
-! CHECK: %[[pte:.*]] = fir.alloca i32 {{.*}}
 ! CHECK: %[[ptr:.*]] = fir.alloca i64 {{.*}}
 ! CHECK: %[[xdt:.*]] = fir.alloca !fir.type<_QFcray_derivedtypeTdt{i:i32,j:i32}> {{.*}}
 ! CHECK: %[[xdtbox:.*]] = fir.embox %[[xdt]] : (!fir.ref<!fir.type<_QFcray_derivedtypeTdt{i:i32,j:i32}>>) -> !fir.box<!fir.type<_QFcray_derivedtypeTdt{i:i32,j:i32}>>
@@ -107,7 +106,6 @@ subroutine cray_ptrArth()
 
 ! CHECK: %[[dt:.*]] = fir.alloca !fir.type<_QFcray_ptrarthTdt{x:i32,y:i32,z:i32}>
 ! CHECK: %[[i:.*]] = fir.alloca i32 {{.*}}
-! CHECK: %[[pte:.*]] = fir.alloca i32 {{.*}}
 ! CHECK: %[[ptr:.*]] = fir.alloca i64 {{.*}}
 ! CHECK: %[[xdt:.*]] = fir.alloca !fir.type<_QFcray_ptrarthTdt{x:i32,y:i32,z:i32}> {{.*}}
 ! CHECK: %[[xdtbox:.*]] = fir.embox %[[xdt]] : (!fir.ref<!fir.type<_QFcray_ptrarthTdt{x:i32,y:i32,z:i32}>>) -> !fir.box<!fir.type<_QFcray_ptrarthTdt{x:i32,y:i32,z:i32}>>
@@ -154,7 +152,6 @@ subroutine cray_arrayElement()
 
 ! CHECK: %[[data:.*]] = fir.alloca !fir.array<5xi32> {{.*}}
 ! CHECK: %[[k:.*]] = fir.alloca i32 {{.*}}
-! CHECK: %[[pte:.*]] = fir.alloca !fir.array<3xi32> {{.*}}
 ! CHECK: %[[ptr:.*]] = fir.alloca i64 {{.*}}
 ! CHECK: %[[c2:.*]] = arith.constant 2 : i64
 ! CHECK: %[[c1:.*]] = arith.constant 1 : i64
@@ -206,7 +203,6 @@ subroutine cray_2darrayElement()
 
 ! CHECK: %[[data:.*]] = fir.alloca !fir.array<2x4xi32> {{.*}}
 ! CHECK: %[[k:.*]] = fir.alloca i32 {{.*}}
-! CHECK: %[[pte:.*]] = fir.alloca !fir.array<2x3xi32> {{.*}}
 ! CHECK: %[[ptr:.*]] = fir.alloca i64 {{.*}}
 ! CHECK: %[[c2:.*]] = arith.constant 2 : i64
 ! CHECK: %[[c1:.*]] = arith.constant 1 : i64
@@ -269,7 +265,6 @@ subroutine cray_array()
 ! CHECK: %[[c3:.*]] = arith.constant 3 : index
 ! CHECK: %[[k:.*]] = fir.alloca !fir.array<3xi32> {{.*}}
 ! CHECK: %[[c31:.*]] = arith.constant 3 : index
-! CHECK: %[[pte:.*]] = fir.alloca !fir.array<3xi32> {{.*}}
 ! CHECK: %[[ptr:.*]] = fir.alloca i64 {{.*}}
 ! CHECK: %[[c2:.*]] = arith.constant 2 : i64
 ! CHECK: %[[c1:.*]] = arith.constant 1 : i64
@@ -333,7 +328,6 @@ subroutine cray_arraySection()
 ! CHECK: %[[c2:.*]] = arith.constant 2 : index
 ! CHECK: %[[k:.*]] = fir.alloca !fir.array<2xi32> {{.*}}
 ! CHECK: %[[c3:.*]] = arith.constant 3 : index
-! CHECK: %[[pte:.*]] = fir.alloca !fir.array<3xi32> {{.*}}
 ! CHECK: %[[ptr:.*]] = fir.alloca i64 {{.*}}
 ! CHECK: %[[c1:.*]] = arith.constant 2 : i64
 ! CHECK: %[[c0:.*]] = arith.constant 1 : i64

>From 92cd82a782c39f50a9ac485abf0853b2cfcb8f5f Mon Sep 17 00:00:00 2001
From: Jean Perier <jperier at nvidia.com>
Date: Tue, 23 Jan 2024 23:54:31 -0800
Subject: [PATCH 2/2] update outdated comments

---
 flang/lib/Lower/ConvertVariable.cpp               | 6 +-----
 flang/lib/Optimizer/Transforms/ArrayValueCopy.cpp | 2 +-
 2 files changed, 2 insertions(+), 6 deletions(-)

diff --git a/flang/lib/Lower/ConvertVariable.cpp b/flang/lib/Lower/ConvertVariable.cpp
index 02f63952a9aac07..006cc1417b63d11 100644
--- a/flang/lib/Lower/ConvertVariable.cpp
+++ b/flang/lib/Lower/ConvertVariable.cpp
@@ -1500,8 +1500,6 @@ lowerExplicitExtents(Fortran::lower::AbstractConverter &converter,
         result.emplace_back(
             computeExtent(builder, loc, lowerBounds[spec.index()], ub));
     } else if (spec.value()->ubound().isStar()) {
-      // Assumed extent is undefined. Must be provided by user's code.
-      // result.emplace_back(builder.create<fir::UndefOp>(loc, idxTy));
       result.emplace_back(getAssumedSizeExtent(loc, builder));
     }
   }
@@ -1530,9 +1528,7 @@ lowerExplicitCharLen(Fortran::lower::AbstractConverter &converter,
   return mlir::Value{};
 }
 
-/// Treat negative values as undefined. Assumed size arrays will return -1 from
-/// the front end for example. Using negative values can produce hard to find
-/// bugs much further along in the compilation.
+/// Assumed size arrays last extent is -1 in the front end.
 static mlir::Value genExtentValue(fir::FirOpBuilder &builder,
                                   mlir::Location loc, mlir::Type idxTy,
                                   long frontEndExtent) {
diff --git a/flang/lib/Optimizer/Transforms/ArrayValueCopy.cpp b/flang/lib/Optimizer/Transforms/ArrayValueCopy.cpp
index 7e77e4aaa746314..29717353da96380 100644
--- a/flang/lib/Optimizer/Transforms/ArrayValueCopy.cpp
+++ b/flang/lib/Optimizer/Transforms/ArrayValueCopy.cpp
@@ -821,7 +821,7 @@ static mlir::Type getEleTy(mlir::Type ty) {
   return ReferenceType::get(eleTy);
 }
 
-// This is an unsafe safe way to deduce this (won't be true in internal
+// This is an unsafe way to deduce this (won't be true in internal
 // procedure or inside select-rank for assumed-size). Only here to satisfy
 // legacy code until removed.
 static bool isAssumedSize(llvm::SmallVectorImpl<mlir::Value> &extents) {



More information about the flang-commits mailing list