[flang-commits] [flang] [flang] c_funloc - handle pocedure pointers in convertToBox (PR #76070)
via flang-commits
flang-commits at lists.llvm.org
Wed Dec 20 08:02:07 PST 2023
https://github.com/jeanPerier created https://github.com/llvm/llvm-project/pull/76070
C_FUNLOC was not handling procedure pointer argument correctly, the issue lied in `hlfir::convertToBox` that did not handle procedure pointers.
I modified the interface of `hlfir::convertToXXX` to take values on the way because hlfir::Entity are fundamentally an mlir::Value with type guarantees, so they should be dealt with by value as mlir::Value are (they are very small).
>From 8f9dd772c3908ba604ff7e325bdb966c1f7fecc5 Mon Sep 17 00:00:00 2001
From: Jean Perier <jperier at nvidia.com>
Date: Wed, 20 Dec 2023 06:40:08 -0800
Subject: [PATCH] [flang] c_funloc - handle pocedure pointers in convertToBox
---
.../flang/Optimizer/Builder/HLFIRTools.h | 6 +--
flang/lib/Lower/ConvertCall.cpp | 2 -
flang/lib/Optimizer/Builder/HLFIRTools.cpp | 11 ++++--
.../Intrinsics/c_funloc-proc-pointers.f90 | 38 +++++++++++++++++++
4 files changed, 49 insertions(+), 8 deletions(-)
create mode 100644 flang/test/Lower/Intrinsics/c_funloc-proc-pointers.f90
diff --git a/flang/include/flang/Optimizer/Builder/HLFIRTools.h b/flang/include/flang/Optimizer/Builder/HLFIRTools.h
index e7561dffb75635..c4c8a993eaa986 100644
--- a/flang/include/flang/Optimizer/Builder/HLFIRTools.h
+++ b/flang/include/flang/Optimizer/Builder/HLFIRTools.h
@@ -404,15 +404,15 @@ mlir::Value inlineElementalOp(
std::pair<fir::ExtendedValue, std::optional<hlfir::CleanupFunction>>
convertToValue(mlir::Location loc, fir::FirOpBuilder &builder,
- const hlfir::Entity &entity);
+ hlfir::Entity entity);
std::pair<fir::ExtendedValue, std::optional<hlfir::CleanupFunction>>
convertToAddress(mlir::Location loc, fir::FirOpBuilder &builder,
- const hlfir::Entity &entity, mlir::Type targetType);
+ hlfir::Entity entity, mlir::Type targetType);
std::pair<fir::ExtendedValue, std::optional<hlfir::CleanupFunction>>
convertToBox(mlir::Location loc, fir::FirOpBuilder &builder,
- const hlfir::Entity &entity, mlir::Type targetType);
+ hlfir::Entity entity, mlir::Type targetType);
/// Clone an hlfir.elemental_addr into an hlfir.elemental value.
hlfir::ElementalOp cloneToElementalOp(mlir::Location loc,
diff --git a/flang/lib/Lower/ConvertCall.cpp b/flang/lib/Lower/ConvertCall.cpp
index fd726c90c07bd0..1ce4608a1c95a4 100644
--- a/flang/lib/Lower/ConvertCall.cpp
+++ b/flang/lib/Lower/ConvertCall.cpp
@@ -1555,8 +1555,6 @@ genIntrinsicRefCore(Fortran::lower::PreparedActualArguments &loweredActuals,
}
hlfir::Entity actual = arg.value()->getActual(loc, builder);
- if (actual.isProcedurePointer())
- TODO(loc, "Procedure pointer as actual argument to intrinsics.");
switch (argRules.lowerAs) {
case fir::LowerIntrinsicArgAs::Value:
operands.emplace_back(
diff --git a/flang/lib/Optimizer/Builder/HLFIRTools.cpp b/flang/lib/Optimizer/Builder/HLFIRTools.cpp
index 17efa45b8667d3..94f723b4bae703 100644
--- a/flang/lib/Optimizer/Builder/HLFIRTools.cpp
+++ b/flang/lib/Optimizer/Builder/HLFIRTools.cpp
@@ -935,7 +935,7 @@ hlfir::translateToExtendedValue(mlir::Location loc, fir::FirOpBuilder &builder,
std::pair<fir::ExtendedValue, std::optional<hlfir::CleanupFunction>>
hlfir::convertToValue(mlir::Location loc, fir::FirOpBuilder &builder,
- const hlfir::Entity &entity) {
+ hlfir::Entity entity) {
// Load scalar references to integer, logical, real, or complex value
// to an mlir value, dereference allocatable and pointers, and get rid
// of fir.box that are not needed or create a copy into contiguous memory.
@@ -957,7 +957,12 @@ static fir::ExtendedValue placeTrivialInMemory(mlir::Location loc,
std::pair<fir::ExtendedValue, std::optional<hlfir::CleanupFunction>>
hlfir::convertToBox(mlir::Location loc, fir::FirOpBuilder &builder,
- const hlfir::Entity &entity, mlir::Type targetType) {
+ hlfir::Entity entity, mlir::Type targetType) {
+ // fir::factory::createBoxValue is not meant to deal with procedures.
+ // Dereference procedure pointers here.
+ if (entity.isProcedurePointer())
+ entity = hlfir::derefPointersAndAllocatables(loc, builder, entity);
+
auto [exv, cleanup] = translateToExtendedValue(loc, builder, entity);
// Procedure entities should not go through createBoxValue that embox
// object entities. Return the fir.boxproc directly.
@@ -972,7 +977,7 @@ hlfir::convertToBox(mlir::Location loc, fir::FirOpBuilder &builder,
std::pair<fir::ExtendedValue, std::optional<hlfir::CleanupFunction>>
hlfir::convertToAddress(mlir::Location loc, fir::FirOpBuilder &builder,
- const hlfir::Entity &entity, mlir::Type targetType) {
+ hlfir::Entity entity, mlir::Type targetType) {
hlfir::Entity derefedEntity =
hlfir::derefPointersAndAllocatables(loc, builder, entity);
auto [exv, cleanup] =
diff --git a/flang/test/Lower/Intrinsics/c_funloc-proc-pointers.f90 b/flang/test/Lower/Intrinsics/c_funloc-proc-pointers.f90
new file mode 100644
index 00000000000000..c9578b17ac525a
--- /dev/null
+++ b/flang/test/Lower/Intrinsics/c_funloc-proc-pointers.f90
@@ -0,0 +1,38 @@
+! Test C_FUNLOC() with procedure pointers.
+! RUN: bbc -emit-hlfir -o - %s | FileCheck %s
+
+subroutine test_c_funloc(p)
+ use iso_c_binding, only : c_funloc
+ real, pointer, external :: p
+ call test(c_funloc(p))
+end subroutine
+! CHECK-LABEL: func.func @_QPtest_c_funloc(
+! CHECK-SAME: %[[VAL_0:.*]]: !fir.ref<!fir.boxproc<() -> ()>>) {
+! CHECK: %[[VAL_1:.*]]:2 = hlfir.declare %[[VAL_0]] {fortran_attrs = #fir.var_attrs<pointer>, uniq_name = "_QFtest_c_funlocEp"} : (!fir.ref<!fir.boxproc<() -> ()>>) -> (!fir.ref<!fir.boxproc<() -> ()>>, !fir.ref<!fir.boxproc<() -> ()>>)
+! CHECK: %[[VAL_2:.*]] = fir.load %[[VAL_1]]#0 : !fir.ref<!fir.boxproc<() -> ()>>
+! CHECK: %[[VAL_3:.*]] = fir.alloca !fir.type<_QM__fortran_builtinsT__builtin_c_funptr{__address:i64}>
+! CHECK: %[[VAL_4:.*]] = fir.field_index __address, !fir.type<_QM__fortran_builtinsT__builtin_c_funptr{__address:i64}>
+! CHECK: %[[VAL_5:.*]] = fir.coordinate_of %[[VAL_3]], %[[VAL_4]] : (!fir.ref<!fir.type<_QM__fortran_builtinsT__builtin_c_funptr{__address:i64}>>, !fir.field) -> !fir.ref<i64>
+! CHECK: %[[VAL_6:.*]] = fir.box_addr %[[VAL_2]] : (!fir.boxproc<() -> ()>) -> (() -> ())
+! CHECK: %[[VAL_7:.*]] = fir.convert %[[VAL_6]] : (() -> ()) -> i64
+! CHECK: fir.store %[[VAL_7]] to %[[VAL_5]] : !fir.ref<i64>
+
+subroutine test_c_funloc_char(p)
+ use iso_c_binding, only : c_funloc
+ interface
+ character(10) function char_func()
+ end function
+ end interface
+ procedure(char_func), pointer :: p
+ call test(c_funloc(p))
+end subroutine
+! CHECK-LABEL: func.func @_QPtest_c_funloc_char(
+! CHECK-SAME: %[[VAL_0:.*]]: !fir.ref<!fir.boxproc<() -> ()>>) {
+! CHECK: %[[VAL_1:.*]]:2 = hlfir.declare %[[VAL_0]] {fortran_attrs = #fir.var_attrs<pointer>, uniq_name = "_QFtest_c_funloc_charEp"} : (!fir.ref<!fir.boxproc<() -> ()>>) -> (!fir.ref<!fir.boxproc<() -> ()>>, !fir.ref<!fir.boxproc<() -> ()>>)
+! CHECK: %[[VAL_2:.*]] = fir.load %[[VAL_1]]#0 : !fir.ref<!fir.boxproc<() -> ()>>
+! CHECK: %[[VAL_3:.*]] = fir.alloca !fir.type<_QM__fortran_builtinsT__builtin_c_funptr{__address:i64}>
+! CHECK: %[[VAL_4:.*]] = fir.field_index __address, !fir.type<_QM__fortran_builtinsT__builtin_c_funptr{__address:i64}>
+! CHECK: %[[VAL_5:.*]] = fir.coordinate_of %[[VAL_3]], %[[VAL_4]] : (!fir.ref<!fir.type<_QM__fortran_builtinsT__builtin_c_funptr{__address:i64}>>, !fir.field) -> !fir.ref<i64>
+! CHECK: %[[VAL_6:.*]] = fir.box_addr %[[VAL_2]] : (!fir.boxproc<() -> ()>) -> (() -> ())
+! CHECK: %[[VAL_7:.*]] = fir.convert %[[VAL_6]] : (() -> ()) -> i64
+! CHECK: fir.store %[[VAL_7]] to %[[VAL_5]] : !fir.ref<i64>
More information about the flang-commits
mailing list