From c8a9afe7c81bc874debbe319f3cf6b7b89f90aa2 Mon Sep 17 00:00:00 2001
From: Jean Perier <jperier@nvidia.com>
Date: Mon, 13 Jun 2022 17:34:29 +0200
Subject: [PATCH] [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>
---
 flang/lib/Optimizer/Builder/MutableBox.cpp | 20 +++++++++++++-------
 flang/test/Lower/allocatables.f90          |  8 ++++++--
 2 files changed, 19 insertions(+), 9 deletions(-)

diff --git a/flang/lib/Optimizer/Builder/MutableBox.cpp b/flang/lib/Optimizer/Builder/MutableBox.cpp
index f023536ecd36..6d7eb2952fcd 100644
--- a/flang/lib/Optimizer/Builder/MutableBox.cpp
+++ b/flang/lib/Optimizer/Builder/MutableBox.cpp
@@ -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
diff --git a/flang/test/Lower/allocatables.f90 b/flang/test/Lower/allocatables.f90
index d26e7fc881af..be2366811842 100644
--- a/flang/test/Lower/allocatables.f90
+++ b/flang/test/Lower/allocatables.f90
@@ -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>