[flang] Carry over BIND(C) information to fir.call (#93981)

The BIND(C) attribute attached to a function can be lost when we do
indirect call. This information might be useful for codegen that have
specific ABI. This patch carry over the BIND(C) information to the
fir.call operation.

Author: clementval

flang/include/flang/Optimizer/Dialect/FIROps.td

@@ -2393,7 +2393,8 @@ def fir_CallOp : fir_Op<"call",
     OptionalAttr<SymbolRefAttr>:$callee,
     Variadic<AnyType>:$args,
     DefaultValuedAttr<Arith_FastMathAttr,
-                      "::mlir::arith::FastMathFlags::none">:$fastmath
+                      "::mlir::arith::FastMathFlags::none">:$fastmath,
+    UnitAttr:$is_bind_c
   );
   let results = (outs Variadic<AnyType>);
 

flang/lib/Lower/ConvertCall.cpp

@@ -643,6 +643,9 @@ std::pair<fir::ExtendedValue, bool> Fortran::lower::genCallOpAndResult(
     // Standard procedure call with fir.call.
     auto call = builder.create<fir::CallOp>(loc, funcType.getResults(),
                                             funcSymbolAttr, operands);
+    if (caller.characterize().IsBindC())
+      call.setIsBindC(true);
+
     callNumResults = call.getNumResults();
     if (callNumResults != 0)
       callResult = call.getResult(0);

flang/test/HLFIR/c_ptr_byvalue.f90

@@ -7,7 +7,7 @@
 ! CHECK:           %[[VAL_113:.*]] = fir.load %[[VAL_112]] : !fir.ref<i64>
 ! CHECK:           %[[VAL_114:.*]] = fir.convert %[[VAL_113]] : (i64) -> !fir.ref<i64>
 ! CHECK:           hlfir.end_associate %[[VAL_110]]#1, %[[VAL_110]]#2 : !fir.ref<!fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}>>, i1
-! CHECK:           fir.call @get_expected_f(%[[VAL_114]]) fastmath<contract> : (!fir.ref<i64>) -> ()
+! CHECK:           fir.call @get_expected_f(%[[VAL_114]]) fastmath<contract> {is_bind_c} : (!fir.ref<i64>) -> ()
 subroutine test1
   use iso_c_binding
   interface
@@ -28,7 +28,7 @@ end subroutine get_expected_f
 ! CHECK:           %[[VAL_99:.*]] = fir.coordinate_of %[[VAL_97]]#0, %[[VAL_98]] : (!fir.ref<!fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}>>, !fir.field) -> !fir.ref<i64>
 ! CHECK:           %[[VAL_100:.*]] = fir.load %[[VAL_99]] : !fir.ref<i64>
 ! CHECK:           %[[VAL_101:.*]] = fir.convert %[[VAL_100]] : (i64) -> !fir.ref<i64>
-! CHECK:           fir.call @get_expected_f(%[[VAL_101]]) fastmath<contract> : (!fir.ref<i64>) -> ()
+! CHECK:           fir.call @get_expected_f(%[[VAL_101]]) fastmath<contract> {is_bind_c} : (!fir.ref<i64>) -> ()
 subroutine test2(cptr)
   use iso_c_binding
   interface

flang/test/Lower/CUDA/cuda-device-proc.cuf

@@ -18,13 +18,13 @@ end
 
 ! CHECK-LABEL: func.func @_QPdevsub() attributes {cuf.proc_attr = #cuf.cuda_proc<global>}
 ! CHECK: fir.call @__syncthreads()
-! CHECK: fir.call @__syncwarp(%{{.*}}) fastmath<contract> : (!fir.ref<i32>) -> ()
+! CHECK: fir.call @__syncwarp(%{{.*}}) fastmath<contract> {is_bind_c} : (!fir.ref<i32>) -> ()
 ! CHECK: fir.call @__threadfence()
 ! CHECK: fir.call @__threadfence_block()
 ! CHECK: fir.call @__threadfence_system()
-! CHECK: %{{.*}} = fir.call @__syncthreads_and(%{{.*}}) fastmath<contract> : (!fir.ref<i32>) -> i32
-! CHECK: %{{.*}} = fir.call @__syncthreads_count(%{{.*}}) fastmath<contract> : (!fir.ref<i32>) -> i32
-! CHECK: %{{.*}} = fir.call @__syncthreads_or(%{{.*}}) fastmath<contract> : (!fir.ref<i32>) -> i32
+! CHECK: %{{.*}} = fir.call @__syncthreads_and(%{{.*}}) fastmath<contract> {is_bind_c} : (!fir.ref<i32>) -> i32
+! CHECK: %{{.*}} = fir.call @__syncthreads_count(%{{.*}}) fastmath<contract> {is_bind_c} : (!fir.ref<i32>) -> i32
+! CHECK: %{{.*}} = fir.call @__syncthreads_or(%{{.*}}) fastmath<contract> {is_bind_c} : (!fir.ref<i32>) -> i32
 
 ! CHECK: func.func private @__syncthreads() attributes {cuf.proc_attr = #cuf.cuda_proc<device>, fir.bindc_name = "__syncthreads"}
 ! CHECK: func.func private @__syncwarp(!fir.ref<i32> {cuf.data_attr = #cuf.cuda<device>}) attributes {cuf.proc_attr = #cuf.cuda_proc<device>, fir.bindc_name = "__syncwarp"}

flang/test/Lower/HLFIR/assumed-rank-iface.f90

@@ -38,7 +38,7 @@ subroutine int_scalar_to_assumed_rank_bindc(x)
 ! CHECK:           %[[VAL_1:.*]]:2 = hlfir.declare %[[VAL_0]] dummy_scope %{{[0-9]+}} {uniq_name = "_QFint_scalar_to_assumed_rank_bindcEx"} : (!fir.ref<i32>, !fir.dscope) -> (!fir.ref<i32>, !fir.ref<i32>)
 ! CHECK:           %[[VAL_2:.*]] = fir.embox %[[VAL_1]]#0 : (!fir.ref<i32>) -> !fir.box<i32>
 ! CHECK:           %[[VAL_3:.*]] = fir.convert %[[VAL_2]] : (!fir.box<i32>) -> !fir.box<!fir.array<*:i32>>
-! CHECK:           fir.call @int_assumed_rank_bindc(%[[VAL_3]]) fastmath<contract> : (!fir.box<!fir.array<*:i32>>) -> ()
+! CHECK:           fir.call @int_assumed_rank_bindc(%[[VAL_3]]) fastmath<contract> {is_bind_c} : (!fir.box<!fir.array<*:i32>>) -> ()
 
 subroutine int_r1_to_assumed_rank(x)
   use ifaces, only : int_assumed_rank
@@ -94,7 +94,7 @@ subroutine int_assumed_shape_to_assumed_rank_bindc(x)
 ! CHECK:           %[[VAL_3:.*]] = fir.shift %[[VAL_2]], %[[VAL_2]] : (index, index) -> !fir.shift<2>
 ! CHECK:           %[[VAL_4:.*]] = fir.rebox %[[VAL_1]]#0(%[[VAL_3]]) : (!fir.box<!fir.array<?x?xi32>>, !fir.shift<2>) -> !fir.box<!fir.array<?x?xi32>>
 ! CHECK:           %[[VAL_5:.*]] = fir.convert %[[VAL_4]] : (!fir.box<!fir.array<?x?xi32>>) -> !fir.box<!fir.array<*:i32>>
-! CHECK:           fir.call @int_assumed_rank_bindc(%[[VAL_5]]) fastmath<contract> : (!fir.box<!fir.array<*:i32>>) -> ()
+! CHECK:           fir.call @int_assumed_rank_bindc(%[[VAL_5]]) fastmath<contract> {is_bind_c} : (!fir.box<!fir.array<*:i32>>) -> ()
 
 subroutine int_allocatable_to_assumed_rank(x)
   use ifaces, only : int_assumed_rank

flang/test/Lower/HLFIR/bindc-value-derived.f90

@@ -31,7 +31,7 @@ subroutine call_it(x)
 ! CHECK-SAME:                                      %[[VAL_0:.*]]: !fir.ref<!fir.type<_QMbindc_byvalTt{i:i32}>> {fir.bindc_name = "x"}) {
 ! CHECK:           %[[VAL_1:.*]]:2 = hlfir.declare %[[VAL_0]] dummy_scope %{{[0-9]+}} {uniq_name = "_QMbindc_byvalFcall_itEx"} : (!fir.ref<!fir.type<_QMbindc_byvalTt{i:i32}>>, !fir.dscope) -> (!fir.ref<!fir.type<_QMbindc_byvalTt{i:i32}>>, !fir.ref<!fir.type<_QMbindc_byvalTt{i:i32}>>)
 ! CHECK:           %[[VAL_2:.*]] = fir.load %[[VAL_1]]#1 : !fir.ref<!fir.type<_QMbindc_byvalTt{i:i32}>>
-! CHECK:           fir.call @test(%[[VAL_2]]) fastmath<contract> : (!fir.type<_QMbindc_byvalTt{i:i32}>) -> ()
+! CHECK:           fir.call @test(%[[VAL_2]]) fastmath<contract> {is_bind_c} : (!fir.type<_QMbindc_byvalTt{i:i32}>) -> ()
 ! CHECK:           return
 ! CHECK:         }
 end module

flang/test/Lower/HLFIR/block_bindc_pocs.f90

@@ -9,7 +9,7 @@ end subroutine test_proc
     end interface
 end module m
 !CHECK-DAG: %[[S0:.*]] = fir.call @llvm.stacksave.p0() fastmath<contract> : () -> !fir.ref<i8>
-!CHECK-DAG: fir.call @test_proc() fastmath<contract> : () -> ()
+!CHECK-DAG: fir.call @test_proc() fastmath<contract> {is_bind_c} : () -> ()
 !CHECK-DAG: fir.call @llvm.stackrestore.p0(%[[S0]]) fastmath<contract> : (!fir.ref<i8>) -> ()
 !CHECK-DAG: func.func private @test_proc() attributes {fir.bindc_name = "test_proc"}
 subroutine test

flang/test/Lower/HLFIR/call-sequence-associated-descriptors.f90

@@ -46,7 +46,7 @@ subroutine test_char_1(x)
 ! CHECK:           %[[VAL_26:.*]] = fir.box_addr %[[VAL_10]] : (!fir.box<!fir.array<10x20x!fir.char<1,?>>>) -> !fir.ref<!fir.array<10x20x!fir.char<1,?>>>
 ! CHECK:           %[[VAL_27:.*]] = fir.convert %[[VAL_26]] : (!fir.ref<!fir.array<10x20x!fir.char<1,?>>>) -> !fir.ref<!fir.array<?x!fir.char<1,?>>>
 ! CHECK:           %[[VAL_28:.*]] = fir.embox %[[VAL_27]](%[[VAL_24]]) typeparams %[[VAL_25]] : (!fir.ref<!fir.array<?x!fir.char<1,?>>>, !fir.shapeshift<1>, index) -> !fir.box<!fir.array<?x!fir.char<1,?>>>
-! CHECK:           fir.call @takes_char(%[[VAL_28]], %[[VAL_11]]#1) fastmath<contract> : (!fir.box<!fir.array<?x!fir.char<1,?>>>, !fir.ref<i32>) -> ()
+! CHECK:           fir.call @takes_char(%[[VAL_28]], %[[VAL_11]]#1) fastmath<contract> {is_bind_c} : (!fir.box<!fir.array<?x!fir.char<1,?>>>, !fir.ref<i32>) -> ()
 ! CHECK:           hlfir.end_associate %[[VAL_11]]#1, %[[VAL_11]]#2 : !fir.ref<i32>, i1
 ! CHECK:           return
 ! CHECK:         }
@@ -80,7 +80,7 @@ subroutine test_char_copy_in_copy_out(x)
 ! CHECK:           %[[VAL_22:.*]] = fir.box_addr %[[VAL_6]] : (!fir.box<!fir.array<?x?x!fir.char<1,?>>>) -> !fir.ref<!fir.array<?x?x!fir.char<1,?>>>
 ! CHECK:           %[[VAL_23:.*]] = fir.convert %[[VAL_22]] : (!fir.ref<!fir.array<?x?x!fir.char<1,?>>>) -> !fir.ref<!fir.array<?x!fir.char<1,?>>>
 ! CHECK:           %[[VAL_24:.*]] = fir.embox %[[VAL_23]](%[[VAL_20]]) typeparams %[[VAL_21]] : (!fir.ref<!fir.array<?x!fir.char<1,?>>>, !fir.shapeshift<1>, index) -> !fir.box<!fir.array<?x!fir.char<1,?>>>
-! CHECK:           fir.call @takes_char(%[[VAL_24]], %[[VAL_7]]#1) fastmath<contract> : (!fir.box<!fir.array<?x!fir.char<1,?>>>, !fir.ref<i32>) -> ()
+! CHECK:           fir.call @takes_char(%[[VAL_24]], %[[VAL_7]]#1) fastmath<contract> {is_bind_c} : (!fir.box<!fir.array<?x!fir.char<1,?>>>, !fir.ref<i32>) -> ()
 ! CHECK:           hlfir.copy_out %[[VAL_3]]#0, %[[VAL_3]]#1 to %[[VAL_1]]#0 : (!fir.box<!fir.array<?x?x!fir.char<1,?>>>, i1, !fir.box<!fir.array<?x?x!fir.char<1,?>>>) -> ()
 ! CHECK:           hlfir.end_associate %[[VAL_7]]#1, %[[VAL_7]]#2 : !fir.ref<i32>, i1
 ! CHECK:           return
@@ -113,7 +113,7 @@ subroutine test_char_assumed_size(x)
 ! CHECK:           %[[VAL_20:.*]] = fir.box_addr %[[VAL_5]] : (!fir.box<!fir.array<?x?x!fir.char<1,?>>>) -> !fir.ref<!fir.array<?x?x!fir.char<1,?>>>
 ! CHECK:           %[[VAL_21:.*]] = fir.convert %[[VAL_20]] : (!fir.ref<!fir.array<?x?x!fir.char<1,?>>>) -> !fir.ref<!fir.array<10x?x!fir.char<1,?>>>
 ! CHECK:           %[[VAL_22:.*]] = fir.embox %[[VAL_21]](%[[VAL_18]]) typeparams %[[VAL_19]] : (!fir.ref<!fir.array<10x?x!fir.char<1,?>>>, !fir.shapeshift<2>, index) -> !fir.box<!fir.array<10x?x!fir.char<1,?>>>
-! CHECK:           fir.call @takes_char_assumed_size(%[[VAL_22]]) fastmath<contract> : (!fir.box<!fir.array<10x?x!fir.char<1,?>>>) -> ()
+! CHECK:           fir.call @takes_char_assumed_size(%[[VAL_22]]) fastmath<contract> {is_bind_c} : (!fir.box<!fir.array<10x?x!fir.char<1,?>>>) -> ()
 ! CHECK:           hlfir.copy_out %[[VAL_2]]#0, %[[VAL_2]]#1 to %[[VAL_1]]#0 : (!fir.box<!fir.array<?x?x!fir.char<1,?>>>, i1, !fir.box<!fir.array<?x?x!fir.char<1,?>>>) -> ()
 ! CHECK:           return
 ! CHECK:         }
@@ -159,7 +159,7 @@ subroutine test_optional_char(x)
 ! CHECK:             %[[VAL_33:.*]] = fir.absent !fir.box<!fir.array<?x!fir.char<1,?>>>
 ! CHECK:             fir.result %[[VAL_33]] : !fir.box<!fir.array<?x!fir.char<1,?>>>
 ! CHECK:           }
-! CHECK:           fir.call @takes_optional_char(%[[VAL_15]], %[[VAL_14]]#1) fastmath<contract> : (!fir.box<!fir.array<?x!fir.char<1,?>>>, !fir.ref<i32>) -> ()
+! CHECK:           fir.call @takes_optional_char(%[[VAL_15]], %[[VAL_14]]#1) fastmath<contract> {is_bind_c} : (!fir.box<!fir.array<?x!fir.char<1,?>>>, !fir.ref<i32>) -> ()
 ! CHECK:           hlfir.end_associate %[[VAL_14]]#1, %[[VAL_14]]#2 : !fir.ref<i32>, i1
 ! CHECK:           return
 ! CHECK:         }

flang/test/Lower/HLFIR/calls-character-singleton-result.f90

@@ -35,7 +35,7 @@ character(1) function bar() bind(c)
 ! CHECK:  %[[VAL_1:.*]] = fir.alloca !fir.char<1>
 ! CHECK:  %[[VAL_3:.*]] = fir.convert %{{.*}}#0 : (!fir.ref<!fir.char<1,?>>) -> !fir.ref<!fir.char<1>>
 ! CHECK:  %[[VAL_4:.*]]:2 = hlfir.declare %[[VAL_3]] typeparams %{{.*}}  {{.*}}Ec
-! CHECK:  %[[VAL_5:.*]] = fir.call @bar() fastmath<contract> : () -> !fir.char<1>
+! CHECK:  %[[VAL_5:.*]] = fir.call @bar() fastmath<contract> {is_bind_c} : () -> !fir.char<1>
 ! CHECK:  fir.store %[[VAL_5]] to %[[VAL_1]] : !fir.ref<!fir.char<1>>
 ! CHECK:  %[[VAL_6:.*]] = arith.constant false
 ! CHECK:  %[[VAL_7:.*]] = hlfir.as_expr %[[VAL_1]] move %[[VAL_6]] : (!fir.ref<!fir.char<1>>, i1) -> !hlfir.expr<!fir.char<1>>

flang/test/Lower/HLFIR/ignore-type-assumed-shape.f90

@@ -23,7 +23,7 @@ subroutine test_ignore_t_1(x)
 ! CHECK:           %[[VAL_6:.*]] = fir.shift %[[VAL_5]] : (index) -> !fir.shift<1>
 ! CHECK:           %[[VAL_7:.*]] = fir.rebox %{{.*}}(%[[VAL_6]]) : (!fir.box<!fir.array<10xf32>>, !fir.shift<1>) -> !fir.box<!fir.array<?xf32>>
 ! CHECK:           %[[VAL_8:.*]] = fir.convert %[[VAL_7]] : (!fir.box<!fir.array<?xf32>>) -> !fir.box<!fir.array<?xi32>>
-! CHECK:           fir.call @takes_assumed_shape_ignore_tkr_t(%[[VAL_8]]) fastmath<contract> : (!fir.box<!fir.array<?xi32>>) -> ()
+! CHECK:           fir.call @takes_assumed_shape_ignore_tkr_t(%[[VAL_8]]) fastmath<contract> {is_bind_c} : (!fir.box<!fir.array<?xi32>>) -> ()
 
 subroutine test_ignore_t_2(x)
   use tkr_ifaces
@@ -35,7 +35,7 @@ subroutine test_ignore_t_2(x)
 ! CHECK:           %[[VAL_3:.*]] = fir.shift %[[VAL_2]] : (index) -> !fir.shift<1>
 ! CHECK:           %[[VAL_4:.*]] = fir.rebox %{{.*}}(%[[VAL_3]]) : (!fir.class<!fir.array<?xnone>>, !fir.shift<1>) -> !fir.class<!fir.array<?xnone>>
 ! CHECK:           %[[VAL_5:.*]] = fir.convert %[[VAL_4]] : (!fir.class<!fir.array<?xnone>>) -> !fir.box<!fir.array<?xi32>>
-! CHECK:           fir.call @takes_assumed_shape_ignore_tkr_t(%[[VAL_5]]) fastmath<contract> : (!fir.box<!fir.array<?xi32>>) -> ()
+! CHECK:           fir.call @takes_assumed_shape_ignore_tkr_t(%[[VAL_5]]) fastmath<contract> {is_bind_c} : (!fir.box<!fir.array<?xi32>>) -> ()
 
 subroutine test_ignore_t_3(x)
   use tkr_ifaces
@@ -47,7 +47,7 @@ subroutine test_ignore_t_3(x)
 ! CHECK:           %[[VAL_13:.*]] = fir.shift %[[VAL_12]] : (index) -> !fir.shift<1>
 ! CHECK:           %[[VAL_14:.*]] = fir.rebox %{{.*}}(%[[VAL_13]]) : (!fir.box<!fir.array<10xf32>>, !fir.shift<1>) -> !fir.box<!fir.array<?xf32>>
 ! CHECK:           %[[VAL_15:.*]] = fir.convert %[[VAL_14]] : (!fir.box<!fir.array<?xf32>>) -> !fir.box<!fir.array<?xi32>>
-! CHECK:           fir.call @takes_assumed_shape_ignore_tkr_t(%[[VAL_15]]) fastmath<contract> : (!fir.box<!fir.array<?xi32>>) -> ()
+! CHECK:           fir.call @takes_assumed_shape_ignore_tkr_t(%[[VAL_15]]) fastmath<contract> {is_bind_c} : (!fir.box<!fir.array<?xi32>>) -> ()
 
 subroutine test_ignore_t_4(x)
   use tkr_ifaces
@@ -59,4 +59,4 @@ subroutine test_ignore_t_4(x)
 ! CHECK:           %[[VAL_4:.*]] = fir.shift %[[VAL_3]] : (index) -> !fir.shift<1>
 ! CHECK:           %[[VAL_5:.*]] = fir.rebox %{{.*}}(%[[VAL_4]]) : (!fir.box<!fir.ptr<!fir.array<?xf32>>>, !fir.shift<1>) -> !fir.box<!fir.array<?xf32>>
 ! CHECK:           %[[VAL_6:.*]] = fir.convert %[[VAL_5]] : (!fir.box<!fir.array<?xf32>>) -> !fir.box<!fir.array<?xi32>>
-! CHECK:           fir.call @takes_assumed_shape_ignore_tkr_t(%[[VAL_6]]) fastmath<contract> : (!fir.box<!fir.array<?xi32>>) -> ()
+! CHECK:           fir.call @takes_assumed_shape_ignore_tkr_t(%[[VAL_6]]) fastmath<contract> {is_bind_c} : (!fir.box<!fir.array<?xi32>>) -> ()

flang/test/Lower/block.f90

@@ -81,7 +81,7 @@ program bb ! block stack management and exits
 
     ! CHECK: %[[V_51:[0-9]+]] = fir.call @llvm.stacksave.p0() fastmath<contract> : () -> !fir.ref<i8>
     ! CHECK: fir.store %c5{{.*}} to %[[V_0]] : !fir.ref<i32>
-    ! CHECK: fir.call @ss(%[[V_0]]) fastmath<contract> : (!fir.ref<i32>) -> ()
+    ! CHECK: fir.call @ss(%[[V_0]]) fastmath<contract> {is_bind_c} : (!fir.ref<i32>) -> ()
     ! CHECK: fir.call @llvm.stackrestore.p0(%[[V_51]]) fastmath<contract> : (!fir.ref<i8>) -> ()
     block
       interface

flang/test/Lower/call-bindc.f90

@@ -0,0 +1,21 @@
+! Chekc that BIND(C) is carried over to the fir.call
+! RUN: bbc -emit-hlfir %s -o - | FileCheck %s
+
+module mod
+  interface
+    complex(kind=4) function foo4c(j) bind(c)
+      integer, intent(in),value :: j
+    end function foo4c
+  end interface
+end module mod
+
+program main
+  use mod
+  procedure(foo4c), pointer :: fptr4c
+  complex(kind=4) :: res4
+  fptr4c => foo4c
+  res4 = fptr4c(6)
+end
+
+! CHECK-LABEL: func.func @_QQmain()
+! CHECK: fir.call %{{.*}}(%{{.*}}) fastmath<contract> {is_bind_c} : (i32) -> !fir.complex<4>