[flang-commits] [flang] 24e8cf4 - [flang] Capture result interface of functions called in internal procedures
Valentin Clement via flang-commits
flang-commits at lists.llvm.org
Wed Jun 22 13:33:01 PDT 2022
Author: Valentin Clement
Date: 2022-06-22T22:32:52+02:00
New Revision: 24e8cf45a3c7175659afb1c2654672856aea9800
URL: https://github.com/llvm/llvm-project/commit/24e8cf45a3c7175659afb1c2654672856aea9800
DIFF: https://github.com/llvm/llvm-project/commit/24e8cf45a3c7175659afb1c2654672856aea9800.diff
LOG: [flang] Capture result interface of functions called in internal procedures
Character and array results are allocated on the caller side. This
require evaluating the result interface on the call site. When calling
such functions inside an internal procedure, it is possible that the
interface is defined in the host, in which case the lengths/bounds of
the function results must be captured so that they are available in
the internal function to emit the call.
To handle this case, extend the PFT symbol visit to visit the bounds and length
parameters of functions called in the internal procedure parse tree.
This patch is part of the upstreaming effort from fir-dev branch.
Reviewed By: klausler
Differential Revision: https://reviews.llvm.org/D128371
Co-authored-by: Jean Perier <jperier at nvidia.com>
Added:
flang/test/Lower/host-associated-functions.f90
Modified:
flang/lib/Lower/PFTBuilder.cpp
Removed:
################################################################################
diff --git a/flang/lib/Lower/PFTBuilder.cpp b/flang/lib/Lower/PFTBuilder.cpp
index 2e2e024880312..bba55709647eb 100644
--- a/flang/lib/Lower/PFTBuilder.cpp
+++ b/flang/lib/Lower/PFTBuilder.cpp
@@ -1781,7 +1781,8 @@ struct SymbolVisitor {
return false;
}
- void visitExpr(const Fortran::lower::SomeExpr &expr) {
+ template <typename T>
+ void visitExpr(const Fortran::evaluate::Expr<T> &expr) {
for (const semantics::Symbol &symbol :
Fortran::evaluate::CollectSymbols(expr))
visitSymbol(symbol);
@@ -1789,11 +1790,47 @@ struct SymbolVisitor {
void visitSymbol(const Fortran::semantics::Symbol &symbol) {
callBack(symbol);
- // Visit statement function body since it will be inlined in lowering.
+ // - Visit statement function body since it will be inlined in lowering.
+ // - Visit function results specification expressions because allocations
+ // happens on the caller side.
if (const auto *subprogramDetails =
- symbol.detailsIf<Fortran::semantics::SubprogramDetails>())
- if (const auto &maybeExpr = subprogramDetails->stmtFunction())
+ symbol.detailsIf<Fortran::semantics::SubprogramDetails>()) {
+ if (const auto &maybeExpr = subprogramDetails->stmtFunction()) {
visitExpr(*maybeExpr);
+ } else {
+ if (subprogramDetails->isFunction()) {
+ // Visit result extents expressions that are explicit.
+ const Fortran::semantics::Symbol &result =
+ subprogramDetails->result();
+ if (const auto *objectDetails =
+ result.detailsIf<Fortran::semantics::ObjectEntityDetails>())
+ if (objectDetails->shape().IsExplicitShape())
+ for (const Fortran::semantics::ShapeSpec &shapeSpec :
+ objectDetails->shape()) {
+ visitExpr(shapeSpec.lbound().GetExplicit().value());
+ visitExpr(shapeSpec.ubound().GetExplicit().value());
+ }
+ }
+ }
+ }
+ if (Fortran::semantics::IsProcedure(symbol)) {
+ if (auto dynamicType = Fortran::evaluate::DynamicType::From(symbol)) {
+ // Visit result length specification expressions that are explicit.
+ if (dynamicType->category() ==
+ Fortran::common::TypeCategory::Character) {
+ if (std::optional<Fortran::evaluate::ExtentExpr> length =
+ dynamicType->GetCharLength())
+ visitExpr(*length);
+ } else if (dynamicType->category() == common::TypeCategory::Derived) {
+ const Fortran::semantics::DerivedTypeSpec &derivedTypeSpec =
+ dynamicType->GetDerivedTypeSpec();
+ for (const auto &[_, param] : derivedTypeSpec.parameters())
+ if (const Fortran::semantics::MaybeIntExpr &expr =
+ param.GetExplicit())
+ visitExpr(expr.value());
+ }
+ }
+ }
}
template <typename A>
diff --git a/flang/test/Lower/host-associated-functions.f90 b/flang/test/Lower/host-associated-functions.f90
new file mode 100644
index 0000000000000..798543ed35dac
--- /dev/null
+++ b/flang/test/Lower/host-associated-functions.f90
@@ -0,0 +1,147 @@
+! RUN: bbc -emit-fir %s -o - | FileCheck %s
+
+! Test calling functions whose result interface is evaluated on the call site
+! and where the calls are located in an internal procedure while the
+! interface is defined in the host procedure.
+
+! CHECK-LABEL: func @_QPcapture_char_func_dummy(
+! CHECK-SAME: %[[VAL_0:.*]]: tuple<!fir.boxproc<() -> ()>, i64> {fir.char_proc},
+! CHECK-SAME: %[[VAL_1:.*]]: !fir.ref<i32> {fir.bindc_name = "n"}) {
+subroutine capture_char_func_dummy(char_func_dummy, n)
+ character(n),external :: char_func_dummy
+ ! CHECK: %[[VAL_2:.*]] = fir.alloca tuple<tuple<!fir.boxproc<() -> ()>, i64>, !fir.ref<i32>>
+ ! CHECK: %[[VAL_3:.*]] = arith.constant 0 : i32
+ ! CHECK: %[[VAL_4:.*]] = fir.coordinate_of %[[VAL_2]], %[[VAL_3]] : (!fir.ref<tuple<tuple<!fir.boxproc<() -> ()>, i64>, !fir.ref<i32>>>, i32) -> !fir.ref<tuple<!fir.boxproc<() -> ()>, i64>>
+ ! CHECK: fir.store %[[VAL_0]] to %[[VAL_4]] : !fir.ref<tuple<!fir.boxproc<() -> ()>, i64>>
+ ! CHECK: %[[VAL_5:.*]] = arith.constant 1 : i32
+ ! CHECK: %[[VAL_6:.*]] = fir.coordinate_of %[[VAL_2]], %[[VAL_5]] : (!fir.ref<tuple<tuple<!fir.boxproc<() -> ()>, i64>, !fir.ref<i32>>>, i32) -> !fir.llvm_ptr<!fir.ref<i32>>
+ ! CHECK: fir.store %[[VAL_1]] to %[[VAL_6]] : !fir.llvm_ptr<!fir.ref<i32>>
+ ! CHECK: fir.call @_QFcapture_char_func_dummyPinternal(%[[VAL_2]]) : (!fir.ref<tuple<tuple<!fir.boxproc<() -> ()>, i64>, !fir.ref<i32>>>) -> ()
+ call internal()
+contains
+ ! CHECK-LABEL: func @_QFcapture_char_func_dummyPinternal(
+ ! CHECK-SAME: %[[VAL_0:.*]]: !fir.ref<tuple<tuple<!fir.boxproc<() -> ()>, i64>, !fir.ref<i32>>> {fir.host_assoc}) {
+ subroutine internal()
+ ! CHECK: %[[VAL_1:.*]] = arith.constant 0 : i32
+ ! CHECK: %[[VAL_2:.*]] = fir.coordinate_of %[[VAL_0]], %[[VAL_1]] : (!fir.ref<tuple<tuple<!fir.boxproc<() -> ()>, i64>, !fir.ref<i32>>>, i32) -> !fir.ref<tuple<!fir.boxproc<() -> ()>, i64>>
+ ! CHECK: %[[VAL_3:.*]] = fir.load %[[VAL_2]] : !fir.ref<tuple<!fir.boxproc<() -> ()>, i64>>
+ ! CHECK: %[[VAL_4:.*]] = arith.constant 1 : i32
+ ! CHECK: %[[VAL_5:.*]] = fir.coordinate_of %[[VAL_0]], %[[VAL_4]] : (!fir.ref<tuple<tuple<!fir.boxproc<() -> ()>, i64>, !fir.ref<i32>>>, i32) -> !fir.llvm_ptr<!fir.ref<i32>>
+ ! CHECK: %[[VAL_6:.*]] = fir.load %[[VAL_5]] : !fir.llvm_ptr<!fir.ref<i32>>
+ ! CHECK: %[[VAL_12:.*]] = fir.extract_value %[[VAL_3]], [0 : index] : (tuple<!fir.boxproc<() -> ()>, i64>) -> !fir.boxproc<() -> ()>
+ ! CHECK: %[[VAL_13:.*]] = fir.box_addr %[[VAL_12]] : (!fir.boxproc<() -> ()>) -> (() -> ())
+ ! CHECK: %[[VAL_14:.*]] = fir.load %[[VAL_6]] : !fir.ref<i32>
+ ! CHECK: %[[VAL_15:.*]] = fir.convert %[[VAL_14]] : (i32) -> i64
+ ! CHECK: %[[VAL_16:.*]] = fir.convert %[[VAL_15]] : (i64) -> index
+ ! CHECK: %[[VAL_17:.*]] = fir.call @llvm.stacksave() : () -> !fir.ref<i8>
+ ! CHECK: %[[VAL_18:.*]] = fir.alloca !fir.char<1,?>(%[[VAL_16]] : index) {bindc_name = ".result"}
+ ! CHECK: %[[VAL_19:.*]] = fir.convert %[[VAL_13]] : (() -> ()) -> ((!fir.ref<!fir.char<1,?>>, index) -> !fir.boxchar<1>)
+ ! CHECK: %[[VAL_20:.*]] = fir.call %[[VAL_19]](%[[VAL_18]], %[[VAL_16]]) : (!fir.ref<!fir.char<1,?>>, index) -> !fir.boxchar<1>
+ print *, char_func_dummy()
+ end subroutine
+end subroutine
+
+! CHECK-LABEL: func @_QPcapture_char_func_assumed_dummy(
+! CHECK-SAME: %[[VAL_0:.*]]: tuple<!fir.boxproc<() -> ()>, i64> {fir.char_proc}) {
+subroutine capture_char_func_assumed_dummy(char_func_dummy)
+ character(*),external :: char_func_dummy
+! CHECK: %[[VAL_1:.*]] = fir.alloca tuple<tuple<!fir.boxproc<() -> ()>, i64>>
+! CHECK: %[[VAL_2:.*]] = arith.constant 0 : i32
+! CHECK: %[[VAL_3:.*]] = fir.coordinate_of %[[VAL_1]], %[[VAL_2]] : (!fir.ref<tuple<tuple<!fir.boxproc<() -> ()>, i64>>>, i32) -> !fir.ref<tuple<!fir.boxproc<() -> ()>, i64>>
+! CHECK: fir.store %[[VAL_0]] to %[[VAL_3]] : !fir.ref<tuple<!fir.boxproc<() -> ()>, i64>>
+! CHECK: fir.call @_QFcapture_char_func_assumed_dummyPinternal(%[[VAL_1]]) : (!fir.ref<tuple<tuple<!fir.boxproc<() -> ()>, i64>>>) -> ()
+ call internal()
+contains
+! CHECK-LABEL: func @_QFcapture_char_func_assumed_dummyPinternal(
+! CHECK-SAME: %[[VAL_0:.*]]: !fir.ref<tuple<tuple<!fir.boxproc<() -> ()>, i64>>> {fir.host_assoc}) {
+ subroutine internal()
+! CHECK: %[[VAL_1:.*]] = arith.constant 0 : i32
+! CHECK: %[[VAL_2:.*]] = fir.coordinate_of %[[VAL_0]], %[[VAL_1]] : (!fir.ref<tuple<tuple<!fir.boxproc<() -> ()>, i64>>>, i32) -> !fir.ref<tuple<!fir.boxproc<() -> ()>, i64>>
+! CHECK: %[[VAL_3:.*]] = fir.load %[[VAL_2]] : !fir.ref<tuple<!fir.boxproc<() -> ()>, i64>>
+! CHECK: %[[VAL_9:.*]] = fir.extract_value %[[VAL_3]], [0 : index] : (tuple<!fir.boxproc<() -> ()>, i64>) -> !fir.boxproc<() -> ()>
+! CHECK: %[[VAL_10:.*]] = fir.box_addr %[[VAL_9]] : (!fir.boxproc<() -> ()>) -> (() -> ())
+! CHECK: %[[VAL_11:.*]] = fir.extract_value %[[VAL_3]], [1 : index] : (tuple<!fir.boxproc<() -> ()>, i64>) -> i64
+! CHECK: %[[VAL_12:.*]] = fir.call @llvm.stacksave() : () -> !fir.ref<i8>
+! CHECK: %[[VAL_13:.*]] = fir.alloca !fir.char<1,?>(%[[VAL_11]] : i64) {bindc_name = ".result"}
+! CHECK: %[[VAL_14:.*]] = fir.convert %[[VAL_10]] : (() -> ()) -> ((!fir.ref<!fir.char<1,?>>, index) -> !fir.boxchar<1>)
+! CHECK: %[[VAL_15:.*]] = fir.convert %[[VAL_11]] : (i64) -> index
+! CHECK: %[[VAL_16:.*]] = fir.call %[[VAL_14]](%[[VAL_13]], %[[VAL_15]]) : (!fir.ref<!fir.char<1,?>>, index) -> !fir.boxchar<1>
+ print *, char_func_dummy()
+ end subroutine
+end subroutine
+
+! CHECK-LABEL: func @_QPcapture_char_func(
+! CHECK-SAME: %[[VAL_0:.*]]: !fir.ref<i32> {fir.bindc_name = "n"}) {
+subroutine capture_char_func(n)
+ character(n), external :: char_func
+! CHECK: %[[VAL_1:.*]] = fir.alloca tuple<!fir.ref<i32>>
+! CHECK: %[[VAL_2:.*]] = arith.constant 0 : i32
+! CHECK: %[[VAL_3:.*]] = fir.coordinate_of %[[VAL_1]], %[[VAL_2]] : (!fir.ref<tuple<!fir.ref<i32>>>, i32) -> !fir.llvm_ptr<!fir.ref<i32>>
+! CHECK: fir.store %[[VAL_0]] to %[[VAL_3]] : !fir.llvm_ptr<!fir.ref<i32>>
+! CHECK: fir.call @_QFcapture_char_funcPinternal(%[[VAL_1]]) : (!fir.ref<tuple<!fir.ref<i32>>>) -> ()
+ call internal()
+contains
+! CHECK-LABEL: func @_QFcapture_char_funcPinternal(
+! CHECK-SAME: %[[VAL_0:.*]]: !fir.ref<tuple<!fir.ref<i32>>> {fir.host_assoc})
+ subroutine internal()
+ print *, char_func()
+ end subroutine
+end subroutine
+
+! CHECK-LABEL: func @_QPcapture_array_func(
+! CHECK-SAME: %[[VAL_0:.*]]: !fir.ref<i32> {fir.bindc_name = "n"}) {
+subroutine capture_array_func(n)
+ integer :: n
+ interface
+ function array_func()
+ import :: n
+ integer :: array_func(n)
+ end function
+ end interface
+! CHECK: %[[VAL_1:.*]] = fir.alloca tuple<!fir.ref<i32>>
+! CHECK: %[[VAL_2:.*]] = arith.constant 0 : i32
+! CHECK: %[[VAL_3:.*]] = fir.coordinate_of %[[VAL_1]], %[[VAL_2]] : (!fir.ref<tuple<!fir.ref<i32>>>, i32) -> !fir.llvm_ptr<!fir.ref<i32>>
+! CHECK: fir.store %[[VAL_0]] to %[[VAL_3]] : !fir.llvm_ptr<!fir.ref<i32>>
+! CHECK: fir.call @_QFcapture_array_funcPinternal(%[[VAL_1]]) : (!fir.ref<tuple<!fir.ref<i32>>>) -> ()
+ call internal()
+contains
+ subroutine internal()
+! CHECK-LABEL: func @_QFcapture_array_funcPinternal(
+! CHECK-SAME: %[[VAL_0:.*]]: !fir.ref<tuple<!fir.ref<i32>>> {fir.host_assoc}) {
+! CHECK: %[[VAL_1:.*]] = arith.constant 0 : i32
+! CHECK: %[[VAL_2:.*]] = fir.coordinate_of %[[VAL_0]], %[[VAL_1]] : (!fir.ref<tuple<!fir.ref<i32>>>, i32) -> !fir.llvm_ptr<!fir.ref<i32>>
+! CHECK: %[[VAL_3:.*]] = fir.load %[[VAL_2]] : !fir.llvm_ptr<!fir.ref<i32>>
+! CHECK: %[[VAL_9:.*]] = fir.load %[[VAL_3]] : !fir.ref<i32>
+! CHECK: %[[VAL_10:.*]] = fir.convert %[[VAL_9]] : (i32) -> i64
+! CHECK: %[[VAL_11:.*]] = arith.constant 1 : i64
+! CHECK: %[[VAL_12:.*]] = arith.subi %[[VAL_10]], %[[VAL_11]] : i64
+! CHECK: %[[VAL_13:.*]] = arith.constant 1 : i64
+! CHECK: %[[VAL_14:.*]] = arith.addi %[[VAL_12]], %[[VAL_13]] : i64
+! CHECK: %[[VAL_15:.*]] = fir.convert %[[VAL_14]] : (i64) -> index
+! CHECK: %[[VAL_16:.*]] = fir.call @llvm.stacksave() : () -> !fir.ref<i8>
+! CHECK: %[[VAL_17:.*]] = fir.alloca !fir.array<?xi32>, %[[VAL_15]] {bindc_name = ".result"}
+ print *, array_func()
+ end subroutine
+end subroutine
+
+module define_char_func
+ contains
+ function return_char(n)
+ integer :: n
+ character(n) :: return_char
+ return_char = "a"
+ end function
+end module
+
+! CHECK-LABEL: func @_QPuse_module() {
+subroutine use_module()
+ ! verify there is no capture triggers by the interface.
+ use define_char_func
+! CHECK: fir.call @_QFuse_modulePinternal() : () -> ()
+ call internal()
+ contains
+! CHECK-LABEL: func @_QFuse_modulePinternal() {
+ subroutine internal()
+ print *, return_char(42)
+ end subroutine
+end subroutine
More information about the flang-commits
mailing list