[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@nvidia.com>
This commit is contained in:
Valentin Clement 2022-06-22 22:32:21 +02:00
parent b1cc59fd3a
commit 24e8cf45a3
No known key found for this signature in database
GPG Key ID: 086D54783C928776
2 changed files with 188 additions and 4 deletions

View File

@ -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>

View File

@ -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