[flang] Lower allocated intrinsic

This patch adds lowering for the `allocated`
intrinsic.

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

Reviewed By: jeanPerier, PeteSteinfeld

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

Co-authored-by: Jean Perier <jperier@nvidia.com>

diff --git a/flang/lib/Lower/IntrinsicCall.cpp b/flang/lib/Lower/IntrinsicCall.cpp
index a690c33..6d03462 100644 (file)
--- a/flang/lib/Lower/IntrinsicCall.cpp
+++ b/flang/lib/Lower/IntrinsicCall.cpp
@@ -266,6 +266,8 @@ struct IntrinsicLibrary {
   mlir::Value genAbs(mlir::Type, llvm::ArrayRef<mlir::Value>);
   mlir::Value genAimag(mlir::Type, llvm::ArrayRef<mlir::Value>);
   fir::ExtendedValue genAll(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
+  fir::ExtendedValue genAllocated(mlir::Type,
+                                  llvm::ArrayRef<fir::ExtendedValue>);
   fir::ExtendedValue genAny(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
   fir::ExtendedValue genAssociated(mlir::Type,
                                    llvm::ArrayRef<fir::ExtendedValue>);
@@ -377,6 +379,10 @@ static constexpr IntrinsicHandler handlers[]{
      &I::genAll,
      {{{"mask", asAddr}, {"dim", asValue}}},
      /*isElemental=*/false},
+    {"allocated",
+     &I::genAllocated,
+     {{{"array", asInquired}, {"scalar", asInquired}}},
+     /*isElemental=*/false},
     {"any",
      &I::genAny,
      {{{"mask", asAddr}, {"dim", asValue}}},
@@ -1166,6 +1172,21 @@ IntrinsicLibrary::genAll(mlir::Type resultType,
           });
 }
 
+// ALLOCATED
+fir::ExtendedValue
+IntrinsicLibrary::genAllocated(mlir::Type resultType,
+                               llvm::ArrayRef<fir::ExtendedValue> args) {
+  assert(args.size() == 1);
+  return args[0].match(
+      [&](const fir::MutableBoxValue &x) -> fir::ExtendedValue {
+        return fir::factory::genIsAllocatedOrAssociatedTest(builder, loc, x);
+      },
+      [&](const auto &) -> fir::ExtendedValue {
+        fir::emitFatalError(loc,
+                            "allocated arg not lowered to MutableBoxValue");
+      });
+}
+
 // ANY
 fir::ExtendedValue
 IntrinsicLibrary::genAny(mlir::Type resultType,

diff --git a/flang/test/Lower/allocated.f90 b/flang/test/Lower/allocated.f90
new file mode 100644 (file)
index 0000000..35c87e2
--- /dev/null
+++ b/flang/test/Lower/allocated.f90
@@ -0,0 +1,18 @@
+! RUN: bbc -emit-fir %s -o - | FileCheck %s
+
+! CHECK-LABEL: allocated_test
+! CHECK-SAME: %[[arg0:.*]]: !fir.ref<!fir.box<!fir.heap<f32>>>{{.*}}, %[[arg1:.*]]: !fir.ref<!fir.box<!fir.heap<!fir.array<?xf32>>>>{{.*}})
+subroutine allocated_test(scalar, array)
+    real, allocatable  :: scalar, array(:)
+    ! CHECK: %[[scalar:.*]] = fir.load %[[arg0]] : !fir.ref<!fir.box<!fir.heap<f32>>>
+    ! CHECK: %[[addr0:.*]] = fir.box_addr %[[scalar]] : (!fir.box<!fir.heap<f32>>) -> !fir.heap<f32>
+    ! CHECK: %[[addrToInt0:.*]] = fir.convert %[[addr0]]
+    ! CHECK: cmpi ne, %[[addrToInt0]], %c0{{.*}}
+    print *, allocated(scalar)
+    ! CHECK: %[[array:.*]] = fir.load %[[arg1]] : !fir.ref<!fir.box<!fir.heap<!fir.array<?xf32>>>>
+    ! CHECK: %[[addr1:.*]] = fir.box_addr %[[array]] : (!fir.box<!fir.heap<!fir.array<?xf32>>>) -> !fir.heap<!fir.array<?xf32>>
+    ! CHECK: %[[addrToInt1:.*]] = fir.convert %[[addr1]]
+    ! CHECK: cmpi ne, %[[addrToInt1]], %c0{{.*}}
+    print *, allocated(array)
+  end subroutine
+  
\ No newline at end of file