flang/test/Lower/host-associated-functions.f90

   1 ! RUN: bbc -emit-fir %s -o - | FileCheck %s
   2
   3 ! Test calling functions whose result interface is evaluated on the call site
   4 ! and where the calls are located in an internal procedure while the
   5 ! interface is defined in the host procedure.
   6
   7 ! CHECK-LABEL: func @_QPcapture_char_func_dummy(
   8 ! CHECK-SAME:  %[[VAL_0:.*]]: tuple<!fir.boxproc<() -> ()>, i64> {fir.char_proc},
   9 ! CHECK-SAME:  %[[VAL_1:.*]]: !fir.ref<i32> {fir.bindc_name = "n"}) {
  10 subroutine capture_char_func_dummy(char_func_dummy, n)
  11   character(n),external :: char_func_dummy
  12   ! CHECK:  %[[VAL_2:.*]] = fir.alloca tuple<tuple<!fir.boxproc<() -> ()>, i64>, !fir.ref<i32>>
  13   ! CHECK:  %[[VAL_3:.*]] = arith.constant 0 : i32
  14   ! 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>>
  15   ! CHECK:  fir.store %[[VAL_0]] to %[[VAL_4]] : !fir.ref<tuple<!fir.boxproc<() -> ()>, i64>>
  16   ! CHECK:  %[[VAL_5:.*]] = arith.constant 1 : i32
  17   ! 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>>
  18   ! CHECK:  fir.store %[[VAL_1]] to %[[VAL_6]] : !fir.llvm_ptr<!fir.ref<i32>>
  19   ! CHECK:  fir.call @_QFcapture_char_func_dummyPinternal(%[[VAL_2]]) {{.*}}: (!fir.ref<tuple<tuple<!fir.boxproc<() -> ()>, i64>, !fir.ref<i32>>>) -> ()
  20   call internal()
  21 contains
  22   ! CHECK-LABEL: func @_QFcapture_char_func_dummyPinternal(
  23   ! CHECK-SAME:  %[[VAL_0:.*]]: !fir.ref<tuple<tuple<!fir.boxproc<() -> ()>, i64>, !fir.ref<i32>>> {fir.host_assoc}) attributes {fir.internal_proc} {
  24   subroutine internal()
  25   ! CHECK:  %[[VAL_1:.*]] = arith.constant 0 : i32
  26   ! 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>>
  27   ! CHECK:  %[[VAL_3:.*]] = fir.load %[[VAL_2]] : !fir.ref<tuple<!fir.boxproc<() -> ()>, i64>>
  28   ! CHECK:  %[[VAL_4:.*]] = arith.constant 1 : i32
  29   ! 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>>
  30   ! CHECK:  %[[VAL_6:.*]] = fir.load %[[VAL_5]] : !fir.llvm_ptr<!fir.ref<i32>>
  31   ! CHECK:  %[[VAL_12:.*]] = fir.extract_value %[[VAL_3]], [0 : index] : (tuple<!fir.boxproc<() -> ()>, i64>) -> !fir.boxproc<() -> ()>
  32   ! CHECK:  %[[VAL_13:.*]] = fir.box_addr %[[VAL_12]] : (!fir.boxproc<() -> ()>) -> (() -> ())
  33   ! CHECK:  %[[VAL_14:.*]] = fir.load %[[VAL_6]] : !fir.ref<i32>
  34   ! CHECK:  %[[VAL_15:.*]] = fir.convert %[[VAL_14]] : (i32) -> i64
  35   ! CHECK:  %[[VAL_16:.*]] = fir.convert %[[VAL_15]] : (i64) -> index
  36   ! CHECK:  %[[C0:.*]] = arith.constant 0 : index
  37   ! CHECK:  %[[CMPI:.*]] = arith.cmpi sgt, %[[VAL_16]], %[[C0]] : index
  38   ! CHECK:  %[[SELECT:.*]] = arith.select %[[CMPI]], %[[VAL_16]], %[[C0]] : index
  39   ! CHECK:  %[[VAL_17:.*]] = fir.call @llvm.stacksave() {{.*}}: () -> !fir.ref<i8>
  40   ! CHECK:  %[[VAL_18:.*]] = fir.alloca !fir.char<1,?>(%[[SELECT]] : index) {bindc_name = ".result"}
  41   ! CHECK:  %[[VAL_19:.*]] = fir.convert %[[VAL_13]] : (() -> ()) -> ((!fir.ref<!fir.char<1,?>>, index) -> !fir.boxchar<1>)
  42   ! CHECK:  %[[VAL_20:.*]] = fir.call %[[VAL_19]](%[[VAL_18]], %[[SELECT]]) {{.*}}: (!fir.ref<!fir.char<1,?>>, index) -> !fir.boxchar<1>
  43    print *, char_func_dummy()
  44   end subroutine
  45 end subroutine
  46
  47 ! CHECK-LABEL: func @_QPcapture_char_func_assumed_dummy(
  48 ! CHECK-SAME:  %[[VAL_0:.*]]: tuple<!fir.boxproc<() -> ()>, i64> {fir.char_proc}) {
  49 subroutine capture_char_func_assumed_dummy(char_func_dummy)
  50   character(*),external :: char_func_dummy
  51 ! CHECK:  %[[VAL_1:.*]] = fir.alloca tuple<tuple<!fir.boxproc<() -> ()>, i64>>
  52 ! CHECK:  %[[VAL_2:.*]] = arith.constant 0 : i32
  53 ! CHECK:  %[[VAL_3:.*]] = fir.coordinate_of %[[VAL_1]], %[[VAL_2]] : (!fir.ref<tuple<tuple<!fir.boxproc<() -> ()>, i64>>>, i32) -> !fir.ref<tuple<!fir.boxproc<() -> ()>, i64>>
  54 ! CHECK:  fir.store %[[VAL_0]] to %[[VAL_3]] : !fir.ref<tuple<!fir.boxproc<() -> ()>, i64>>
  55 ! CHECK:  fir.call @_QFcapture_char_func_assumed_dummyPinternal(%[[VAL_1]]) {{.*}}: (!fir.ref<tuple<tuple<!fir.boxproc<() -> ()>, i64>>>) -> ()
  56   call internal()
  57 contains
  58 ! CHECK-LABEL: func @_QFcapture_char_func_assumed_dummyPinternal(
  59 ! CHECK-SAME:  %[[VAL_0:.*]]: !fir.ref<tuple<tuple<!fir.boxproc<() -> ()>, i64>>> {fir.host_assoc}) attributes {fir.internal_proc} {
  60   subroutine internal()
  61 ! CHECK:  %[[VAL_1:.*]] = arith.constant 0 : i32
  62 ! CHECK:  %[[VAL_2:.*]] = fir.coordinate_of %[[VAL_0]], %[[VAL_1]] : (!fir.ref<tuple<tuple<!fir.boxproc<() -> ()>, i64>>>, i32) -> !fir.ref<tuple<!fir.boxproc<() -> ()>, i64>>
  63 ! CHECK:  %[[VAL_3:.*]] = fir.load %[[VAL_2]] : !fir.ref<tuple<!fir.boxproc<() -> ()>, i64>>
  64 ! CHECK:  %[[VAL_9:.*]] = fir.extract_value %[[VAL_3]], [0 : index] : (tuple<!fir.boxproc<() -> ()>, i64>) -> !fir.boxproc<() -> ()>
  65 ! CHECK:  %[[VAL_10:.*]] = fir.box_addr %[[VAL_9]] : (!fir.boxproc<() -> ()>) -> (() -> ())
  66 ! CHECK:  %[[VAL_11:.*]] = fir.extract_value %[[VAL_3]], [1 : index] : (tuple<!fir.boxproc<() -> ()>, i64>) -> i64
  67 ! CHECK:  %[[VAL_12:.*]] = fir.call @llvm.stacksave() {{.*}}: () -> !fir.ref<i8>
  68 ! CHECK:  %[[VAL_13:.*]] = fir.alloca !fir.char<1,?>(%[[VAL_11]] : i64) {bindc_name = ".result"}
  69 ! CHECK:  %[[VAL_14:.*]] = fir.convert %[[VAL_10]] : (() -> ()) -> ((!fir.ref<!fir.char<1,?>>, index) -> !fir.boxchar<1>)
  70 ! CHECK:  %[[VAL_15:.*]] = fir.convert %[[VAL_11]] : (i64) -> index
  71 ! CHECK:  %[[VAL_16:.*]] = fir.call %[[VAL_14]](%[[VAL_13]], %[[VAL_15]]) {{.*}}: (!fir.ref<!fir.char<1,?>>, index) -> !fir.boxchar<1>
  72    print *, char_func_dummy()
  73   end subroutine
  74 end subroutine
  75
  76 ! CHECK-LABEL: func @_QPcapture_char_func(
  77 ! CHECK-SAME:  %[[VAL_0:.*]]: !fir.ref<i32> {fir.bindc_name = "n"}) {
  78 subroutine capture_char_func(n)
  79   character(n), external :: char_func
  80 ! CHECK:  %[[VAL_1:.*]] = fir.alloca tuple<!fir.ref<i32>>
  81 ! CHECK:  %[[VAL_2:.*]] = arith.constant 0 : i32
  82 ! CHECK:  %[[VAL_3:.*]] = fir.coordinate_of %[[VAL_1]], %[[VAL_2]] : (!fir.ref<tuple<!fir.ref<i32>>>, i32) -> !fir.llvm_ptr<!fir.ref<i32>>
  83 ! CHECK:  fir.store %[[VAL_0]] to %[[VAL_3]] : !fir.llvm_ptr<!fir.ref<i32>>
  84 ! CHECK:  fir.call @_QFcapture_char_funcPinternal(%[[VAL_1]]) {{.*}}: (!fir.ref<tuple<!fir.ref<i32>>>) -> ()
  85   call internal()
  86 contains
  87 ! CHECK-LABEL: func @_QFcapture_char_funcPinternal(
  88 ! CHECK-SAME:  %[[VAL_0:.*]]: !fir.ref<tuple<!fir.ref<i32>>> {fir.host_assoc})
  89   subroutine internal()
  90    print *, char_func()
  91   end subroutine
  92 end subroutine
  93
  94 ! CHECK-LABEL: func @_QPcapture_array_func(
  95 ! CHECK-SAME:  %[[VAL_0:.*]]: !fir.ref<i32> {fir.bindc_name = "n"}) {
  96 subroutine capture_array_func(n)
  97   integer :: n
  98   interface
  99   function array_func()
 100     import :: n
 101     integer :: array_func(n)
 102   end function
 103   end interface
 104 ! CHECK:  %[[VAL_1:.*]] = fir.alloca tuple<!fir.ref<i32>>
 105 ! CHECK:  %[[VAL_2:.*]] = arith.constant 0 : i32
 106 ! CHECK:  %[[VAL_3:.*]] = fir.coordinate_of %[[VAL_1]], %[[VAL_2]] : (!fir.ref<tuple<!fir.ref<i32>>>, i32) -> !fir.llvm_ptr<!fir.ref<i32>>
 107 ! CHECK:  fir.store %[[VAL_0]] to %[[VAL_3]] : !fir.llvm_ptr<!fir.ref<i32>>
 108 ! CHECK:  fir.call @_QFcapture_array_funcPinternal(%[[VAL_1]]) {{.*}}: (!fir.ref<tuple<!fir.ref<i32>>>) -> ()
 109   call internal()
 110 contains
 111   subroutine internal()
 112 ! CHECK-LABEL: func @_QFcapture_array_funcPinternal(
 113 ! CHECK-SAME:  %[[VAL_0:.*]]: !fir.ref<tuple<!fir.ref<i32>>> {fir.host_assoc}) attributes {fir.internal_proc} {
 114 ! CHECK:  %[[VAL_1:.*]] = arith.constant 0 : i32
 115 ! CHECK:  %[[VAL_2:.*]] = fir.coordinate_of %[[VAL_0]], %[[VAL_1]] : (!fir.ref<tuple<!fir.ref<i32>>>, i32) -> !fir.llvm_ptr<!fir.ref<i32>>
 116 ! CHECK:  %[[VAL_3:.*]] = fir.load %[[VAL_2]] : !fir.llvm_ptr<!fir.ref<i32>>
 117 ! CHECK:  %[[VAL_9:.*]] = fir.load %[[VAL_3]] : !fir.ref<i32>
 118 ! CHECK:  %[[VAL_10:.*]] = fir.convert %[[VAL_9]] : (i32) -> i64
 119 ! CHECK:  %[[VAL_11:.*]] = arith.constant 1 : i64
 120 ! CHECK:  %[[VAL_12:.*]] = arith.subi %[[VAL_10]], %[[VAL_11]] : i64
 121 ! CHECK:  %[[VAL_13:.*]] = arith.constant 1 : i64
 122 ! CHECK:  %[[VAL_14:.*]] = arith.addi %[[VAL_12]], %[[VAL_13]] : i64
 123 ! CHECK:  %[[VAL_15:.*]] = fir.convert %[[VAL_14]] : (i64) -> index
 124 ! CHECK:  %[[C0:.*]] = arith.constant 0 : index
 125 ! CHECK:  %[[CMPI:.*]] = arith.cmpi sgt, %[[VAL_15]], %[[C0]] : index
 126 ! CHECK:  %[[SELECT:.*]] = arith.select %[[CMPI]], %[[VAL_15]], %[[C0]] : index
 127 ! CHECK:  %[[VAL_16:.*]] = fir.call @llvm.stacksave() {{.*}}: () -> !fir.ref<i8>
 128 ! CHECK:  %[[VAL_17:.*]] = fir.alloca !fir.array<?xi32>, %[[SELECT]] {bindc_name = ".result"}
 129    print *, array_func()
 130   end subroutine
 131 end subroutine
 132
 133 module define_char_func
 134   contains
 135   function return_char(n)
 136     integer :: n
 137     character(n) :: return_char
 138     return_char = "a"
 139   end function
 140 end module
 141
 142 ! CHECK-LABEL: func @_QPuse_module() {
 143 subroutine use_module()
 144   ! verify there is no capture triggers by the interface.
 145   use define_char_func
 146 ! CHECK:  fir.call @_QFuse_modulePinternal() {{.*}}: () -> ()
 147   call internal()
 148   contains
 149 ! CHECK-LABEL: func @_QFuse_modulePinternal() {
 150   subroutine internal()
 151     print *, return_char(42)
 152   end subroutine
 153 end subroutine