diff --git a/flang/docs/Directives.md b/flang/docs/Directives.md index 7080e5c5cf543..07ba5c25a1a78 100644 --- a/flang/docs/Directives.md +++ b/flang/docs/Directives.md @@ -18,15 +18,18 @@ A list of non-standard directives supported by Flang directive allow actual arguments that would otherwise be diagnosed as incompatible in type (T), kind (K), rank (R), CUDA device (D), or managed (M) status. The letter (A) is a shorthand for (TKRDM), and is the default when no - letters appear. The letter (C) checks for contiguity, for example allowing an - element of an assumed-shape array to be passed as a dummy argument. It also - specifies that dummy arguments passed by descriptor should not have their - descriptor copied or reboxed, allowing the original descriptor to be passed + letters appear. The letter (C) checks for contiguity, for example allowing + an element of an assumed-shape array to be passed as a dummy argument. When + the dummy argument is passed by descriptor, (C) specifies that the descriptor + should not be copied or reboxed, allowing the original descriptor to be passed directly even if attributes like ALLOCATABLE or POINTER don't match exactly. - The letter (P) ignores pointer and allocatable matching, so that one can pass an - allocatable array to routine with pointer array argument and vice versa. For - example, if one wanted to call a "set all bytes to zero" utility that could - be applied to arrays of any type or rank: + When the dummy argument is not passed by descriptor (e.g., an assumed-size + array in a BIND(C) interface), the base address is extracted from the actual + argument's descriptor and passed as a raw pointer. + The letter (P) ignores pointer and allocatable matching, so that one can pass + an allocatable array to routine with pointer array argument and vice versa. + For example, if one wanted to call a "set all bytes to zero" utility that + could be applied to arrays of any type or rank: ``` interface subroutine clear(arr,bytes) diff --git a/flang/lib/Lower/ConvertCall.cpp b/flang/lib/Lower/ConvertCall.cpp index d72f74b440c53..ae9d1733d053d 100644 --- a/flang/lib/Lower/ConvertCall.cpp +++ b/flang/lib/Lower/ConvertCall.cpp @@ -1349,7 +1349,7 @@ static PreparedDummyArgument preparePresentUserCallActualArgument( hlfir::Entity actual = preparedActual.getActual(loc, builder); if (arg.testTKR(Fortran::common::IgnoreTKR::Contiguous) && - actual.isBoxAddress()) { + actual.isBoxAddress() && fir::isBoxAddressOrValue(dummyType)) { // With ignore_tkr(c), pointer to a descriptor should be passed as is return PreparedDummyArgument{actual, /*cleanups=*/{}}; } diff --git a/flang/test/Lower/HLFIR/ignore-tkr-c-base-addr.f90 b/flang/test/Lower/HLFIR/ignore-tkr-c-base-addr.f90 new file mode 100644 index 0000000000000..e04e8d1a2140f --- /dev/null +++ b/flang/test/Lower/HLFIR/ignore-tkr-c-base-addr.f90 @@ -0,0 +1,40 @@ +! RUN: bbc -emit-hlfir -o - %s | FileCheck %s + +! Test that ignore_tkr(c) with a non-descriptor dummy (assumed-size) extracts +! the base address from allocatable/pointer actual arguments instead of passing +! the descriptor. This pattern is used by CUDA library interfaces like cuFFT. + +module m_ignore_tkr_c_base_addr + interface + subroutine pass_assumed_size(a) + !dir$ ignore_tkr(c) a + real :: a(*) + end subroutine + end interface +contains + ! CHECK-LABEL: func.func @_QMm_ignore_tkr_c_base_addrPtest_allocatable( + ! CHECK-SAME: %[[ARR:.*]]: !fir.ref>>> + subroutine test_allocatable(arr) + real, allocatable :: arr(:) + ! CHECK: %[[DECL:.*]]:2 = hlfir.declare %[[ARR]] + ! CHECK: %[[LOAD:.*]] = fir.load %[[DECL]]#0 : !fir.ref>>> + ! CHECK: %[[ADDR:.*]] = fir.box_addr %[[LOAD]] : (!fir.box>>) -> !fir.heap> + ! CHECK: %[[CONV:.*]] = fir.convert %[[ADDR]] : (!fir.heap>) -> !fir.ref> + ! CHECK: fir.call @_QPpass_assumed_size(%[[CONV]]) {{.*}} : (!fir.ref>) -> () + call pass_assumed_size(arr) + end subroutine + + ! CHECK-LABEL: func.func @_QMm_ignore_tkr_c_base_addrPtest_pointer( + ! CHECK-SAME: %[[ARR:.*]]: !fir.ref>>> + subroutine test_pointer(arr) + real, pointer :: arr(:) + ! CHECK: %[[DECL:.*]]:2 = hlfir.declare %[[ARR]] + ! CHECK: %[[LOAD:.*]] = fir.load %[[DECL]]#0 : !fir.ref>>> + ! CHECK: %[[ADDR:.*]] = fir.box_addr %[[LOAD]] : (!fir.box>>) -> !fir.ptr> + ! CHECK: %[[CONV:.*]] = fir.convert %[[ADDR]] : (!fir.ptr>) -> !fir.ref> + ! CHECK: fir.call @_QPpass_assumed_size(%[[CONV]]) {{.*}} : (!fir.ref>) -> () + call pass_assumed_size(arr) + end subroutine + + ! CHECK: func.func private @_QPpass_assumed_size(!fir.ref>) +end module