[flang] Handle reversed bounds and negative length in inlined allocation

ALLOCATE statement allows reversed bounds (see Fortran 2018 9.7.1.2
point 1) in which case the extents are zero.

The same applies for the character length provided in the type spec that
can be negative. In which case the new length is zero.

Use genMaxWithZero to deal with these cases.

This patch is part of the upstreaming effort from fir-dev branch.

Reviewed By: jeanPerier, PeteSteinfeld

Differential Revision: https://reviews.llvm.org/D127617

Co-authored-by: Jean Perier <jperier@nvidia.com>
This commit is contained in:
Jean Perier 2022-06-13 17:34:29 +02:00 committed by Valentin Clement
parent 1054a73187
commit c8a9afe7c8
No known key found for this signature in database
GPG Key ID: 086D54783C928776
2 changed files with 19 additions and 9 deletions

View File

@ -640,14 +640,17 @@ getNewLengths(fir::FirOpBuilder &builder, mlir::Location loc,
auto idxTy = builder.getIndexType();
if (auto charTy = box.getEleTy().dyn_cast<fir::CharacterType>()) {
if (charTy.getLen() == fir::CharacterType::unknownLen()) {
if (box.hasNonDeferredLenParams())
if (box.hasNonDeferredLenParams()) {
lengths.emplace_back(
builder.createConvert(loc, idxTy, box.nonDeferredLenParams()[0]));
else if (!lenParams.empty())
lengths.emplace_back(builder.createConvert(loc, idxTy, lenParams[0]));
else
} else if (!lenParams.empty()) {
mlir::Value len =
fir::factory::genMaxWithZero(builder, loc, lenParams[0]);
lengths.emplace_back(builder.createConvert(loc, idxTy, len));
} else {
fir::emitFatalError(
loc, "could not deduce character lengths in character allocation");
}
}
}
return lengths;
@ -682,10 +685,13 @@ void fir::factory::genInlinedAllocation(fir::FirOpBuilder &builder,
mlir::ValueRange lenParams,
llvm::StringRef allocName) {
auto lengths = getNewLengths(builder, loc, box, lenParams);
llvm::SmallVector<mlir::Value> safeExtents;
for (mlir::Value extent : extents)
safeExtents.push_back(fir::factory::genMaxWithZero(builder, loc, extent));
auto heap = builder.create<fir::AllocMemOp>(loc, box.getBaseTy(), allocName,
lengths, extents);
MutablePropertyWriter{builder, loc, box}.updateMutableBox(heap, lbounds,
extents, lengths);
lengths, safeExtents);
MutablePropertyWriter{builder, loc, box}.updateMutableBox(
heap, lbounds, safeExtents, lengths);
if (box.getEleTy().isa<fir::RecordType>()) {
// TODO: skip runtime initialization if this is not required. Currently,
// there is no way to know here if a derived type needs it or not. But the

View File

@ -42,7 +42,9 @@ subroutine foodim1()
! CHECK-DAG: %[[c42:.*]] = fir.convert %c42{{.*}} : (i32) -> index
! CHECK-DAG: %[[c100:.*]] = fir.convert %c100_i32 : (i32) -> index
! CHECK-DAG: %[[diff:.*]] = arith.subi %[[c100]], %[[c42]] : index
! CHECK: %[[extent:.*]] = arith.addi %[[diff]], %c1{{.*}} : index
! CHECK: %[[rawExtent:.*]] = arith.addi %[[diff]], %c1{{.*}} : index
! CHECK: %[[extentPositive:.*]] = arith.cmpi sgt, %[[rawExtent]], %c0{{.*}} : index
! CHECK: %[[extent:.*]] = arith.select %[[extentPositive]], %[[rawExtent]], %c0{{.*}} : index
! CHECK: %[[alloc:.*]] = fir.allocmem !fir.array<?xf32>, %[[extent]] {{{.*}}uniq_name = "_QFfoodim1Ex.alloc"}
! CHECK-DAG: fir.store %[[alloc]] to %[[xAddrVar]] : !fir.ref<!fir.heap<!fir.array<?xf32>>>
! CHECK-DAG: fir.store %[[extent]] to %[[xExtVar]] : !fir.ref<index>
@ -86,7 +88,9 @@ subroutine char_deferred(n)
! CHECK: fir.freemem %{{.*}}
allocate(character(n):: c)
! CHECK: %[[n:.*]] = fir.load %arg0 : !fir.ref<i32>
! CHECK: %[[ni:.*]] = fir.convert %[[n]] : (i32) -> index
! CHECK: %[[nPositive:.*]] = arith.cmpi sgt, %[[n]], %c0{{.*}} : i32
! CHECK: %[[ns:.*]] = arith.select %[[nPositive]], %[[n]], %c0{{.*}} : i32
! CHECK: %[[ni:.*]] = fir.convert %[[ns]] : (i32) -> index
! CHECK: fir.allocmem !fir.char<1,?>(%[[ni]] : index) {{{.*}}uniq_name = "_QFchar_deferredEc.alloc"}
! CHECK: fir.store %[[ni]] to %[[cLenVar]] : !fir.ref<index>