[flang] Lower non optional inquired argument in custom intrinsic lowering

[clementval]

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.

[llvmbot]

@llvm/pr-subscribers-flang-fir-hlfir

Author: Valentin Clement (バレンタイン クレメン) (clementval)

Changes

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.

---

Full diff: https://github.com/llvm/llvm-project/pull/93592.diff

4 Files Affected:

• (modified) flang/lib/Lower/ConvertCall.cpp (+3-2)
• (modified) flang/lib/Lower/CustomIntrinsicCall.cpp (+4-1)
• (modified) flang/lib/Optimizer/Builder/IntrinsicCall.cpp (+24-1)
• (modified) flang/test/Lower/Intrinsics/associated.f90 (+23)

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

[jeanPerier]

Looks good, thanks!