1! RUN: bbc -emit-fir -hlfir=false %s -o - | FileCheck %s 2 3! Test allocatable dummy argument on callee side 4 5! CHECK-LABEL: func @_QPtest_scalar( 6! CHECK-SAME: %[[arg0:.*]]: !fir.ref<!fir.box<!fir.heap<f32>>>{{.*}}) 7subroutine test_scalar(x) 8 real, allocatable :: x 9 10 print *, x 11 ! CHECK: %[[box:.*]] = fir.load %[[arg0]] : !fir.ref<!fir.box<!fir.heap<f32>>> 12 ! CHECK: %[[addr:.*]] = fir.box_addr %[[box]] : (!fir.box<!fir.heap<f32>>) -> !fir.heap<f32> 13 ! CHECK: %[[val:.*]] = fir.load %[[addr]] : !fir.heap<f32> 14end subroutine 15 16! CHECK-LABEL: func @_QPtest_array( 17! CHECK-SAME: %[[arg0:.*]]: !fir.ref<!fir.box<!fir.heap<!fir.array<?x?xi32>>>>{{.*}}) 18subroutine test_array(x) 19 integer, allocatable :: x(:,:) 20 21 print *, x(1,2) 22 ! CHECK: %[[box:.*]] = fir.load %[[arg0]] : !fir.ref<!fir.box<!fir.heap<!fir.array<?x?xi32>>>> 23 ! CHECK-DAG: fir.box_addr %[[box]] : (!fir.box<!fir.heap<!fir.array<?x?xi32>>>) -> !fir.heap<!fir.array<?x?xi32>> 24 ! CHECK-DAG: fir.box_dims %[[box]], %c0{{.*}} : (!fir.box<!fir.heap<!fir.array<?x?xi32>>>, index) -> (index, index, index) 25 ! CHECK-DAG: fir.box_dims %[[box]], %c1{{.*}} : (!fir.box<!fir.heap<!fir.array<?x?xi32>>>, index) -> (index, index, index) 26end subroutine 27 28! CHECK-LABEL: func @_QPtest_char_scalar_deferred( 29! CHECK-SAME: %[[arg0:.*]]: !fir.ref<!fir.box<!fir.heap<!fir.char<1,?>>>>{{.*}}) 30subroutine test_char_scalar_deferred(c) 31 character(:), allocatable :: c 32 external foo1 33 call foo1(c) 34 ! CHECK: %[[box:.*]] = fir.load %[[arg0]] : !fir.ref<!fir.box<!fir.heap<!fir.char<1,?>>>> 35 ! CHECK-DAG: %[[addr:.*]] = fir.box_addr %[[box]] : (!fir.box<!fir.heap<!fir.char<1,?>>>) -> !fir.heap<!fir.char<1,?>> 36 ! CHECK-DAG: %[[len:.*]] = fir.box_elesize %[[box]] : (!fir.box<!fir.heap<!fir.char<1,?>>>) -> index 37 ! CHECK: %[[boxchar:.*]] = fir.emboxchar %[[addr]], %[[len]] : (!fir.heap<!fir.char<1,?>>, index) -> !fir.boxchar<1> 38 ! CHECK: fir.call @_QPfoo1(%[[boxchar]]) {{.*}}: (!fir.boxchar<1>) -> () 39end subroutine 40 41! CHECK-LABEL: func @_QPtest_char_scalar_explicit_cst( 42! CHECK-SAME: %[[arg0:.*]]: !fir.ref<!fir.box<!fir.heap<!fir.char<1,10>>>>{{.*}}) 43subroutine test_char_scalar_explicit_cst(c) 44 character(10), allocatable :: c 45 external foo1 46 call foo1(c) 47 ! CHECK: %[[box:.*]] = fir.load %[[arg0]] : !fir.ref<!fir.box<!fir.heap<!fir.char<1,10>>>> 48 ! CHECK-DAG: %[[addr:.*]] = fir.box_addr %[[box]] : (!fir.box<!fir.heap<!fir.char<1,10>>>) -> !fir.heap<!fir.char<1,10>> 49 ! CHECK: %[[boxchar:.*]] = fir.emboxchar %[[addr]], %c10{{.*}} : (!fir.heap<!fir.char<1,10>>, index) -> !fir.boxchar<1> 50 ! CHECK: fir.call @_QPfoo1(%[[boxchar]]) {{.*}}: (!fir.boxchar<1>) -> () 51end subroutine 52 53! CHECK-LABEL: func @_QPtest_char_scalar_explicit_dynamic( 54! CHECK-SAME: %[[arg0:.*]]: !fir.ref<!fir.box<!fir.heap<!fir.char<1,?>>>>{{.*}}, %[[arg1:.*]]: !fir.ref<i32>{{.*}}) 55subroutine test_char_scalar_explicit_dynamic(c, n) 56 integer :: n 57 character(n), allocatable :: c 58 external foo1 59 ! Check that the length expr was evaluated before the execution parts. 60 ! CHECK: %[[raw_len:.*]] = fir.load %arg1 : !fir.ref<i32> 61 ! CHECK: %[[c0_i32:.*]] = arith.constant 0 : i32 62 ! CHECK: %[[cmp:.*]] = arith.cmpi sgt, %[[raw_len]], %[[c0_i32]] : i32 63 ! CHECK: %[[len:.*]] = arith.select %[[cmp]], %[[raw_len]], %[[c0_i32]] : i32 64 n = n + 1 65 ! CHECK: fir.store {{.*}} to %arg1 : !fir.ref<i32> 66 call foo1(c) 67 ! CHECK: %[[box:.*]] = fir.load %[[arg0]] : !fir.ref<!fir.box<!fir.heap<!fir.char<1,?>>>> 68 ! CHECK-DAG: %[[addr:.*]] = fir.box_addr %[[box]] : (!fir.box<!fir.heap<!fir.char<1,?>>>) -> !fir.heap<!fir.char<1,?>> 69 ! CHECK-DAG: %[[len_cast:.*]] = fir.convert %[[len]] : (i32) -> index 70 ! CHECK: %[[boxchar:.*]] = fir.emboxchar %[[addr]], %[[len_cast]] : (!fir.heap<!fir.char<1,?>>, index) -> !fir.boxchar<1> 71 ! CHECK: fir.call @_QPfoo1(%[[boxchar]]) {{.*}}: (!fir.boxchar<1>) -> () 72end subroutine 73 74! CHECK-LABEL: func @_QPtest_char_array_deferred( 75! CHECK-SAME: %[[arg0:.*]]: !fir.ref<!fir.box<!fir.heap<!fir.array<?x!fir.char<1,?>>>>>{{.*}}) 76subroutine test_char_array_deferred(c) 77 character(:), allocatable :: c(:) 78 external foo1 79 call foo1(c(10)) 80 ! CHECK: %[[box:.*]] = fir.load %[[arg0]] : !fir.ref<!fir.box<!fir.heap<!fir.array<?x!fir.char<1,?>>>>> 81 ! CHECK-DAG: %[[addr:.*]] = fir.box_addr %[[box]] : (!fir.box<!fir.heap<!fir.array<?x!fir.char<1,?>>>>) -> !fir.heap<!fir.array<?x!fir.char<1,?>>> 82 ! CHECK-DAG: fir.box_dims %[[box]], %c0{{.*}} : (!fir.box<!fir.heap<!fir.array<?x!fir.char<1,?>>>>, index) -> (index, index, index) 83 ! CHECK-DAG: %[[len:.*]] = fir.box_elesize %[[box]] : (!fir.box<!fir.heap<!fir.array<?x!fir.char<1,?>>>>) -> index 84 ! [...] address computation 85 ! CHECK: %[[boxchar:.*]] = fir.emboxchar %{{.*}}, %[[len]] : (!fir.ref<!fir.char<1,?>>, index) -> !fir.boxchar<1> 86 ! CHECK: fir.call @_QPfoo1(%[[boxchar]]) {{.*}}: (!fir.boxchar<1>) -> () 87end subroutine 88 89! CHECK-LABEL: func @_QPtest_char_array_explicit_cst( 90! CHECK-SAME: %[[arg0:.*]]: !fir.ref<!fir.box<!fir.heap<!fir.array<?x!fir.char<1,10>>>>>{{.*}}) 91subroutine test_char_array_explicit_cst(c) 92 character(10), allocatable :: c(:) 93 external foo1 94 call foo1(c(3)) 95 ! CHECK: %[[box:.*]] = fir.load %[[arg0]] : !fir.ref<!fir.box<!fir.heap<!fir.array<?x!fir.char<1,10>>>>> 96 ! CHECK-DAG: %[[addr:.*]] = fir.box_addr %[[box]] : (!fir.box<!fir.heap<!fir.array<?x!fir.char<1,10>>>>) -> !fir.heap<!fir.array<?x!fir.char<1,10>>> 97 ! [...] address computation 98 ! CHECK: %[[boxchar:.*]] = fir.emboxchar %{{.*}}, %c10{{.*}} : (!fir.ref<!fir.char<1,10>>, index) -> !fir.boxchar<1> 99 ! CHECK: fir.call @_QPfoo1(%[[boxchar]]) {{.*}}: (!fir.boxchar<1>) -> () 100end subroutine 101 102! CHECK-LABEL: func @_QPtest_char_array_explicit_dynamic( 103! CHECK-SAME: %[[arg0:.*]]: !fir.ref<!fir.box<!fir.heap<!fir.array<?x!fir.char<1,?>>>>>{{.*}}, %[[arg1:.*]]: !fir.ref<i32>{{.*}}) 104subroutine test_char_array_explicit_dynamic(c, n) 105 integer :: n 106 character(n), allocatable :: c(:) 107 external foo1 108 ! Check that the length expr was evaluated before the execution parts. 109 ! CHECK: %[[raw_len:.*]] = fir.load %arg1 : !fir.ref<i32> 110 ! CHECK: %[[c0_i32:.*]] = arith.constant 0 : i32 111 ! CHECK: %[[cmp:.*]] = arith.cmpi sgt, %[[raw_len]], %[[c0_i32]] : i32 112 ! CHECK: %[[len:.*]] = arith.select %[[cmp]], %[[raw_len]], %[[c0_i32]] : i32 113 n = n + 1 114 ! CHECK: fir.store {{.*}} to %arg1 : !fir.ref<i32> 115 call foo1(c(1)) 116 ! CHECK: %[[box:.*]] = fir.load %[[arg0]] : !fir.ref<!fir.box<!fir.heap<!fir.array<?x!fir.char<1,?>>>>> 117 ! CHECK-DAG: %[[addr:.*]] = fir.box_addr %[[box]] : (!fir.box<!fir.heap<!fir.array<?x!fir.char<1,?>>>>) -> !fir.heap<!fir.array<?x!fir.char<1,?>>> 118 ! [...] address computation 119 ! CHECK: fir.coordinate_of 120 ! CHECK-DAG: %[[len_cast:.*]] = fir.convert %[[len]] : (i32) -> index 121 ! CHECK: %[[boxchar:.*]] = fir.emboxchar %{{.*}}, %[[len_cast]] : (!fir.ref<!fir.char<1,?>>, index) -> !fir.boxchar<1> 122 ! CHECK: fir.call @_QPfoo1(%[[boxchar]]) {{.*}}: (!fir.boxchar<1>) -> () 123end subroutine 124 125! Check that when reading allocatable length from descriptor, the width is taking 126! into account when the kind is not 1. 127 128! CHECK-LABEL: func @_QPtest_char_scalar_deferred_k2( 129! CHECK-SAME: %[[arg0:.*]]: !fir.ref<!fir.box<!fir.heap<!fir.char<2,?>>>>{{.*}}) 130subroutine test_char_scalar_deferred_k2(c) 131 character(kind=2, len=:), allocatable :: c 132 external foo2 133 call foo2(c) 134 ! CHECK: %[[box:.*]] = fir.load %[[arg0]] : !fir.ref<!fir.box<!fir.heap<!fir.char<2,?>>>> 135 ! CHECK-DAG: %[[addr:.*]] = fir.box_addr %[[box]] : (!fir.box<!fir.heap<!fir.char<2,?>>>) -> !fir.heap<!fir.char<2,?>> 136 ! CHECK-DAG: %[[size:.*]] = fir.box_elesize %[[box]] : (!fir.box<!fir.heap<!fir.char<2,?>>>) -> index 137 ! CHECK-DAG: %[[len:.*]] = arith.divsi %[[size]], %c2{{.*}} : index 138 ! CHECK: %[[boxchar:.*]] = fir.emboxchar %[[addr]], %[[len]] : (!fir.heap<!fir.char<2,?>>, index) -> !fir.boxchar<2> 139 ! CHECK: fir.call @_QPfoo2(%[[boxchar]]) {{.*}}: (!fir.boxchar<2>) -> () 140end subroutine 141 142! Check that assumed length character allocatables are reading the length from 143! the descriptor. 144 145! CHECK-LABEL: _QPtest_char_assumed( 146! CHECK-SAME: %[[arg0:.*]]: !fir.ref<!fir.box<!fir.heap<!fir.char<1,?>>>>{{.*}} 147subroutine test_char_assumed(a) 148 integer :: n 149 character(len=*), allocatable :: a 150 ! CHECK: %[[argLoad:.*]] = fir.load %[[arg0]] : !fir.ref<!fir.box<!fir.heap<!fir.char<1,?>>>> 151 ! CHECK: %[[argLen:.*]] = fir.box_elesize %[[argLoad]] : (!fir.box<!fir.heap<!fir.char<1,?>>>) -> index 152 153 n = len(a) 154 ! CHECK: %[[argLenCast:.*]] = fir.convert %[[argLen]] : (index) -> i32 155 ! CHECK: fir.store %[[argLenCast]] to %{{.*}} : !fir.ref<i32> 156end subroutine 157 158! CHECK-LABEL: _QPtest_char_assumed_optional( 159! CHECK-SAME: %[[arg0:.*]]: !fir.ref<!fir.box<!fir.heap<!fir.char<1,?>>>>{{.*}} 160subroutine test_char_assumed_optional(a) 161 integer :: n 162 character(len=*), allocatable, optional :: a 163 ! CHECK: %[[argPresent:.*]] = fir.is_present %[[arg0]] : (!fir.ref<!fir.box<!fir.heap<!fir.char<1,?>>>>) -> i1 164 ! CHECK: %[[argLen:.*]] = fir.if %[[argPresent]] -> (index) { 165 ! CHECK: %[[argLoad:.*]] = fir.load %[[arg0]] : !fir.ref<!fir.box<!fir.heap<!fir.char<1,?>>>> 166 ! CHECK: %[[argEleSz:.*]] = fir.box_elesize %[[argLoad]] : (!fir.box<!fir.heap<!fir.char<1,?>>>) -> index 167 ! CHECK: fir.result %[[argEleSz]] : index 168 ! CHECK: } else { 169 ! CHECK: %[[undef:.*]] = fir.undefined index 170 ! CHECK: fir.result %[[undef]] : index 171 172 if (present(a)) then 173 n = len(a) 174 ! CHECK: %[[argLenCast:.*]] = fir.convert %[[argLen]] : (index) -> i32 175 ! CHECK: fir.store %[[argLenCast]] to %{{.*}} : !fir.ref<i32> 176 endif 177end subroutine 178