1! RUN: bbc -emit-fir %s -o - | FileCheck %s 2 3module callee 4implicit none 5contains 6! CHECK-LABEL: func @_QMcalleePreturn_cst_array() -> !fir.array<20x30xf32> 7function return_cst_array() 8 real :: return_cst_array(20, 30) 9end function 10 11! CHECK-LABEL: func @_QMcalleePreturn_dyn_array( 12! CHECK-SAME: %{{.*}}: !fir.ref<i32>{{.*}}, %{{.*}}: !fir.ref<i32>{{.*}}) -> !fir.array<?x?xf32> 13function return_dyn_array(m, n) 14 integer :: m, n 15 real :: return_dyn_array(m, n) 16end function 17 18! CHECK-LABEL: func @_QMcalleePreturn_cst_char_cst_array() -> !fir.array<20x30x!fir.char<1,10>> 19function return_cst_char_cst_array() 20 character(10) :: return_cst_char_cst_array(20, 30) 21end function 22 23! CHECK-LABEL: func @_QMcalleePreturn_dyn_char_cst_array( 24! CHECK-SAME: %{{.*}}: !fir.ref<i32>{{.*}}) -> !fir.array<20x30x!fir.char<1,?>> 25function return_dyn_char_cst_array(l) 26 integer :: l 27 character(l) :: return_dyn_char_cst_array(20, 30) 28end function 29 30! CHECK-LABEL: func @_QMcalleePreturn_cst_char_dyn_array( 31! CHECK-SAME: %{{.*}}: !fir.ref<i32>{{.*}}, %{{.*}}: !fir.ref<i32>{{.*}}) -> !fir.array<?x?x!fir.char<1,10>> 32function return_cst_char_dyn_array(m, n) 33 integer :: m, n 34 character(10) :: return_cst_char_dyn_array(m, n) 35end function 36 37! CHECK-LABEL: func @_QMcalleePreturn_dyn_char_dyn_array( 38! CHECK-SAME: %{{.*}}: !fir.ref<i32>{{.*}}, %{{.*}}: !fir.ref<i32>{{.*}}, %{{.*}}: !fir.ref<i32>{{.*}}) -> !fir.array<?x?x!fir.char<1,?>> 39function return_dyn_char_dyn_array(l, m, n) 40 integer :: l, m, n 41 character(l) :: return_dyn_char_dyn_array(m, n) 42end function 43 44! CHECK-LABEL: func @_QMcalleePreturn_alloc() -> !fir.box<!fir.heap<!fir.array<?xf32>>> 45function return_alloc() 46 real, allocatable :: return_alloc(:) 47end function 48 49! CHECK-LABEL: func @_QMcalleePreturn_cst_char_alloc() -> !fir.box<!fir.heap<!fir.array<?x!fir.char<1,10>>>> 50function return_cst_char_alloc() 51 character(10), allocatable :: return_cst_char_alloc(:) 52end function 53 54! CHECK-LABEL: func @_QMcalleePreturn_dyn_char_alloc( 55! CHECK-SAME: %{{.*}}: !fir.ref<i32>{{.*}}) -> !fir.box<!fir.heap<!fir.array<?x!fir.char<1,?>>>> 56function return_dyn_char_alloc(l) 57 integer :: l 58 character(l), allocatable :: return_dyn_char_alloc(:) 59end function 60 61! CHECK-LABEL: func @_QMcalleePreturn_def_char_alloc() -> !fir.box<!fir.heap<!fir.array<?x!fir.char<1,?>>>> 62function return_def_char_alloc() 63 character(:), allocatable :: return_def_char_alloc(:) 64end function 65 66! CHECK-LABEL: func @_QMcalleePreturn_pointer() -> !fir.box<!fir.ptr<!fir.array<?xf32>>> 67function return_pointer() 68 real, pointer :: return_pointer(:) 69end function 70 71! CHECK-LABEL: func @_QMcalleePreturn_cst_char_pointer() -> !fir.box<!fir.ptr<!fir.array<?x!fir.char<1,10>>>> 72function return_cst_char_pointer() 73 character(10), pointer :: return_cst_char_pointer(:) 74end function 75 76! CHECK-LABEL: func @_QMcalleePreturn_dyn_char_pointer( 77! CHECK-SAME: %{{.*}}: !fir.ref<i32>{{.*}}) -> !fir.box<!fir.ptr<!fir.array<?x!fir.char<1,?>>>> 78function return_dyn_char_pointer(l) 79 integer :: l 80 character(l), pointer :: return_dyn_char_pointer(:) 81end function 82 83! CHECK-LABEL: func @_QMcalleePreturn_def_char_pointer() -> !fir.box<!fir.ptr<!fir.array<?x!fir.char<1,?>>>> 84function return_def_char_pointer() 85 character(:), pointer :: return_def_char_pointer(:) 86end function 87end module 88 89module caller 90 use callee 91contains 92 93! CHECK-LABEL: func @_QMcallerPcst_array() 94subroutine cst_array() 95 ! CHECK: %[[alloc:.*]] = fir.alloca !fir.array<20x30xf32> {{{.*}}bindc_name = ".result"} 96 ! CHECK: %[[shape:.*]] = fir.shape %{{.*}}, {{.*}} : (index, index) -> !fir.shape<2> 97 ! CHECK: %[[res:.*]] = fir.call @_QMcalleePreturn_cst_array() : () -> !fir.array<20x30xf32> 98 ! CHECK: fir.save_result %[[res]] to %[[alloc]](%[[shape]]) : !fir.array<20x30xf32>, !fir.ref<!fir.array<20x30xf32>>, !fir.shape<2> 99 print *, return_cst_array() 100end subroutine 101 102! CHECK-LABEL: func @_QMcallerPcst_char_cst_array() 103subroutine cst_char_cst_array() 104 ! CHECK: %[[alloc:.*]] = fir.alloca !fir.array<20x30x!fir.char<1,10>> {{{.*}}bindc_name = ".result"} 105 ! CHECK: %[[shape:.*]] = fir.shape %{{.*}}, {{.*}} : (index, index) -> !fir.shape<2> 106 ! CHECK: %[[res:.*]] = fir.call @_QMcalleePreturn_cst_char_cst_array() : () -> !fir.array<20x30x!fir.char<1,10>> 107 ! CHECK: fir.save_result %[[res]] to %[[alloc]](%[[shape]]) typeparams %{{.*}} : !fir.array<20x30x!fir.char<1,10>>, !fir.ref<!fir.array<20x30x!fir.char<1,10>>>, !fir.shape<2>, index 108 print *, return_cst_char_cst_array() 109end subroutine 110 111! CHECK-LABEL: func @_QMcallerPalloc() 112subroutine alloc() 113 ! CHECK: %[[alloc:.*]] = fir.alloca !fir.box<!fir.heap<!fir.array<?xf32>>> {{{.*}}bindc_name = ".result"} 114 ! CHECK: %[[res:.*]] = fir.call @_QMcalleePreturn_alloc() : () -> !fir.box<!fir.heap<!fir.array<?xf32>>> 115 ! CHECK: fir.save_result %[[res]] to %[[alloc]] : !fir.box<!fir.heap<!fir.array<?xf32>>>, !fir.ref<!fir.box<!fir.heap<!fir.array<?xf32>>>> 116 print *, return_alloc() 117 ! CHECK: _FortranAioOutputDescriptor 118 ! CHECK: %[[load:.*]] = fir.load %[[alloc]] : !fir.ref<!fir.box<!fir.heap<!fir.array<?xf32>>>> 119 ! CHECK: %[[addr:.*]] = fir.box_addr %[[load]] : (!fir.box<!fir.heap<!fir.array<?xf32>>>) -> !fir.heap<!fir.array<?xf32>> 120 ! CHECK: %[[cmpi:.*]] = arith.cmpi 121 ! CHECK: fir.if %[[cmpi]] 122 ! CHECK: fir.freemem %[[addr]] : !fir.heap<!fir.array<?xf32>> 123end subroutine 124 125! CHECK-LABEL: func @_QMcallerPcst_char_alloc() 126subroutine cst_char_alloc() 127 ! CHECK: %[[alloc:.*]] = fir.alloca !fir.box<!fir.heap<!fir.array<?x!fir.char<1,10>>>> {{{.*}}bindc_name = ".result"} 128 ! CHECK: %[[res:.*]] = fir.call @_QMcalleePreturn_cst_char_alloc() : () -> !fir.box<!fir.heap<!fir.array<?x!fir.char<1,10>>>> 129 ! CHECK: fir.save_result %[[res]] to %[[alloc]] : !fir.box<!fir.heap<!fir.array<?x!fir.char<1,10>>>>, !fir.ref<!fir.box<!fir.heap<!fir.array<?x!fir.char<1,10>>>>> 130 print *, return_cst_char_alloc() 131 ! CHECK: _FortranAioOutputDescriptor 132 ! CHECK: %[[load:.*]] = fir.load %[[alloc]] : !fir.ref<!fir.box<!fir.heap<!fir.array<?x!fir.char<1,10>>>>> 133 ! CHECK: %[[addr:.*]] = fir.box_addr %[[load]] : (!fir.box<!fir.heap<!fir.array<?x!fir.char<1,10>>>>) -> !fir.heap<!fir.array<?x!fir.char<1,10>>> 134 ! CHECK: %[[cmpi:.*]] = arith.cmpi 135 ! CHECK: fir.if %[[cmpi]] 136 ! CHECK: fir.freemem %[[addr]] : !fir.heap<!fir.array<?x!fir.char<1,10>>> 137end subroutine 138 139! CHECK-LABEL: func @_QMcallerPdef_char_alloc() 140subroutine def_char_alloc() 141 ! CHECK: %[[alloc:.*]] = fir.alloca !fir.box<!fir.heap<!fir.array<?x!fir.char<1,?>>>> {{{.*}}bindc_name = ".result"} 142 ! CHECK: %[[res:.*]] = fir.call @_QMcalleePreturn_def_char_alloc() : () -> !fir.box<!fir.heap<!fir.array<?x!fir.char<1,?>>>> 143 ! CHECK: fir.save_result %[[res]] to %[[alloc]] : !fir.box<!fir.heap<!fir.array<?x!fir.char<1,?>>>>, !fir.ref<!fir.box<!fir.heap<!fir.array<?x!fir.char<1,?>>>>> 144 print *, return_def_char_alloc() 145 ! CHECK: _FortranAioOutputDescriptor 146 ! CHECK: %[[load:.*]] = fir.load %[[alloc]] : !fir.ref<!fir.box<!fir.heap<!fir.array<?x!fir.char<1,?>>>>> 147 ! CHECK: %[[addr:.*]] = fir.box_addr %[[load]] : (!fir.box<!fir.heap<!fir.array<?x!fir.char<1,?>>>>) -> !fir.heap<!fir.array<?x!fir.char<1,?>>> 148 ! CHECK: %[[cmpi:.*]] = arith.cmpi 149 ! CHECK: fir.if %[[cmpi]] 150 ! CHECK: fir.freemem %[[addr]] : !fir.heap<!fir.array<?x!fir.char<1,?>>> 151end subroutine 152 153! CHECK-LABEL: func @_QMcallerPpointer_test() 154subroutine pointer_test() 155 ! CHECK: %[[alloc:.*]] = fir.alloca !fir.box<!fir.ptr<!fir.array<?xf32>>> {{{.*}}bindc_name = ".result"} 156 ! CHECK: %[[res:.*]] = fir.call @_QMcalleePreturn_pointer() : () -> !fir.box<!fir.ptr<!fir.array<?xf32>>> 157 ! CHECK: fir.save_result %[[res]] to %[[alloc]] : !fir.box<!fir.ptr<!fir.array<?xf32>>>, !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>> 158 print *, return_pointer() 159 ! CHECK-NOT: fir.freemem 160end subroutine 161 162! CHECK-LABEL: func @_QMcallerPcst_char_pointer() 163subroutine cst_char_pointer() 164 ! CHECK: %[[alloc:.*]] = fir.alloca !fir.box<!fir.ptr<!fir.array<?x!fir.char<1,10>>>> {{{.*}}bindc_name = ".result"} 165 ! CHECK: %[[res:.*]] = fir.call @_QMcalleePreturn_cst_char_pointer() : () -> !fir.box<!fir.ptr<!fir.array<?x!fir.char<1,10>>>> 166 ! CHECK: fir.save_result %[[res]] to %[[alloc]] : !fir.box<!fir.ptr<!fir.array<?x!fir.char<1,10>>>>, !fir.ref<!fir.box<!fir.ptr<!fir.array<?x!fir.char<1,10>>>>> 167 print *, return_cst_char_pointer() 168 ! CHECK-NOT: fir.freemem 169end subroutine 170 171! CHECK-LABEL: func @_QMcallerPdef_char_pointer() 172subroutine def_char_pointer() 173 ! CHECK: %[[alloc:.*]] = fir.alloca !fir.box<!fir.ptr<!fir.array<?x!fir.char<1,?>>>> {{{.*}}bindc_name = ".result"} 174 ! CHECK: %[[res:.*]] = fir.call @_QMcalleePreturn_def_char_pointer() : () -> !fir.box<!fir.ptr<!fir.array<?x!fir.char<1,?>>>> 175 ! CHECK: fir.save_result %[[res]] to %[[alloc]] : !fir.box<!fir.ptr<!fir.array<?x!fir.char<1,?>>>>, !fir.ref<!fir.box<!fir.ptr<!fir.array<?x!fir.char<1,?>>>>> 176 print *, return_def_char_pointer() 177 ! CHECK-NOT: fir.freemem 178end subroutine 179 180! CHECK-LABEL: func @_QMcallerPdyn_array( 181! CHECK-SAME: %[[m:.*]]: !fir.ref<i32>{{.*}}, %[[n:.*]]: !fir.ref<i32>{{.*}}) { 182subroutine dyn_array(m, n) 183 integer :: m, n 184 ! CHECK-DAG: %[[mload:.*]] = fir.load %[[m]] : !fir.ref<i32> 185 ! CHECK-DAG: %[[mcast:.*]] = fir.convert %[[mload]] : (i32) -> i64 186 ! CHECK-DAG: %[[msub:.*]] = arith.subi %[[mcast]], %c1{{.*}} : i64 187 ! CHECK-DAG: %[[madd:.*]] = arith.addi %[[msub]], %c1{{.*}} : i64 188 ! CHECK-DAG: %[[mcast2:.*]] = fir.convert %[[madd]] : (i64) -> index 189 ! CHECK-DAG: %[[nload:.*]] = fir.load %[[n]] : !fir.ref<i32> 190 ! CHECK-DAG: %[[ncast:.*]] = fir.convert %[[nload]] : (i32) -> i64 191 ! CHECK-DAG: %[[nsub:.*]] = arith.subi %[[ncast]], %c1{{.*}} : i64 192 ! CHECK-DAG: %[[nadd:.*]] = arith.addi %[[nsub]], %c1{{.*}} : i64 193 ! CHECK-DAG: %[[ncast2:.*]] = fir.convert %[[nadd]] : (i64) -> index 194 ! CHECK: %[[tmp:.*]] = fir.alloca !fir.array<?x?xf32>, %[[mcast2]], %[[ncast2]] 195 ! CHECK: %[[shape:.*]] = fir.shape %[[mcast2]], %[[ncast2]] : (index, index) -> !fir.shape<2> 196 ! CHECK: %[[res:.*]] = fir.call @_QMcalleePreturn_dyn_array(%[[m]], %[[n]]) : (!fir.ref<i32>, !fir.ref<i32>) -> !fir.array<?x?xf32> 197 ! CHECK: fir.save_result %[[res]] to %[[tmp]](%[[shape]]) : !fir.array<?x?xf32>, !fir.ref<!fir.array<?x?xf32>>, !fir.shape<2> 198 print *, return_dyn_array(m, n) 199end subroutine 200 201! CHECK-LABEL: func @_QMcallerPdyn_char_cst_array( 202! CHECK-SAME: %[[l:.*]]: !fir.ref<i32>{{.*}}) { 203subroutine dyn_char_cst_array(l) 204 integer :: l 205 ! CHECK: %[[lload:.*]] = fir.load %[[l]] : !fir.ref<i32> 206 ! CHECK: %[[lcast:.*]] = fir.convert %[[lload]] : (i32) -> i64 207 ! CHECK: %[[lcast2:.*]] = fir.convert %[[lcast]] : (i64) -> index 208 ! CHECK: %[[tmp:.*]] = fir.alloca !fir.array<20x30x!fir.char<1,?>>(%[[lcast2]] : index) 209 ! CHECK: %[[shape:.*]] = fir.shape %{{.*}}, %{{.*}} : (index, index) -> !fir.shape<2> 210 ! CHECK: %[[res:.*]] = fir.call @_QMcalleePreturn_dyn_char_cst_array(%[[l]]) : (!fir.ref<i32>) -> !fir.array<20x30x!fir.char<1,?>> 211 ! CHECK: fir.save_result %[[res]] to %[[tmp]](%[[shape]]) typeparams %[[lcast2]] : !fir.array<20x30x!fir.char<1,?>>, !fir.ref<!fir.array<20x30x!fir.char<1,?>>>, !fir.shape<2>, index 212 print *, return_dyn_char_cst_array(l) 213end subroutine 214 215! CHECK-LABEL: func @_QMcallerPcst_char_dyn_array( 216! CHECK-SAME: %[[m:.*]]: !fir.ref<i32>{{.*}}, %[[n:.*]]: !fir.ref<i32>{{.*}}) { 217subroutine cst_char_dyn_array(m, n) 218 integer :: m, n 219 ! CHECK-DAG: %[[mload:.*]] = fir.load %[[m]] : !fir.ref<i32> 220 ! CHECK-DAG: %[[mcast:.*]] = fir.convert %[[mload]] : (i32) -> i64 221 ! CHECK-DAG: %[[msub:.*]] = arith.subi %[[mcast]], %c1{{.*}} : i64 222 ! CHECK-DAG: %[[madd:.*]] = arith.addi %[[msub]], %c1{{.*}} : i64 223 ! CHECK-DAG: %[[mcast2:.*]] = fir.convert %[[madd]] : (i64) -> index 224 ! CHECK-DAG: %[[nload:.*]] = fir.load %[[n]] : !fir.ref<i32> 225 ! CHECK-DAG: %[[ncast:.*]] = fir.convert %[[nload]] : (i32) -> i64 226 ! CHECK-DAG: %[[nsub:.*]] = arith.subi %[[ncast]], %c1{{.*}} : i64 227 ! CHECK-DAG: %[[nadd:.*]] = arith.addi %[[nsub]], %c1{{.*}} : i64 228 ! CHECK-DAG: %[[ncast2:.*]] = fir.convert %[[nadd]] : (i64) -> index 229 ! CHECK: %[[tmp:.*]] = fir.alloca !fir.array<?x?x!fir.char<1,10>>, %[[mcast2]], %[[ncast2]] 230 ! CHECK: %[[shape:.*]] = fir.shape %[[mcast2]], %[[ncast2]] : (index, index) -> !fir.shape<2> 231 ! CHECK: %[[res:.*]] = fir.call @_QMcalleePreturn_cst_char_dyn_array(%[[m]], %[[n]]) : (!fir.ref<i32>, !fir.ref<i32>) -> !fir.array<?x?x!fir.char<1,10>> 232 ! CHECK: fir.save_result %[[res]] to %[[tmp]](%[[shape]]) typeparams {{.*}} : !fir.array<?x?x!fir.char<1,10>>, !fir.ref<!fir.array<?x?x!fir.char<1,10>>>, !fir.shape<2>, index 233 print *, return_cst_char_dyn_array(m, n) 234end subroutine 235 236! CHECK-LABEL: func @_QMcallerPdyn_char_dyn_array( 237! CHECK-SAME: %[[l:.*]]: !fir.ref<i32>{{.*}}, %[[m:.*]]: !fir.ref<i32>{{.*}}, %[[n:.*]]: !fir.ref<i32>{{.*}}) { 238subroutine dyn_char_dyn_array(l, m, n) 239 ! CHECK-DAG: %[[mload:.*]] = fir.load %[[m]] : !fir.ref<i32> 240 ! CHECK-DAG: %[[mcast:.*]] = fir.convert %[[mload]] : (i32) -> i64 241 ! CHECK-DAG: %[[msub:.*]] = arith.subi %[[mcast]], %c1{{.*}} : i64 242 ! CHECK-DAG: %[[madd:.*]] = arith.addi %[[msub]], %c1{{.*}} : i64 243 ! CHECK-DAG: %[[mcast2:.*]] = fir.convert %[[madd]] : (i64) -> index 244 245 ! CHECK-DAG: %[[nload:.*]] = fir.load %[[n]] : !fir.ref<i32> 246 ! CHECK-DAG: %[[ncast:.*]] = fir.convert %[[nload]] : (i32) -> i64 247 ! CHECK-DAG: %[[nsub:.*]] = arith.subi %[[ncast]], %c1{{.*}} : i64 248 ! CHECK-DAG: %[[nadd:.*]] = arith.addi %[[nsub]], %c1{{.*}} : i64 249 ! CHECK-DAG: %[[ncast2:.*]] = fir.convert %[[nadd]] : (i64) -> index 250 251 ! CHECK-DAG: %[[lload:.*]] = fir.load %[[l]] : !fir.ref<i32> 252 ! CHECK-DAG: %[[lcast:.*]] = fir.convert %[[lload]] : (i32) -> i64 253 ! CHECK-DAG: %[[lcast2:.*]] = fir.convert %[[lcast]] : (i64) -> index 254 ! CHECK: %[[tmp:.*]] = fir.alloca !fir.array<?x?x!fir.char<1,?>>(%[[lcast2]] : index), %[[mcast2]], %[[ncast2]] 255 ! CHECK: %[[shape:.*]] = fir.shape %[[mcast2]], %[[ncast2]] : (index, index) -> !fir.shape<2> 256 ! CHECK: %[[res:.*]] = fir.call @_QMcalleePreturn_dyn_char_dyn_array(%[[l]], %[[m]], %[[n]]) : (!fir.ref<i32>, !fir.ref<i32>, !fir.ref<i32>) -> !fir.array<?x?x!fir.char<1,?>> 257 ! CHECK: fir.save_result %[[res]] to %[[tmp]](%[[shape]]) typeparams {{.*}} : !fir.array<?x?x!fir.char<1,?>>, !fir.ref<!fir.array<?x?x!fir.char<1,?>>>, !fir.shape<2>, index 258 integer :: l, m, n 259 print *, return_dyn_char_dyn_array(l, m, n) 260end subroutine 261 262! CHECK-LABEL: @_QMcallerPdyn_char_alloc 263subroutine dyn_char_alloc(l) 264 integer :: l 265 ! CHECK: %[[alloc:.*]] = fir.alloca !fir.box<!fir.heap<!fir.array<?x!fir.char<1,?>>>> {{{.*}}bindc_name = ".result"} 266 ! CHECK: %[[res:.*]] = fir.call @_QMcalleePreturn_dyn_char_alloc({{.*}}) : (!fir.ref<i32>) -> !fir.box<!fir.heap<!fir.array<?x!fir.char<1,?>>>> 267 ! CHECK: fir.save_result %[[res]] to %[[alloc]] : !fir.box<!fir.heap<!fir.array<?x!fir.char<1,?>>>>, !fir.ref<!fir.box<!fir.heap<!fir.array<?x!fir.char<1,?>>>>> 268 print *, return_dyn_char_alloc(l) 269 ! CHECK: _FortranAioOutputDescriptor 270 ! CHECK: %[[load:.*]] = fir.load %[[alloc]] : !fir.ref<!fir.box<!fir.heap<!fir.array<?x!fir.char<1,?>>>>> 271 ! CHECK: %[[addr:.*]] = fir.box_addr %[[load]] : (!fir.box<!fir.heap<!fir.array<?x!fir.char<1,?>>>>) -> !fir.heap<!fir.array<?x!fir.char<1,?>>> 272 ! CHECK: %[[cmpi:.*]] = arith.cmpi 273 ! CHECK: fir.if %[[cmpi]] 274 ! CHECK: fir.freemem %[[addr]] : !fir.heap<!fir.array<?x!fir.char<1,?>>> 275end subroutine 276 277! CHECK-LABEL: @_QMcallerPdyn_char_pointer 278subroutine dyn_char_pointer(l) 279 integer :: l 280 ! CHECK: %[[alloc:.*]] = fir.alloca !fir.box<!fir.ptr<!fir.array<?x!fir.char<1,?>>>> {{{.*}}bindc_name = ".result"} 281 ! CHECK: %[[res:.*]] = fir.call @_QMcalleePreturn_dyn_char_pointer({{.*}}) : (!fir.ref<i32>) -> !fir.box<!fir.ptr<!fir.array<?x!fir.char<1,?>>>> 282 ! CHECK: fir.save_result %[[res]] to %[[alloc]] : !fir.box<!fir.ptr<!fir.array<?x!fir.char<1,?>>>>, !fir.ref<!fir.box<!fir.ptr<!fir.array<?x!fir.char<1,?>>>>> 283 print *, return_dyn_char_pointer(l) 284 ! CHECK-NOT: fir.freemem 285end subroutine 286 287end module 288 289 290! Test more complex symbol dependencies in the result specification expression 291 292module m_with_equiv 293 integer(8) :: l 294 integer(8) :: array(3) 295 equivalence (array(2), l) 296contains 297 function result_depends_on_equiv_sym() 298 character(l) :: result_depends_on_equiv_sym 299 call set_result_with_some_value(result_depends_on_equiv_sym) 300 end function 301end module 302 303! CHECK-LABEL: func @_QPtest_result_depends_on_equiv_sym 304subroutine test_result_depends_on_equiv_sym() 305 use m_with_equiv, only : result_depends_on_equiv_sym 306 ! CHECK: %[[equiv:.*]] = fir.address_of(@_QMm_with_equivEarray) : !fir.ref<!fir.array<24xi8>> 307 ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[equiv]], %c{{.*}} : (!fir.ref<!fir.array<24xi8>>, index) -> !fir.ref<i8> 308 ! CHECK: %[[l:.*]] = fir.convert %[[coor]] : (!fir.ref<i8>) -> !fir.ptr<i64> 309 ! CHECK: %[[load:.*]] = fir.load %[[l]] : !fir.ptr<i64> 310 ! CHECK: %[[lcast:.*]] = fir.convert %[[load]] : (i64) -> index 311 ! CHECK: fir.alloca !fir.char<1,?>(%[[lcast]] : index) 312 print *, result_depends_on_equiv_sym() 313end subroutine 314 315! CHECK-LABEL: func @_QPtest_depends_on_descriptor( 316! CHECK-SAME: %[[x:.*]]: !fir.box<!fir.array<?xf32>>{{.*}}) { 317subroutine test_depends_on_descriptor(x) 318 interface 319 function depends_on_descriptor(x) 320 real :: x(:) 321 character(size(x,1, KIND=8)) :: depends_on_descriptor 322 end function 323 end interface 324 real :: x(:) 325 ! CHECK: %[[dims:.*]]:3 = fir.box_dims %arg0, %c0 : (!fir.box<!fir.array<?xf32>>, index) -> (index, index, index) 326 ! CHECK: %[[extentCast:.*]] = fir.convert %[[dims]]#1 : (index) -> i64 327 ! CHECK: %[[extent:.*]] = fir.convert %[[extentCast]] : (i64) -> index 328 ! CHECK: fir.alloca !fir.char<1,?>(%[[extent]] : index) 329 print *, depends_on_descriptor(x) 330end subroutine 331 332! CHECK-LABEL: func @_QPtest_symbol_indirection( 333! CHECK-SAME: %[[n:.*]]: !fir.ref<i64>{{.*}}) { 334subroutine test_symbol_indirection(n) 335 interface 336 function symbol_indirection(c, n) 337 integer(8) :: n 338 character(n) :: c 339 character(len(c, KIND=8)) :: symbol_indirection 340 end function 341 end interface 342 integer(8) :: n 343 character(n) :: c 344 ! CHECK: BeginExternalListOutput 345 ! CHECK: %[[nload:.*]] = fir.load %[[n]] : !fir.ref<i64> 346 ! CHECK: %[[n_is_positive:.*]] = arith.cmpi sgt, %[[nload]], %c0{{.*}} : i64 347 ! CHECK: %[[len:.*]] = arith.select %[[n_is_positive]], %[[nload]], %c0{{.*}} : i64 348 ! CHECK: %[[len_cast:.*]] = fir.convert %[[len]] : (i64) -> index 349 ! CHECK: fir.alloca !fir.char<1,?>(%[[len_cast]] : index) 350 print *, symbol_indirection(c, n) 351end subroutine 352 353! CHECK-LABEL: func @_QPtest_recursion( 354! CHECK-SAME: %[[res:.*]]: !fir.ref<!fir.char<1,?>>{{.*}}, %[[resLen:.*]]: index{{.*}}, %[[n:.*]]: !fir.ref<i64>{{.*}}) -> !fir.boxchar<1> { 355function test_recursion(n) result(res) 356 integer(8) :: n 357 character(n) :: res 358 ! some_local is here to verify that local symbols that are visible in the 359 ! function interface are not instantiated by accident (that only the 360 ! symbols needed for the result are instantiated before the call). 361 ! CHECK: fir.alloca !fir.array<?xi32>, {{.*}}some_local 362 ! CHECK-NOT: fir.alloca !fir.array<?xi32> 363 integer :: some_local(n) 364 some_local(0) = n + 64 365 if (n.eq.1) then 366 res = char(some_local(0)) 367 ! CHECK: else 368 else 369 ! CHECK-NOT: fir.alloca !fir.array<?xi32> 370 371 ! verify that the actual argument for symbol n ("n-1") is used to allocate 372 ! the result, and not the local value of symbol n. 373 374 ! CHECK: %[[nLoad:.*]] = fir.load %[[n]] : !fir.ref<i64> 375 ! CHECK: %[[sub:.*]] = arith.subi %[[nLoad]], %c1{{.*}} : i64 376 ! CHECK: fir.store %[[sub]] to %[[nInCall:.*]] : !fir.ref<i64> 377 378 ! CHECK-NOT: fir.alloca !fir.array<?xi32> 379 380 ! CHECK: %[[nInCallLoad:.*]] = fir.load %[[nInCall]] : !fir.ref<i64> 381 ! CHECK: %[[nInCallCast:.*]] = fir.convert %[[nInCallLoad]] : (i64) -> index 382 ! CHECK: %[[tmp:.*]] = fir.alloca !fir.char<1,?>(%[[nInCallCast]] : index) 383 384 ! CHECK-NOT: fir.alloca !fir.array<?xi32> 385 ! CHECK: fir.call @_QPtest_recursion(%[[tmp]], {{.*}} 386 res = char(some_local(0)) // test_recursion(n-1) 387 388 ! Verify that symbol n was not remapped to the actual argument passed 389 ! to n in the call (that the temporary mapping was cleaned-up). 390 391 ! CHECK: %[[nLoad2:.*]] = fir.load %[[n]] : !fir.ref<i64> 392 ! CHECK: OutputInteger64(%{{.*}}, %[[nLoad2]]) 393 print *, n 394 end if 395end function 396 397! Test call to character function for which only the result type is explicit 398! CHECK-LABEL:func @_QPtest_not_entirely_explicit_interface( 399! CHECK-SAME: %[[n_arg:.*]]: !fir.ref<i64>{{.*}}) { 400subroutine test_not_entirely_explicit_interface(n) 401 integer(8) :: n 402 character(n) :: return_dyn_char_2 403 print *, return_dyn_char_2(10) 404 ! CHECK: %[[n:.*]] = fir.load %[[n_arg]] : !fir.ref<i64> 405 ! CHECK: %[[len:.*]] = fir.convert %[[n]] : (i64) -> index 406 ! CHECK: %[[result:.*]] = fir.alloca !fir.char<1,?>(%[[len]] : index) {bindc_name = ".result"} 407 ! CHECK: fir.call @_QPreturn_dyn_char_2(%[[result]], %[[len]], %{{.*}}) : (!fir.ref<!fir.char<1,?>>, index, !fir.ref<i32>) -> !fir.boxchar<1> 408end subroutine 409