flang/test/Lower/explicit-interface-results-2.f90

   1 ! Test lowering of internal procedures returning arrays or characters.
   2 ! This test allocation on the caller side of the results that may depend on
   3 ! host associated symbols.
   4 ! RUN: bbc %s -o - | FileCheck %s
   5
   6 module some_module
   7  integer :: n_module
   8 end module
   9
  10 ! Test host calling array internal procedure.
  11 ! Result depends on host variable.
  12 ! CHECK-LABEL: func @_QPhost1
  13 subroutine host1()
  14   implicit none
  15   integer :: n
  16 ! CHECK:  %[[VAL_1:.*]] = fir.alloca i32
  17   call takes_array(return_array())
  18 ! CHECK:  %[[VAL_4:.*]] = fir.load %[[VAL_1]] : !fir.ref<i32>
  19 ! CHECK:  %[[VAL_5:.*]] = fir.convert %[[VAL_4]] : (i32) -> index
  20 ! CHECK:  %[[CMPI:.*]] = arith.cmpi sgt, %[[VAL_5]], %{{.*}} : index
  21 ! CHECK:  %[[SELECT:.*]] = arith.select %[[CMPI]], %[[VAL_5]], %{{.*}} : index
  22 ! CHECK:  %[[VAL_6:.*]] = fir.alloca !fir.array<?xf32>, %[[SELECT]] {bindc_name = ".result"}
  23 contains
  24   function return_array()
  25     real :: return_array(n)
  26   end function
  27 end subroutine
  28
  29 ! Test host calling array internal procedure.
  30 ! Result depends on module variable with the use statement inside the host.
  31 ! CHECK-LABEL: func @_QPhost2
  32 subroutine host2()
  33   use :: some_module
  34   call takes_array(return_array())
  35 ! CHECK:  %[[VAL_0:.*]] = fir.address_of(@_QMsome_moduleEn_module) : !fir.ref<i32>
  36 ! CHECK:  %[[VAL_1:.*]] = fir.load %[[VAL_0]] : !fir.ref<i32>
  37 ! CHECK:  %[[VAL_2:.*]] = fir.convert %[[VAL_1]] : (i32) -> index
  38 ! CHECK:  %[[CMPI:.*]] = arith.cmpi sgt, %[[VAL_2]], %{{.*}} : index
  39 ! CHECK:  %[[SELECT:.*]] = arith.select %[[CMPI]], %[[VAL_2]], %{{.*}} : index
  40 ! CHECK:  %[[VAL_3:.*]] = fir.alloca !fir.array<?xf32>, %[[SELECT]] {bindc_name = ".result"}
  41 contains
  42   function return_array()
  43     real :: return_array(n_module)
  44   end function
  45 end subroutine
  46
  47 ! Test host calling array internal procedure.
  48 ! Result depends on module variable with the use statement inside the internal procedure.
  49 ! CHECK-LABEL: func @_QPhost3
  50 subroutine host3()
  51   call takes_array(return_array())
  52 ! CHECK:  %[[VAL_0:.*]] = fir.address_of(@_QMsome_moduleEn_module) : !fir.ref<i32>
  53 ! CHECK:  %[[VAL_1:.*]] = fir.load %[[VAL_0]] : !fir.ref<i32>
  54 ! CHECK:  %[[VAL_2:.*]] = fir.convert %[[VAL_1]] : (i32) -> index
  55 ! CHECK:  %[[CMPI:.*]] = arith.cmpi sgt, %[[VAL_2]], %{{.*}} : index
  56 ! CHECK:  %[[SELECT:.*]] = arith.select %[[CMPI]], %[[VAL_2]], %{{.*}} : index
  57 ! CHECK:  %[[VAL_3:.*]] = fir.alloca !fir.array<?xf32>, %[[SELECT]] {bindc_name = ".result"}
  58 contains
  59   function return_array()
  60     use :: some_module
  61     real :: return_array(n_module)
  62   end function
  63 end subroutine
  64
  65 ! Test internal procedure A calling array internal procedure B.
  66 ! Result depends on host variable not directly used in A.
  67 subroutine host4()
  68   implicit none
  69   integer :: n
  70   call internal_proc_a()
  71 contains
  72 ! CHECK-LABEL: func @_QFhost4Pinternal_proc_a
  73 ! CHECK-SAME:  %[[VAL_0:.*]]: !fir.ref<tuple<!fir.ref<i32>>> {fir.host_assoc}) attributes {fir.internal_proc} {
  74   subroutine internal_proc_a()
  75     call takes_array(return_array())
  76 ! CHECK:  %[[VAL_1:.*]] = arith.constant 0 : i32
  77 ! CHECK:  %[[VAL_2:.*]] = fir.coordinate_of %[[VAL_0]], %[[VAL_1]] : (!fir.ref<tuple<!fir.ref<i32>>>, i32) -> !fir.llvm_ptr<!fir.ref<i32>>
  78 ! CHECK:  %[[VAL_3:.*]] = fir.load %[[VAL_2]] : !fir.llvm_ptr<!fir.ref<i32>>
  79 ! CHECK:  %[[VAL_4:.*]] = fir.load %[[VAL_3]] : !fir.ref<i32>
  80 ! CHECK:  %[[VAL_5:.*]] = fir.convert %[[VAL_4]] : (i32) -> index
  81 ! CHECK:  %[[CMPI:.*]] = arith.cmpi sgt, %[[VAL_5]], %{{.*}} : index
  82 ! CHECK:  %[[SELECT:.*]] = arith.select %[[CMPI]], %[[VAL_5]], %{{.*}} : index
  83 ! CHECK:  %[[VAL_6:.*]] = fir.alloca !fir.array<?xf32>, %[[SELECT]] {bindc_name = ".result"}
  84   end subroutine
  85   function return_array()
  86     real :: return_array(n)
  87   end function
  88 end subroutine
  89
  90 ! Test internal procedure A calling array internal procedure B.
  91 ! Result depends on module variable with use statement in the host.
  92 subroutine host5()
  93   use :: some_module
  94   implicit none
  95   call internal_proc_a()
  96 contains
  97 ! CHECK-LABEL: func @_QFhost5Pinternal_proc_a() attributes {fir.internal_proc} {
  98   subroutine internal_proc_a()
  99     call takes_array(return_array())
 100 ! CHECK:  %[[VAL_0:.*]] = fir.address_of(@_QMsome_moduleEn_module) : !fir.ref<i32>
 101 ! CHECK:  %[[VAL_1:.*]] = fir.load %[[VAL_0]] : !fir.ref<i32>
 102 ! CHECK:  %[[VAL_2:.*]] = fir.convert %[[VAL_1]] : (i32) -> index
 103 ! CHECK:  %[[CMPI:.*]] = arith.cmpi sgt, %[[VAL_2]], %{{.*}} : index
 104 ! CHECK:  %[[SELECT:.*]] = arith.select %[[CMPI]], %[[VAL_2]], %{{.*}} : index
 105 ! CHECK:  %[[VAL_3:.*]] = fir.alloca !fir.array<?xf32>, %[[SELECT]] {bindc_name = ".result"}
 106   end subroutine
 107   function return_array()
 108     real :: return_array(n_module)
 109   end function
 110 end subroutine
 111
 112 ! Test internal procedure A calling array internal procedure B.
 113 ! Result depends on module variable with use statement in B.
 114 subroutine host6()
 115   implicit none
 116   call internal_proc_a()
 117 contains
 118 ! CHECK-LABEL: func @_QFhost6Pinternal_proc_a
 119   subroutine internal_proc_a()
 120     call takes_array(return_array())
 121 ! CHECK:  %[[VAL_0:.*]] = fir.address_of(@_QMsome_moduleEn_module) : !fir.ref<i32>
 122 ! CHECK:  %[[VAL_1:.*]] = fir.load %[[VAL_0]] : !fir.ref<i32>
 123 ! CHECK:  %[[VAL_2:.*]] = fir.convert %[[VAL_1]] : (i32) -> index
 124 ! CHECK:  %[[CMPI:.*]] = arith.cmpi sgt, %[[VAL_2]], %{{.*}} : index
 125 ! CHECK:  %[[SELECT:.*]] = arith.select %[[CMPI]], %[[VAL_2]], %{{.*}} : index
 126 ! CHECK:  %[[VAL_3:.*]] = fir.alloca !fir.array<?xf32>, %[[SELECT]] {bindc_name = ".result"}
 127   end subroutine
 128   function return_array()
 129     use :: some_module
 130     real :: return_array(n_module)
 131   end function
 132 end subroutine
 133
 134 ! Test host calling array internal procedure.
 135 ! Result depends on a common block variable declared in the host.
 136 ! CHECK-LABEL: func @_QPhost7
 137 subroutine host7()
 138   implicit none
 139   integer :: n_common
 140   common /mycom/ n_common
 141   call takes_array(return_array())
 142 ! CHECK:  %[[VAL_0:.*]] = arith.constant 0 : index
 143 ! CHECK:  %[[VAL_2:.*]] = fir.address_of(@mycom_) : !fir.ref<!fir.array<4xi8>>
 144 ! CHECK:  %[[VAL_3:.*]] = fir.convert %[[VAL_2]] : (!fir.ref<!fir.array<4xi8>>) -> !fir.ref<!fir.array<?xi8>>
 145 ! CHECK:  %[[VAL_4:.*]] = fir.coordinate_of %[[VAL_3]], %[[VAL_0]] : (!fir.ref<!fir.array<?xi8>>, index) -> !fir.ref<i8>
 146 ! CHECK:  %[[VAL_5:.*]] = fir.convert %[[VAL_4]] : (!fir.ref<i8>) -> !fir.ref<i32>
 147 ! CHECK:  %[[VAL_8:.*]] = fir.load %[[VAL_5]] : !fir.ref<i32>
 148 ! CHECK:  %[[VAL_9:.*]] = fir.convert %[[VAL_8]] : (i32) -> index
 149 ! CHECK:  %[[CMPI:.*]] = arith.cmpi sgt, %[[VAL_9]], %{{.*}} : index
 150 ! CHECK:  %[[SELECT:.*]] = arith.select %[[CMPI]], %[[VAL_9]], %{{.*}} : index
 151 ! CHECK:  %[[VAL_10:.*]] = fir.alloca !fir.array<?xf32>, %[[SELECT]] {bindc_name = ".result"}
 152 contains
 153   function return_array()
 154     real :: return_array(n_common)
 155   end function
 156 end subroutine
 157
 158 ! Test host calling array internal procedure.
 159 ! Result depends on a common block variable declared in the internal procedure.
 160 ! CHECK-LABEL: func @_QPhost8
 161 subroutine host8()
 162   implicit none
 163   call takes_array(return_array())
 164 ! CHECK:  %[[VAL_0:.*]] = arith.constant 0 : index
 165 ! CHECK:  %[[VAL_1:.*]] = fir.address_of(@mycom_) : !fir.ref<!fir.array<4xi8>>
 166 ! CHECK:  %[[VAL_2:.*]] = fir.convert %[[VAL_1]] : (!fir.ref<!fir.array<4xi8>>) -> !fir.ref<!fir.array<?xi8>>
 167 ! CHECK:  %[[VAL_3:.*]] = fir.coordinate_of %[[VAL_2]], %[[VAL_0]] : (!fir.ref<!fir.array<?xi8>>, index) -> !fir.ref<i8>
 168 ! CHECK:  %[[VAL_4:.*]] = fir.convert %[[VAL_3]] : (!fir.ref<i8>) -> !fir.ref<i32>
 169 ! CHECK:  %[[VAL_5:.*]] = fir.load %[[VAL_4]] : !fir.ref<i32>
 170 ! CHECK:  %[[VAL_6:.*]] = fir.convert %[[VAL_5]] : (i32) -> index
 171 ! CHECK:  %[[CMPI:.*]] = arith.cmpi sgt, %[[VAL_6]], %{{.*}} : index
 172 ! CHECK:  %[[SELECT:.*]] = arith.select %[[CMPI]], %[[VAL_6]], %{{.*}} : index
 173 ! CHECK:  %[[VAL_7:.*]] = fir.alloca !fir.array<?xf32>, %[[SELECT]] {bindc_name = ".result"}
 174 contains
 175   function return_array()
 176     integer :: n_common
 177     common /mycom/ n_common
 178     real :: return_array(n_common)
 179   end function
 180 end subroutine
 181
 182 ! Test internal procedure A calling array internal procedure B.
 183 ! Result depends on a common block variable declared in the host.
 184 subroutine host9()
 185   implicit none
 186   integer :: n_common
 187   common /mycom/ n_common
 188   call internal_proc_a()
 189 contains
 190 ! CHECK-LABEL: func @_QFhost9Pinternal_proc_a
 191   subroutine internal_proc_a()
 192 ! CHECK:  %[[VAL_0:.*]] = arith.constant 0 : index
 193 ! CHECK:  %[[VAL_1:.*]] = fir.address_of(@mycom_) : !fir.ref<!fir.array<4xi8>>
 194 ! CHECK:  %[[VAL_2:.*]] = fir.convert %[[VAL_1]] : (!fir.ref<!fir.array<4xi8>>) -> !fir.ref<!fir.array<?xi8>>
 195 ! CHECK:  %[[VAL_3:.*]] = fir.coordinate_of %[[VAL_2]], %[[VAL_0]] : (!fir.ref<!fir.array<?xi8>>, index) -> !fir.ref<i8>
 196 ! CHECK:  %[[VAL_4:.*]] = fir.convert %[[VAL_3]] : (!fir.ref<i8>) -> !fir.ref<i32>
 197 ! CHECK:  %[[VAL_5:.*]] = fir.load %[[VAL_4]] : !fir.ref<i32>
 198 ! CHECK:  %[[VAL_6:.*]] = fir.convert %[[VAL_5]] : (i32) -> index
 199 ! CHECK:  %[[VAL_7:.*]] = arith.cmpi sgt, %[[VAL_6]], %[[VAL_0]] : index
 200 ! CHECK:  %[[VAL_8:.*]] = arith.select %[[VAL_7]], %[[VAL_6]], %[[VAL_0]] : index
 201 ! CHECK:  %[[VAL_10:.*]] = fir.alloca !fir.array<?xf32>, %[[VAL_8]] {bindc_name = ".result"}
 202     call takes_array(return_array())
 203   end subroutine
 204   function return_array()
 205     use :: some_module
 206     real :: return_array(n_common)
 207   end function
 208 end subroutine
 209
 210 ! Test internal procedure A calling array internal procedure B.
 211 ! Result depends on a common block variable declared in B.
 212 subroutine host10()
 213   implicit none
 214   call internal_proc_a()
 215 contains
 216 ! CHECK-LABEL: func @_QFhost10Pinternal_proc_a
 217   subroutine internal_proc_a()
 218     call takes_array(return_array())
 219 ! CHECK:  %[[VAL_0:.*]] = arith.constant 0 : index
 220 ! CHECK:  %[[VAL_1:.*]] = fir.address_of(@mycom_) : !fir.ref<!fir.array<4xi8>>
 221 ! CHECK:  %[[VAL_2:.*]] = fir.convert %[[VAL_1]] : (!fir.ref<!fir.array<4xi8>>) -> !fir.ref<!fir.array<?xi8>>
 222 ! CHECK:  %[[VAL_3:.*]] = fir.coordinate_of %[[VAL_2]], %[[VAL_0]] : (!fir.ref<!fir.array<?xi8>>, index) -> !fir.ref<i8>
 223 ! CHECK:  %[[VAL_4:.*]] = fir.convert %[[VAL_3]] : (!fir.ref<i8>) -> !fir.ref<i32>
 224 ! CHECK:  %[[VAL_5:.*]] = fir.load %[[VAL_4]] : !fir.ref<i32>
 225 ! CHECK:  %[[VAL_6:.*]] = fir.convert %[[VAL_5]] : (i32) -> index
 226 ! CHECK:  %[[CMPI:.*]] = arith.cmpi sgt, %[[VAL_6]], %{{.*}} : index
 227 ! CHECK:  %[[SELECT:.*]] = arith.select %[[CMPI]], %[[VAL_6]], %{{.*}} : index
 228 ! CHECK:  %[[VAL_7:.*]] = fir.alloca !fir.array<?xf32>, %[[SELECT]] {bindc_name = ".result"}
 229   end subroutine
 230   function return_array()
 231     integer :: n_common
 232     common /mycom/ n_common
 233     real :: return_array(n_common)
 234   end function
 235 end subroutine
 236
 237
 238 ! Test call to a function returning an array where the interface is use
 239 ! associated from a module.
 240 module define_interface
 241 contains
 242 function foo()
 243   real :: foo(100)
 244   foo = 42
 245 end function
 246 end module
 247 ! CHECK-LABEL: func @_QPtest_call_to_used_interface(
 248 ! CHECK-SAME:  %[[VAL_0:.*]]: !fir.boxproc<() -> ()>) {
 249 subroutine test_call_to_used_interface(dummy_proc)
 250   use define_interface
 251   procedure(foo) :: dummy_proc
 252   call takes_array(dummy_proc())
 253 ! CHECK:  %[[VAL_1:.*]] = arith.constant 100 : index
 254 ! CHECK:  %[[VAL_2:.*]] = fir.alloca !fir.array<100xf32> {bindc_name = ".result"}
 255 ! CHECK:  %[[VAL_3:.*]] = fir.call @llvm.stacksave.p0() {{.*}}: () -> !fir.ref<i8>
 256 ! CHECK:  %[[VAL_4:.*]] = fir.shape %[[VAL_1]] : (index) -> !fir.shape<1>
 257 ! CHECK:  %[[VAL_5:.*]] = fir.box_addr %[[VAL_0]] : (!fir.boxproc<() -> ()>) -> (() -> !fir.array<100xf32>)
 258 ! CHECK:  %[[VAL_6:.*]] = fir.call %[[VAL_5]]() {{.*}}: () -> !fir.array<100xf32>
 259 ! CHECK:  fir.save_result %[[VAL_6]] to %[[VAL_2]](%[[VAL_4]]) : !fir.array<100xf32>, !fir.ref<!fir.array<100xf32>>, !fir.shape<1>
 260 ! CHECK:  %[[VAL_7:.*]] = fir.convert %[[VAL_2]] : (!fir.ref<!fir.array<100xf32>>) -> !fir.ref<!fir.array<?xf32>>
 261 ! CHECK:  fir.call @_QPtakes_array(%[[VAL_7]]) {{.*}}: (!fir.ref<!fir.array<?xf32>>) -> ()
 262 ! CHECK:  fir.call @llvm.stackrestore.p0(%[[VAL_3]]) {{.*}}: (!fir.ref<i8>) -> ()
 263 end subroutine