[flang-commits] [flang] [flang] Lower non optional inquired argument in custom intrinsic lowering (PR #93592)
Valentin Clement バレンタイン クレメン via flang-commits
flang-commits at lists.llvm.org
Tue May 28 11:18:28 PDT 2024
https://github.com/clementval created https://github.com/llvm/llvm-project/pull/93592
Handle lowering of non optional inquired argument in custom lowering. Also fix an issue in the lowering of associated optional argument where a box was emboxed again which led to weird result.
>From a38678f0bcdcef6f7ee5b978a22bc71a863ce688 Mon Sep 17 00:00:00 2001
From: Valentin Clement <clementval at gmail.com>
Date: Tue, 28 May 2024 08:34:18 -0700
Subject: [PATCH] [flang] Lower non optional inquired argument in custom
intrinsic lowering
---
flang/lib/Lower/ConvertCall.cpp | 5 ++--
flang/lib/Lower/CustomIntrinsicCall.cpp | 5 +++-
flang/lib/Optimizer/Builder/IntrinsicCall.cpp | 25 ++++++++++++++++++-
flang/test/Lower/Intrinsics/associated.f90 | 23 +++++++++++++++++
4 files changed, 54 insertions(+), 4 deletions(-)
diff --git a/flang/lib/Lower/ConvertCall.cpp b/flang/lib/Lower/ConvertCall.cpp
index 7ec719a2cb9ec..0d4611118843c 100644
--- a/flang/lib/Lower/ConvertCall.cpp
+++ b/flang/lib/Lower/ConvertCall.cpp
@@ -2436,8 +2436,9 @@ genCustomIntrinsicRef(const Fortran::evaluate::SpecificIntrinsic *intrinsic,
getActualFortranElementType());
break;
case fir::LowerIntrinsicArgAs::Inquired:
- TODO(loc, "Inquired non-optional arg to intrinsic with custom handling");
- return;
+ exv = Fortran::lower::convertToBox(loc, converter, actual, stmtCtx,
+ getActualFortranElementType());
+ break;
}
if (!exv)
llvm_unreachable("bad switch");
diff --git a/flang/lib/Lower/CustomIntrinsicCall.cpp b/flang/lib/Lower/CustomIntrinsicCall.cpp
index 30c6ce7f53b3f..8a3aa452799f2 100644
--- a/flang/lib/Lower/CustomIntrinsicCall.cpp
+++ b/flang/lib/Lower/CustomIntrinsicCall.cpp
@@ -291,7 +291,10 @@ lowerAssociated(fir::FirOpBuilder &builder, mlir::Location loc,
.genIfOp(loc, {boxType}, isPresent,
/*withElseRegion=*/true)
.genThen([&]() {
- mlir::Value box = builder.createBox(loc, targetExv);
+ mlir::Value box =
+ fir::isBoxAddress(targetBase.getType())
+ ? builder.create<fir::LoadOp>(loc, fir::getBase(targetExv))
+ : builder.createBox(loc, targetExv);
mlir::Value cast = builder.createConvert(loc, boxType, box);
builder.create<fir::ResultOp>(loc, cast);
})
diff --git a/flang/lib/Optimizer/Builder/IntrinsicCall.cpp b/flang/lib/Optimizer/Builder/IntrinsicCall.cpp
index ad2f9236f0db9..e497f58853703 100644
--- a/flang/lib/Optimizer/Builder/IntrinsicCall.cpp
+++ b/flang/lib/Optimizer/Builder/IntrinsicCall.cpp
@@ -38,6 +38,7 @@
#include "flang/Optimizer/Dialect/FIROps.h"
#include "flang/Optimizer/Dialect/FIROpsSupport.h"
#include "flang/Optimizer/Dialect/Support/FIRContext.h"
+#include "flang/Optimizer/HLFIR/HLFIROps.h"
#include "flang/Optimizer/Support/FatalError.h"
#include "flang/Optimizer/Support/Utils.h"
#include "flang/Runtime/entry-names.h"
@@ -2486,12 +2487,34 @@ IntrinsicLibrary::genAssociated(mlir::Type resultType,
// In both cases, ASSOCIATED should be false if POINTER is NULL.
return builder.create<mlir::arith::AndIOp>(loc, sameTarget, notNull);
}
+
+ const fir::ExtendedValue &target = args[1];
+
+ if (!args[0].getBoxOf<fir::MutableBoxValue>()) {
+ // Argument was lowered as a EntityWithAttribute. Try to retrieve the box
+ // reference.
+ if (auto declareOp = mlir::dyn_cast_or_null<hlfir::DeclareOp>(
+ fir::getBase(args[0]).getDefiningOp())) {
+ if (auto loadOp = mlir::dyn_cast_or_null<fir::LoadOp>(
+ declareOp.getMemref().getDefiningOp())) {
+ if (isStaticallyAbsent(target)) {
+ auto mutBox = fir::MutableBoxValue(loadOp.getMemref(), {}, {});
+ return fir::factory::genIsAllocatedOrAssociatedTest(builder, loc,
+ mutBox);
+ }
+ mlir::Value targetBox = builder.createBox(loc, target);
+ return fir::runtime::genAssociated(builder, loc, declareOp.getMemref(),
+ targetBox);
+ }
+ }
+ }
+
auto *pointer =
args[0].match([&](const fir::MutableBoxValue &x) { return &x; },
[&](const auto &) -> const fir::MutableBoxValue * {
fir::emitFatalError(loc, "pointer not a MutableBoxValue");
});
- const fir::ExtendedValue &target = args[1];
+
if (isStaticallyAbsent(target))
return fir::factory::genIsAllocatedOrAssociatedTest(builder, loc, *pointer);
mlir::Value targetBox = builder.createBox(loc, target);
diff --git a/flang/test/Lower/Intrinsics/associated.f90 b/flang/test/Lower/Intrinsics/associated.f90
index f09d0546a6514..9308ec7cc1a15 100644
--- a/flang/test/Lower/Intrinsics/associated.f90
+++ b/flang/test/Lower/Intrinsics/associated.f90
@@ -151,3 +151,26 @@ subroutine test_allocatable_target(p, allocatable_ziel)
! CHECK: fir.call @_FortranAPointerIsAssociatedWith(%[[VAL_9]], %[[VAL_10]]) {{.*}}: (!fir.box<none>, !fir.box<none>) -> i1
print *, associated(p, allocatable_ziel)
end subroutine
+
+subroutine test_optional_argument(a, b)
+ integer, pointer :: a
+ integer, optional, pointer :: b
+ logical :: assoc
+
+ assoc = associated(a, b)
+end subroutine
+
+! CHECK-LABEL: func.func @_QPtest_optional_argument(
+! CHECK-SAME: %[[A:.*]]: !fir.ref<!fir.box<!fir.ptr<i32>>> {fir.bindc_name = "a"}, %[[B:.*]]: !fir.ref<!fir.box<!fir.ptr<i32>>> {fir.bindc_name = "b", fir.optional}) {
+! CHECK: %[[IS_PRESENT_B:.*]] = fir.is_present %[[B]] : (!fir.ref<!fir.box<!fir.ptr<i32>>>) -> i1
+! CHECK: %[[BOX_B:.*]] = fir.if %[[IS_PRESENT_B]] -> (!fir.box<!fir.ptr<i32>>) {
+! CHECK: %[[LOADED_B:.*]] = fir.load %[[B]] : !fir.ref<!fir.box<!fir.ptr<i32>>>
+! CHECK: fir.result %[[LOADED_B]] : !fir.box<!fir.ptr<i32>>
+! CHECK: } else {
+! CHECK: %[[ABSENT_B:.*]] = fir.absent !fir.box<!fir.ptr<i32>>
+! CHECK: fir.result %[[ABSENT_B]] : !fir.box<!fir.ptr<i32>>
+! CHECK: }
+! CHECK: %[[LOADED_A:.*]] = fir.load %[[A]] : !fir.ref<!fir.box<!fir.ptr<i32>>>
+! CHECK: %[[BOX_NONE_A:.*]] = fir.convert %[[LOADED_A]] : (!fir.box<!fir.ptr<i32>>) -> !fir.box<none>
+! CHECK: %[[BOX_NONE_B:.*]] = fir.convert %[[BOX_B]] : (!fir.box<!fir.ptr<i32>>) -> !fir.box<none>
+! CHECK: %{{.*}} fir.call @_FortranAPointerIsAssociatedWith(%[[BOX_NONE_A]], %[[BOX_NONE_B]]) fastmath<contract> : (!fir.box<none>, !fir.box<none>) -> i1
More information about the flang-commits
mailing list