diff --git a/flang/lib/Lower/IntrinsicCall.cpp b/flang/lib/Lower/IntrinsicCall.cpp --- a/flang/lib/Lower/IntrinsicCall.cpp +++ b/flang/lib/Lower/IntrinsicCall.cpp @@ -236,6 +236,8 @@ mlir::Value genAbs(mlir::Type, llvm::ArrayRef); mlir::Value genAimag(mlir::Type, llvm::ArrayRef); fir::ExtendedValue genAll(mlir::Type, llvm::ArrayRef); + fir::ExtendedValue genAllocated(mlir::Type, + llvm::ArrayRef); fir::ExtendedValue genAny(mlir::Type, llvm::ArrayRef); fir::ExtendedValue genAssociated(mlir::Type, llvm::ArrayRef); @@ -342,6 +344,10 @@ &I::genAll, {{{"mask", asAddr}, {"dim", asValue}}}, /*isElemental=*/false}, + {"allocated", + &I::genAllocated, + {{{"array", asInquired}, {"scalar", asInquired}}}, + /*isElemental=*/false}, {"any", &I::genAny, {{{"mask", asAddr}, {"dim", asValue}}}, @@ -1124,6 +1130,21 @@ }); } +// ALLOCATED +fir::ExtendedValue +IntrinsicLibrary::genAllocated(mlir::Type resultType, + llvm::ArrayRef 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 --- /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>>{{.*}}, %[[arg1:.*]]: !fir.ref>>>{{.*}}) +subroutine allocated_test(scalar, array) + real, allocatable :: scalar, array(:) + ! CHECK: %[[scalar:.*]] = fir.load %[[arg0]] : !fir.ref>> + ! CHECK: %[[addr0:.*]] = fir.box_addr %[[scalar]] : (!fir.box>) -> !fir.heap + ! CHECK: %[[addrToInt0:.*]] = fir.convert %[[addr0]] + ! CHECK: cmpi ne, %[[addrToInt0]], %c0{{.*}} + print *, allocated(scalar) + ! CHECK: %[[array:.*]] = fir.load %[[arg1]] : !fir.ref>>> + ! CHECK: %[[addr1:.*]] = fir.box_addr %[[array]] : (!fir.box>>) -> !fir.heap> + ! CHECK: %[[addrToInt1:.*]] = fir.convert %[[addr1]] + ! CHECK: cmpi ne, %[[addrToInt1]], %c0{{.*}} + print *, allocated(array) + end subroutine + \ No newline at end of file