[flang] Lower allocated intrinsic

[clementval]

Summary

This patch adds lowering for the allocated
intrinsic.

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

[jeanPerier]

LGTM

[PeteSteinfeld]

All builds and tests correctly and looks good.

flang/lib/Lower/IntrinsicCall.cpp

struct IntrinsicLibrary {
 
   /// Lowering for the ABS intrinsic. The ABS intrinsic expects one argument in
   /// the llvm::ArrayRef. The ABS intrinsic is lowered into MLIR/FIR operation
   /// if the argument is an integer, into llvm intrinsics if the argument is
   /// real and to the `hypot` math routine if the argument is of complex type.
   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>);
   fir::ExtendedValue genChar(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
   mlir::Value genDim(mlir::Type, llvm::ArrayRef<mlir::Value>);
   fir::ExtendedValue genDotProduct(mlir::Type,
                                    llvm::ArrayRef<fir::ExtendedValue>);
   template <Extremum, ExtremumBehavior>

 /// should be provided for all the intrinsic arguments for completeness.
 static constexpr IntrinsicHandler handlers[]{
     {"abs", &I::genAbs},
     {"aimag", &I::genAimag},
     {"all",
      &I::genAll,
      {{{"mask", asAddr}, {"dim", asValue}}},
      /*isElemental=*/false},
+    {"allocated",
+     &I::genAllocated,
+     {{{"array", asInquired}, {"scalar", asInquired}}},
+     /*isElemental=*/false},
     {"any",
      &I::genAny,
      {{{"mask", asAddr}, {"dim", asValue}}},
      /*isElemental=*/false},
     {"associated",
      &I::genAssociated,
      {{{"pointer", asInquired}, {"target", asInquired}}},
      /*isElemental=*/false},
return fir::factory::genMutableBoxRead(builder, loc, resultMutableBox)
             addCleanUpForTemp(loc, box.getAddr());
             return box;
           },
           [&](const auto &) -> fir::ExtendedValue {
             fir::emitFatalError(loc, "Invalid result for ALL");
           });
 }
 
+// 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,
                          llvm::ArrayRef<fir::ExtendedValue> args) {
 
   assert(args.size() == 2);
   // Handle required mask argument
   mlir::Value mask = builder.createBox(loc, args[0]);

flang/test/Lower/allocated.f90

+! 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