[flang] Fix ignore_tkr(c) passing descriptor instead of base address for non-descriptor dummies (#186894)

When ignore_tkr(c) is set and the actual argument is an allocatable or
pointer (stored as a descriptor), the lowering code was unconditionally
returning the descriptor pointer as-is, regardless of whether the dummy
argument expects a descriptor. For bind(c) interfaces with assumed-size
dummies (e.g., cuFFT), the dummy expects a raw pointer, not a
descriptor. Passing the descriptor caused the C function to receive the
wrong address, leading to silent data corruption and invalid descriptor
crashes at deallocation.

The fix adds a check that the early return for ignore_tkr(c) only
applies when the dummy type is itself a descriptor type. When the dummy
expects a base address, the normal path is taken, which correctly
extracts the base address from the descriptor via fir.box_addr.

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)

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=*/{}};
   }

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<!fir.box<!fir.heap<!fir.array<?xf32>>>>
+  subroutine test_allocatable(arr)
+    real, allocatable :: arr(:)
+    ! CHECK: %[[DECL:.*]]:2 = hlfir.declare %[[ARR]]
+    ! CHECK: %[[LOAD:.*]] = fir.load %[[DECL]]#0 : !fir.ref<!fir.box<!fir.heap<!fir.array<?xf32>>>>
+    ! CHECK: %[[ADDR:.*]] = fir.box_addr %[[LOAD]] : (!fir.box<!fir.heap<!fir.array<?xf32>>>) -> !fir.heap<!fir.array<?xf32>>
+    ! CHECK: %[[CONV:.*]] = fir.convert %[[ADDR]] : (!fir.heap<!fir.array<?xf32>>) -> !fir.ref<!fir.array<?xf32>>
+    ! CHECK: fir.call @_QPpass_assumed_size(%[[CONV]]) {{.*}} : (!fir.ref<!fir.array<?xf32>>) -> ()
+    call pass_assumed_size(arr)
+  end subroutine
+
+  ! CHECK-LABEL: func.func @_QMm_ignore_tkr_c_base_addrPtest_pointer(
+  ! CHECK-SAME: %[[ARR:.*]]: !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>
+  subroutine test_pointer(arr)
+    real, pointer :: arr(:)
+    ! CHECK: %[[DECL:.*]]:2 = hlfir.declare %[[ARR]]
+    ! CHECK: %[[LOAD:.*]] = fir.load %[[DECL]]#0 : !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>
+    ! CHECK: %[[ADDR:.*]] = fir.box_addr %[[LOAD]] : (!fir.box<!fir.ptr<!fir.array<?xf32>>>) -> !fir.ptr<!fir.array<?xf32>>
+    ! CHECK: %[[CONV:.*]] = fir.convert %[[ADDR]] : (!fir.ptr<!fir.array<?xf32>>) -> !fir.ref<!fir.array<?xf32>>
+    ! CHECK: fir.call @_QPpass_assumed_size(%[[CONV]]) {{.*}} : (!fir.ref<!fir.array<?xf32>>) -> ()
+    call pass_assumed_size(arr)
+  end subroutine
+
+  ! CHECK: func.func private @_QPpass_assumed_size(!fir.ref<!fir.array<?xf32>>)
+end module