From 411f839ae36f0f56ce0b6c5f4e37039c54bdd9f7 Mon Sep 17 00:00:00 2001 From: Valentin Clement Date: Thu, 30 Jun 2022 10:36:47 +0200 Subject: [PATCH] [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 --- flang/lib/Lower/ConvertVariable.cpp | 37 ++++++++++++++++++++++++++++++------- flang/test/Lower/memory-alloc.f90 | 19 +++++++++++++++++++ 2 files changed, 49 insertions(+), 7 deletions(-) create mode 100644 flang/test/Lower/memory-alloc.f90 diff --git a/flang/lib/Lower/ConvertVariable.cpp b/flang/lib/Lower/ConvertVariable.cpp index 70dcf93..b5430f9 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(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 +recoverShapeVector(llvm::ArrayRef shapeVec, mlir::Value initVal) { + llvm::SmallVector 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 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 extents; llvm::SmallVector 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 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 extents; llvm::SmallVector 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 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 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 0000000..3b7b8f0 --- /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>, %[[TWO]] {uniq_name = ".array.expr"} +! CHECK: fir.freemem %[[HEAP]] : !fir.heap>> + +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 -- 2.7.4