1! RUN: bbc -emit-fir -hlfir=false %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: %[[mcmpi:.*]] = arith.cmpi sgt, %[[mcast2]], %{{.*}} : index 190 ! CHECK-DAG: %[[mselect:.*]] = arith.select %[[mcmpi]], %[[mcast2]], %{{.*}} : index 191 ! CHECK-DAG: %[[nload:.*]] = fir.load %[[n]] : !fir.ref<i32> 192 ! CHECK-DAG: %[[ncast:.*]] = fir.convert %[[nload]] : (i32) -> i64 193 ! CHECK-DAG: %[[nsub:.*]] = arith.subi %[[ncast]], %c1{{.*}} : i64 194 ! CHECK-DAG: %[[nadd:.*]] = arith.addi %[[nsub]], %c1{{.*}} : i64 195 ! CHECK-DAG: %[[ncast2:.*]] = fir.convert %[[nadd]] : (i64) -> index 196 ! CHECK-DAG: %[[ncmpi:.*]] = arith.cmpi sgt, %[[ncast2]], %{{.*}} : index 197 ! CHECK-DAG: %[[nselect:.*]] = arith.select %[[ncmpi]], %[[ncast2]], %{{.*}} : index 198 ! CHECK: %[[shape:.*]] = fir.shape %[[mselect]], %[[nselect]] : (index, index) -> !fir.shape<2> 199 ! CHECK: %[[tmp:.*]] = fir.alloca !fir.array<?x?xf32>, %[[mselect]], %[[nselect]] 200 ! CHECK: %[[res:.*]] = fir.call @_QMcalleePreturn_dyn_array(%[[m]], %[[n]]) {{.*}}: (!fir.ref<i32>, !fir.ref<i32>) -> !fir.array<?x?xf32> 201 ! CHECK: fir.save_result %[[res]] to %[[tmp]](%[[shape]]) : !fir.array<?x?xf32>, !fir.ref<!fir.array<?x?xf32>>, !fir.shape<2> 202 print *, return_dyn_array(m, n) 203end subroutine 204 205! CHECK-LABEL: func @_QMcallerPdyn_char_cst_array( 206! CHECK-SAME: %[[l:.*]]: !fir.ref<i32>{{.*}}) { 207subroutine dyn_char_cst_array(l) 208 integer :: l 209 ! CHECK: %[[lload:.*]] = fir.load %[[l]] : !fir.ref<i32> 210 ! CHECK: %[[lcast:.*]] = fir.convert %[[lload]] : (i32) -> i64 211 ! CHECK: %[[lcast2:.*]] = fir.convert %[[lcast]] : (i64) -> index 212 ! CHECK: %[[cmpi:.*]] = arith.cmpi sgt, %[[lcast2]], %{{.*}} : index 213 ! CHECK: %[[select:.*]] = arith.select %[[cmpi]], %[[lcast2]], %{{.*}} : index 214 ! CHECK: %[[shape:.*]] = fir.shape %{{.*}}, %{{.*}} : (index, index) -> !fir.shape<2> 215 ! CHECK: %[[tmp:.*]] = fir.alloca !fir.array<20x30x!fir.char<1,?>>(%[[select]] : index) 216 ! CHECK: %[[res:.*]] = fir.call @_QMcalleePreturn_dyn_char_cst_array(%[[l]]) {{.*}}: (!fir.ref<i32>) -> !fir.array<20x30x!fir.char<1,?>> 217 ! CHECK: fir.save_result %[[res]] to %[[tmp]](%[[shape]]) typeparams %[[select]] : !fir.array<20x30x!fir.char<1,?>>, !fir.ref<!fir.array<20x30x!fir.char<1,?>>>, !fir.shape<2>, index 218 print *, return_dyn_char_cst_array(l) 219end subroutine 220 221! CHECK-LABEL: func @_QMcallerPcst_char_dyn_array( 222! CHECK-SAME: %[[m:.*]]: !fir.ref<i32>{{.*}}, %[[n:.*]]: !fir.ref<i32>{{.*}}) { 223subroutine cst_char_dyn_array(m, n) 224 integer :: m, n 225 ! CHECK-DAG: %[[mload:.*]] = fir.load %[[m]] : !fir.ref<i32> 226 ! CHECK-DAG: %[[mcast:.*]] = fir.convert %[[mload]] : (i32) -> i64 227 ! CHECK-DAG: %[[msub:.*]] = arith.subi %[[mcast]], %c1{{.*}} : i64 228 ! CHECK-DAG: %[[madd:.*]] = arith.addi %[[msub]], %c1{{.*}} : i64 229 ! CHECK-DAG: %[[mcast2:.*]] = fir.convert %[[madd]] : (i64) -> index 230 ! CHECK-DAG: %[[mcmpi:.*]] = arith.cmpi sgt, %[[mcast2]], %{{.*}} : index 231 ! CHECK-DAG: %[[mselect:.*]] = arith.select %[[mcmpi]], %[[mcast2]], %{{.*}} : index 232 ! CHECK-DAG: %[[nload:.*]] = fir.load %[[n]] : !fir.ref<i32> 233 ! CHECK-DAG: %[[ncast:.*]] = fir.convert %[[nload]] : (i32) -> i64 234 ! CHECK-DAG: %[[nsub:.*]] = arith.subi %[[ncast]], %c1{{.*}} : i64 235 ! CHECK-DAG: %[[nadd:.*]] = arith.addi %[[nsub]], %c1{{.*}} : i64 236 ! CHECK-DAG: %[[ncast2:.*]] = fir.convert %[[nadd]] : (i64) -> index 237 ! CHECK-DAG: %[[ncmpi:.*]] = arith.cmpi sgt, %[[ncast2]], %{{.*}} : index 238 ! CHECK-DAG: %[[nselect:.*]] = arith.select %[[ncmpi]], %[[ncast2]], %{{.*}} : index 239 ! CHECK: %[[shape:.*]] = fir.shape %[[mselect]], %[[nselect]] : (index, index) -> !fir.shape<2> 240 ! CHECK: %[[tmp:.*]] = fir.alloca !fir.array<?x?x!fir.char<1,10>>, %[[mselect]], %[[nselect]] 241 ! 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>> 242 ! 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 243 print *, return_cst_char_dyn_array(m, n) 244end subroutine 245 246! CHECK-LABEL: func @_QMcallerPdyn_char_dyn_array( 247! CHECK-SAME: %[[l:.*]]: !fir.ref<i32>{{.*}}, %[[m:.*]]: !fir.ref<i32>{{.*}}, %[[n:.*]]: !fir.ref<i32>{{.*}}) { 248subroutine dyn_char_dyn_array(l, m, n) 249 ! CHECK-DAG: %[[mload:.*]] = fir.load %[[m]] : !fir.ref<i32> 250 ! CHECK-DAG: %[[mcast:.*]] = fir.convert %[[mload]] : (i32) -> i64 251 ! CHECK-DAG: %[[msub:.*]] = arith.subi %[[mcast]], %c1{{.*}} : i64 252 ! CHECK-DAG: %[[madd:.*]] = arith.addi %[[msub]], %c1{{.*}} : i64 253 ! CHECK-DAG: %[[mcast2:.*]] = fir.convert %[[madd]] : (i64) -> index 254 ! CHECK-DAG: %[[mcmpi:.*]] = arith.cmpi sgt, %[[mcast2]], %{{.*}} : index 255 ! CHECK-DAG: %[[mselect:.*]] = arith.select %[[mcmpi]], %[[mcast2]], %{{.*}} : index 256 257 ! CHECK-DAG: %[[nload:.*]] = fir.load %[[n]] : !fir.ref<i32> 258 ! CHECK-DAG: %[[ncast:.*]] = fir.convert %[[nload]] : (i32) -> i64 259 ! CHECK-DAG: %[[nsub:.*]] = arith.subi %[[ncast]], %c1{{.*}} : i64 260 ! CHECK-DAG: %[[nadd:.*]] = arith.addi %[[nsub]], %c1{{.*}} : i64 261 ! CHECK-DAG: %[[ncast2:.*]] = fir.convert %[[nadd]] : (i64) -> index 262 ! CHECK-DAG: %[[ncmpi:.*]] = arith.cmpi sgt, %[[ncast2]], %{{.*}} : index 263 ! CHECK-DAG: %[[nselect:.*]] = arith.select %[[ncmpi]], %[[ncast2]], %{{.*}} : index 264 265 ! CHECK-DAG: %[[lload:.*]] = fir.load %[[l]] : !fir.ref<i32> 266 ! CHECK-DAG: %[[lcast:.*]] = fir.convert %[[lload]] : (i32) -> i64 267 ! CHECK-DAG: %[[lcast2:.*]] = fir.convert %[[lcast]] : (i64) -> index 268 ! CHECK-DAG: %[[lcmpi:.*]] = arith.cmpi sgt, %[[lcast2]], %{{.*}} : index 269 ! CHECK-DAG: %[[lselect:.*]] = arith.select %[[lcmpi]], %[[lcast2]], %{{.*}} : index 270 ! CHECK: %[[shape:.*]] = fir.shape %[[mselect]], %[[nselect]] : (index, index) -> !fir.shape<2> 271 ! CHECK: %[[tmp:.*]] = fir.alloca !fir.array<?x?x!fir.char<1,?>>(%[[lselect]] : index), %[[mselect]], %[[nselect]] 272 ! 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,?>> 273 ! 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 274 integer :: l, m, n 275 print *, return_dyn_char_dyn_array(l, m, n) 276end subroutine 277 278! CHECK-LABEL: @_QMcallerPdyn_char_alloc 279subroutine dyn_char_alloc(l) 280 integer :: l 281 ! CHECK: %[[alloc:.*]] = fir.alloca !fir.box<!fir.heap<!fir.array<?x!fir.char<1,?>>>> {{{.*}}bindc_name = ".result"} 282 ! CHECK: %[[res:.*]] = fir.call @_QMcalleePreturn_dyn_char_alloc({{.*}}) {{.*}}: (!fir.ref<i32>) -> !fir.box<!fir.heap<!fir.array<?x!fir.char<1,?>>>> 283 ! 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,?>>>>> 284 print *, return_dyn_char_alloc(l) 285 ! CHECK: _FortranAioOutputDescriptor 286 ! CHECK: %[[load:.*]] = fir.load %[[alloc]] : !fir.ref<!fir.box<!fir.heap<!fir.array<?x!fir.char<1,?>>>>> 287 ! CHECK: %[[addr:.*]] = fir.box_addr %[[load]] : (!fir.box<!fir.heap<!fir.array<?x!fir.char<1,?>>>>) -> !fir.heap<!fir.array<?x!fir.char<1,?>>> 288 ! CHECK: %[[cmpi:.*]] = arith.cmpi 289 ! CHECK: fir.if %[[cmpi]] 290 ! CHECK: fir.freemem %[[addr]] : !fir.heap<!fir.array<?x!fir.char<1,?>>> 291end subroutine 292 293! CHECK-LABEL: @_QMcallerPdyn_char_pointer 294subroutine dyn_char_pointer(l) 295 integer :: l 296 ! CHECK: %[[alloc:.*]] = fir.alloca !fir.box<!fir.ptr<!fir.array<?x!fir.char<1,?>>>> {{{.*}}bindc_name = ".result"} 297 ! CHECK: %[[res:.*]] = fir.call @_QMcalleePreturn_dyn_char_pointer({{.*}}) {{.*}}: (!fir.ref<i32>) -> !fir.box<!fir.ptr<!fir.array<?x!fir.char<1,?>>>> 298 ! 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,?>>>>> 299 print *, return_dyn_char_pointer(l) 300 ! CHECK-NOT: fir.freemem 301end subroutine 302 303end module 304 305 306! Test more complex symbol dependencies in the result specification expression 307 308module m_with_equiv 309 integer(8) :: l 310 integer(8) :: array(3) 311 equivalence (array(2), l) 312contains 313 function result_depends_on_equiv_sym() 314 character(l) :: result_depends_on_equiv_sym 315 call set_result_with_some_value(result_depends_on_equiv_sym) 316 end function 317end module 318 319! CHECK-LABEL: func @_QPtest_result_depends_on_equiv_sym 320subroutine test_result_depends_on_equiv_sym() 321 use m_with_equiv, only : result_depends_on_equiv_sym 322 ! CHECK: %[[equiv:.*]] = fir.address_of(@_QMm_with_equivEarray) : !fir.ref<!fir.array<24xi8>> 323 ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[equiv]], %c{{.*}} : (!fir.ref<!fir.array<24xi8>>, index) -> !fir.ref<i8> 324 ! CHECK: %[[l:.*]] = fir.convert %[[coor]] : (!fir.ref<i8>) -> !fir.ptr<i64> 325 ! CHECK: %[[load:.*]] = fir.load %[[l]] : !fir.ptr<i64> 326 ! CHECK: %[[lcast:.*]] = fir.convert %[[load]] : (i64) -> index 327 ! CHECK: %[[cmpi:.*]] = arith.cmpi sgt, %[[lcast]], %{{.*}} : index 328 ! CHECK: %[[select:.*]] = arith.select %[[cmpi]], %[[lcast]], %{{.*}} : index 329 ! CHECK: fir.alloca !fir.char<1,?>(%[[select]] : index) 330 print *, result_depends_on_equiv_sym() 331end subroutine 332 333! CHECK-LABEL: func @_QPtest_depends_on_descriptor( 334! CHECK-SAME: %[[x:.*]]: !fir.box<!fir.array<?xf32>>{{.*}}) { 335subroutine test_depends_on_descriptor(x) 336 interface 337 function depends_on_descriptor(x) 338 real :: x(:) 339 character(size(x,1, KIND=8)) :: depends_on_descriptor 340 end function 341 end interface 342 real :: x(:) 343 ! CHECK: %[[dims:.*]]:3 = fir.box_dims %arg0, %c0 : (!fir.box<!fir.array<?xf32>>, index) -> (index, index, index) 344 ! CHECK: %[[extentCast:.*]] = fir.convert %[[dims]]#1 : (index) -> i64 345 ! CHECK: %[[extent:.*]] = fir.convert %[[extentCast]] : (i64) -> index 346 ! CHECK: %[[cmpi:.*]] = arith.cmpi sgt, %[[extent]], %{{.*}} : index 347 ! CHECK: %[[select:.*]] = arith.select %[[cmpi]], %[[extent]], %{{.*}} : index 348 ! CHECK: fir.alloca !fir.char<1,?>(%[[select]] : index) 349 print *, depends_on_descriptor(x) 350end subroutine 351 352! CHECK-LABEL: func @_QPtest_symbol_indirection( 353! CHECK-SAME: %[[n:.*]]: !fir.ref<i64>{{.*}}) { 354subroutine test_symbol_indirection(n) 355 interface 356 function symbol_indirection(c, n) 357 integer(8) :: n 358 character(n) :: c 359 character(len(c, KIND=8)) :: symbol_indirection 360 end function 361 end interface 362 integer(8) :: n 363 character(n) :: c 364 ! CHECK: BeginExternalListOutput 365 ! CHECK: %[[nload:.*]] = fir.load %[[n]] : !fir.ref<i64> 366 ! CHECK: %[[n_is_positive:.*]] = arith.cmpi sgt, %[[nload]], %c0{{.*}} : i64 367 ! CHECK: %[[len:.*]] = arith.select %[[n_is_positive]], %[[nload]], %c0{{.*}} : i64 368 ! CHECK: %[[len_cast:.*]] = fir.convert %[[len]] : (i64) -> index 369 ! CHECK: %[[cmpi:.*]] = arith.cmpi sgt, %[[len_cast]], %{{.*}} : index 370 ! CHECK: %[[select:.*]] = arith.select %[[cmpi]], %[[len_cast]], %{{.*}} : index 371 ! CHECK: fir.alloca !fir.char<1,?>(%[[select]] : index) 372 print *, symbol_indirection(c, n) 373end subroutine 374 375! CHECK-LABEL: func @_QPtest_recursion( 376! CHECK-SAME: %[[res:.*]]: !fir.ref<!fir.char<1,?>>{{.*}}, %[[resLen:.*]]: index{{.*}}, %[[n:.*]]: !fir.ref<i64>{{.*}}) -> !fir.boxchar<1> { 377function test_recursion(n) result(res) 378 integer(8) :: n 379 character(n) :: res 380 ! some_local is here to verify that local symbols that are visible in the 381 ! function interface are not instantiated by accident (that only the 382 ! symbols needed for the result are instantiated before the call). 383 ! CHECK: fir.alloca !fir.array<?xi32>, {{.*}}some_local 384 ! CHECK-NOT: fir.alloca !fir.array<?xi32> 385 integer :: some_local(n) 386 some_local(1) = n + 64 387 if (n.eq.1) then 388 res = char(some_local(1)) 389 ! CHECK: else 390 else 391 ! CHECK-NOT: fir.alloca !fir.array<?xi32> 392 393 ! verify that the actual argument for symbol n ("n-1") is used to allocate 394 ! the result, and not the local value of symbol n. 395 396 ! CHECK: %[[nLoad:.*]] = fir.load %[[n]] : !fir.ref<i64> 397 ! CHECK: %[[sub:.*]] = arith.subi %[[nLoad]], %c1{{.*}} : i64 398 ! CHECK: fir.store %[[sub]] to %[[nInCall:.*]] : !fir.ref<i64> 399 400 ! CHECK-NOT: fir.alloca !fir.array<?xi32> 401 402 ! CHECK: %[[nInCallLoad:.*]] = fir.load %[[nInCall]] : !fir.ref<i64> 403 ! CHECK: %[[nInCallCast:.*]] = fir.convert %[[nInCallLoad]] : (i64) -> index 404 ! CHECK: %[[cmpi:.*]] = arith.cmpi sgt, %[[nInCallCast]], %{{.*}} : index 405 ! CHECK: %[[select:.*]] = arith.select %[[cmpi]], %[[nInCallCast]], %{{.*}} : index 406 ! CHECK: %[[tmp:.*]] = fir.alloca !fir.char<1,?>(%[[select]] : index) 407 408 ! CHECK-NOT: fir.alloca !fir.array<?xi32> 409 ! CHECK: fir.call @_QPtest_recursion(%[[tmp]], {{.*}} 410 res = char(some_local(1)) // test_recursion(n-1) 411 412 ! Verify that symbol n was not remapped to the actual argument passed 413 ! to n in the call (that the temporary mapping was cleaned-up). 414 415 ! CHECK: %[[nLoad2:.*]] = fir.load %[[n]] : !fir.ref<i64> 416 ! CHECK: OutputInteger64(%{{.*}}, %[[nLoad2]]) 417 print *, n 418 end if 419end function 420 421! Test call to character function for which only the result type is explicit 422! CHECK-LABEL:func @_QPtest_not_entirely_explicit_interface( 423! CHECK-SAME: %[[n_arg:.*]]: !fir.ref<i64>{{.*}}) { 424subroutine test_not_entirely_explicit_interface(n) 425 integer(8) :: n 426 character(n) :: return_dyn_char_2 427 print *, return_dyn_char_2(10) 428 ! CHECK: %[[n:.*]] = fir.load %[[n_arg]] : !fir.ref<i64> 429 ! CHECK: %[[len:.*]] = fir.convert %[[n]] : (i64) -> index 430 ! CHECK: %[[cmpi:.*]] = arith.cmpi sgt, %[[len]], %{{.*}} : index 431 ! CHECK: %[[select:.*]] = arith.select %[[cmpi]], %[[len]], %{{.*}} : index 432 ! CHECK: %[[result:.*]] = fir.alloca !fir.char<1,?>(%[[select]] : index) {bindc_name = ".result"} 433 ! CHECK: fir.call @_QPreturn_dyn_char_2(%[[result]], %[[select]], %{{.*}}) {{.*}}: (!fir.ref<!fir.char<1,?>>, index, !fir.ref<i32>) -> !fir.boxchar<1> 434end subroutine 435