178 lines · plain
1! RUN: bbc -emit-fir -hlfir=false %s -o - | FileCheck %s2 3! Test allocatable dummy argument on callee side4 5! CHECK-LABEL: func @_QPtest_scalar(6! CHECK-SAME: %[[arg0:.*]]: !fir.ref<!fir.box<!fir.heap<f32>>>{{.*}})7subroutine test_scalar(x)8 real, allocatable :: x9 10 print *, x11 ! 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 subroutine15 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 subroutine27 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 :: c32 external foo133 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,?>>>) -> index37 ! 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 subroutine40 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 :: c45 external foo146 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 subroutine52 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 :: n57 character(n), allocatable :: c58 external foo159 ! 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 : i3262 ! CHECK: %[[cmp:.*]] = arith.cmpi sgt, %[[raw_len]], %[[c0_i32]] : i3263 ! CHECK: %[[len:.*]] = arith.select %[[cmp]], %[[raw_len]], %[[c0_i32]] : i3264 n = n + 165 ! 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) -> index70 ! 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 subroutine73 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 foo179 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,?>>>>) -> index84 ! [...] address computation85 ! CHECK: %[[boxchar:.*]] = fir.emboxchar %{{.*}}, %[[len]] : (!fir.ref<!fir.char<1,?>>, index) -> !fir.boxchar<1>86 ! CHECK: fir.call @_QPfoo1(%[[boxchar]]) {{.*}}: (!fir.boxchar<1>) -> ()87end subroutine88 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 foo194 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 computation98 ! 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 subroutine101 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 :: n106 character(n), allocatable :: c(:)107 external foo1108 ! 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 : i32111 ! CHECK: %[[cmp:.*]] = arith.cmpi sgt, %[[raw_len]], %[[c0_i32]] : i32112 ! CHECK: %[[len:.*]] = arith.select %[[cmp]], %[[raw_len]], %[[c0_i32]] : i32113 n = n + 1114 ! 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 computation119 ! CHECK: fir.coordinate_of120 ! CHECK-DAG: %[[len_cast:.*]] = fir.convert %[[len]] : (i32) -> index121 ! 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 subroutine124 125! Check that when reading allocatable length from descriptor, the width is taking126! 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 :: c132 external foo2133 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,?>>>) -> index137 ! CHECK-DAG: %[[len:.*]] = arith.divsi %[[size]], %c2{{.*}} : index138 ! 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 subroutine141 142! Check that assumed length character allocatables are reading the length from143! 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 :: n149 character(len=*), allocatable :: a150 ! 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,?>>>) -> index152 153 n = len(a)154 ! CHECK: %[[argLenCast:.*]] = fir.convert %[[argLen]] : (index) -> i32155 ! CHECK: fir.store %[[argLenCast]] to %{{.*}} : !fir.ref<i32>156end subroutine157 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 :: n162 character(len=*), allocatable, optional :: a163 ! CHECK: %[[argPresent:.*]] = fir.is_present %[[arg0]] : (!fir.ref<!fir.box<!fir.heap<!fir.char<1,?>>>>) -> i1164 ! 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,?>>>) -> index167 ! CHECK: fir.result %[[argEleSz]] : index168 ! CHECK: } else {169 ! CHECK: %[[undef:.*]] = fir.undefined index170 ! CHECK: fir.result %[[undef]] : index171 172 if (present(a)) then173 n = len(a)174 ! CHECK: %[[argLenCast:.*]] = fir.convert %[[argLen]] : (index) -> i32175 ! CHECK: fir.store %[[argLenCast]] to %{{.*}} : !fir.ref<i32>176 endif177end subroutine178