[flang-commits] [flang] 411f839 - [flang] Fix for array upper bounds with *
Valentin Clement via flang-commits
flang-commits at lists.llvm.org
Thu Jun 30 01:37:31 PDT 2022
Author: Valentin Clement
Date: 2022-06-30T10:37:22+02:00
New Revision: 411f839ae36f0f56ce0b6c5f4e37039c54bdd9f7
URL: https://github.com/llvm/llvm-project/commit/411f839ae36f0f56ce0b6c5f4e37039c54bdd9f7
DIFF: https://github.com/llvm/llvm-project/commit/411f839ae36f0f56ce0b6c5f4e37039c54bdd9f7.diff
LOG: [flang] Fix for array upper bounds with *
Even though the array is declared with '*' upper bounds, it has an
initial value that has a statically known shape. Use the shape from
the type of the initializer when the declared size is '*'.
This patch is part of the upstreaming effort from fir-dev branch.
Reviewed By: jeanPerier
Differential Revision: https://reviews.llvm.org/D128889
Co-authored-by: Eric Schweitz <eschweitz at nvidia.com>
Added:
flang/test/Lower/memory-alloc.f90
Modified:
flang/lib/Lower/ConvertVariable.cpp
Removed:
################################################################################
diff --git a/flang/lib/Lower/ConvertVariable.cpp b/flang/lib/Lower/ConvertVariable.cpp
index 70dcf93126b7..b5430f9a1f27 100644
--- a/flang/lib/Lower/ConvertVariable.cpp
+++ b/flang/lib/Lower/ConvertVariable.cpp
@@ -1199,6 +1199,24 @@ static mlir::Value genExtentValue(fir::FirOpBuilder &builder,
return builder.create<fir::UndefOp>(loc, idxTy);
}
+/// If a symbol is an array, it may have been declared with unknown extent
+/// parameters (e.g., `*`), but if it has an initial value then the actual size
+/// may be available from the initial array value's type.
+inline static llvm::SmallVector<std::int64_t>
+recoverShapeVector(llvm::ArrayRef<std::int64_t> shapeVec, mlir::Value initVal) {
+ llvm::SmallVector<std::int64_t> result;
+ if (initVal) {
+ if (auto seqTy = fir::unwrapUntilSeqType(initVal.getType())) {
+ for (auto [fst, snd] : llvm::zip(shapeVec, seqTy.getShape()))
+ result.push_back(fst == fir::SequenceType::getUnknownExtent() ? snd
+ : fst);
+ return result;
+ }
+ }
+ result.assign(shapeVec.begin(), shapeVec.end());
+ return result;
+}
+
/// Lower specification expressions and attributes of variable \p var and
/// add it to the symbol map. For a global or an alias, the address must be
/// pre-computed and provided in \p preAlloc. A dummy argument for the current
@@ -1518,7 +1536,7 @@ void Fortran::lower::mapSymbolAttributes(
if (x.lboundAllOnes()) {
// if lower bounds are all ones, build simple shaped object
llvm::SmallVector<mlir::Value> shape;
- for (int64_t i : x.shapes)
+ for (int64_t i : recoverShapeVector(x.shapes, preAlloc))
shape.push_back(genExtentValue(builder, loc, idxTy, i));
mlir::Value local =
isDummy ? addr : createNewLocal(converter, loc, var, preAlloc);
@@ -1529,14 +1547,17 @@ void Fortran::lower::mapSymbolAttributes(
// constructing constants and populating the lbounds and extents.
llvm::SmallVector<mlir::Value> extents;
llvm::SmallVector<mlir::Value> lbounds;
- for (auto [fst, snd] : llvm::zip(x.lbounds, x.shapes)) {
+ for (auto [fst, snd] :
+ llvm::zip(x.lbounds, recoverShapeVector(x.shapes, preAlloc))) {
lbounds.emplace_back(builder.createIntegerConstant(loc, idxTy, fst));
extents.emplace_back(genExtentValue(builder, loc, idxTy, snd));
}
mlir::Value local =
isDummy ? addr
: createNewLocal(converter, loc, var, preAlloc, extents);
- assert(isDummy || Fortran::lower::isExplicitShape(sym));
+ // Must be a dummy argument, have an explicit shape, or be a PARAMETER.
+ assert(isDummy || Fortran::lower::isExplicitShape(sym) ||
+ Fortran::semantics::IsNamedConstant(sym));
symMap.addSymbolWithBounds(sym, local, extents, lbounds, isDummy);
},
@@ -1616,7 +1637,7 @@ void Fortran::lower::mapSymbolAttributes(
if (x.lboundAllOnes()) {
// if lower bounds are all ones, build simple shaped object
llvm::SmallVector<mlir::Value> shape;
- for (int64_t i : x.shapes)
+ for (int64_t i : recoverShapeVector(x.shapes, preAlloc))
shape.push_back(genExtentValue(builder, loc, idxTy, i));
mlir::Value local =
isDummy ? addr : createNewLocal(converter, loc, var, preAlloc);
@@ -1628,7 +1649,8 @@ void Fortran::lower::mapSymbolAttributes(
llvm::SmallVector<mlir::Value> extents;
llvm::SmallVector<mlir::Value> lbounds;
// construct constants and populate `bounds`
- for (auto [fst, snd] : llvm::zip(x.lbounds, x.shapes)) {
+ for (auto [fst, snd] :
+ llvm::zip(x.lbounds, recoverShapeVector(x.shapes, preAlloc))) {
lbounds.emplace_back(builder.createIntegerConstant(loc, idxTy, fst));
extents.emplace_back(genExtentValue(builder, loc, idxTy, snd));
}
@@ -1682,7 +1704,7 @@ void Fortran::lower::mapSymbolAttributes(
if (x.lboundAllOnes()) {
// if lower bounds are all ones, build simple shaped object
llvm::SmallVector<mlir::Value> shape;
- for (int64_t i : x.shapes)
+ for (int64_t i : recoverShapeVector(x.shapes, preAlloc))
shape.push_back(genExtentValue(builder, loc, idxTy, i));
if (isDummy) {
symMap.addCharSymbolWithShape(sym, addr, len, shape, true);
@@ -1700,7 +1722,8 @@ void Fortran::lower::mapSymbolAttributes(
llvm::SmallVector<mlir::Value> lbounds;
// construct constants and populate `bounds`
- for (auto [fst, snd] : llvm::zip(x.lbounds, x.shapes)) {
+ for (auto [fst, snd] :
+ llvm::zip(x.lbounds, recoverShapeVector(x.shapes, preAlloc))) {
lbounds.emplace_back(builder.createIntegerConstant(loc, idxTy, fst));
extents.emplace_back(genExtentValue(builder, loc, idxTy, snd));
}
diff --git a/flang/test/Lower/memory-alloc.f90 b/flang/test/Lower/memory-alloc.f90
new file mode 100644
index 000000000000..3b7b8f01e725
--- /dev/null
+++ b/flang/test/Lower/memory-alloc.f90
@@ -0,0 +1,19 @@
+! RUN: bbc -o - %s | FileCheck %s
+
+! CHECK-LABEL: func @_QMw0bPtest1(
+! CHECK: %[[TWO:.*]] = arith.constant 2 : index
+! CHECK: %[[HEAP:.*]] = fir.allocmem !fir.array<?x!fir.logical<4>>, %[[TWO]] {uniq_name = ".array.expr"}
+! CHECK: fir.freemem %[[HEAP]] : !fir.heap<!fir.array<?x!fir.logical<4>>>
+
+Module w0b
+ Integer,Parameter :: a(*,*) = Reshape( [ 1,2,3,4 ], [ 2,2 ])
+contains
+ Subroutine test1(i,expect)
+ Integer,Intent(In) :: i,expect(:)
+ Logical :: ok = .True.
+ If (Any(a(:,i)/=expect)) Then
+ !Print *,'FAIL 1:',a(:,i),'/=',expect
+ ok = .False.
+ End If
+ End Subroutine
+End Module
More information about the flang-commits
mailing list