1! Test lowering of intrinsic assignments to HLFIR 2! RUN: bbc -emit-hlfir -o - %s 2>&1 | FileCheck %s 3 4! ----------------------------------------------------------------------------- 5! Test assignments with scalar variable LHS and RHS 6! ----------------------------------------------------------------------------- 7 8subroutine scalar_int(x, y) 9 integer :: x, y 10 x = y 11end subroutine 12! CHECK-LABEL: func.func @_QPscalar_int( 13! CHECK: %[[VAL_2:.*]]:2 = hlfir.declare {{.*}} {uniq_name = "_QFscalar_intEx"} : (!fir.ref<i32>, !fir.dscope) -> (!fir.ref<i32>, !fir.ref<i32>) 14! CHECK: %[[VAL_3:.*]]:2 = hlfir.declare {{.*}} {uniq_name = "_QFscalar_intEy"} : (!fir.ref<i32>, !fir.dscope) -> (!fir.ref<i32>, !fir.ref<i32>) 15! CHECK: %[[VAL_4:.*]] = fir.load %[[VAL_3]]#0 16! CHECK: hlfir.assign %[[VAL_4]] to %[[VAL_2]]#0 : i32, !fir.ref<i32> 17 18subroutine scalar_logical(x, y) 19 logical :: x, y 20 x = y 21end subroutine 22! CHECK-LABEL: func.func @_QPscalar_logical( 23! CHECK: %[[VAL_2:.*]]:2 = hlfir.declare {{.*}} {uniq_name = "_QFscalar_logicalEx"} : (!fir.ref<!fir.logical<4>>, !fir.dscope) -> (!fir.ref<!fir.logical<4>>, !fir.ref<!fir.logical<4>>) 24! CHECK: %[[VAL_3:.*]]:2 = hlfir.declare {{.*}} {uniq_name = "_QFscalar_logicalEy"} : (!fir.ref<!fir.logical<4>>, !fir.dscope) -> (!fir.ref<!fir.logical<4>>, !fir.ref<!fir.logical<4>>) 25! CHECK: %[[VAL_4:.*]] = fir.load %[[VAL_3]]#0 26! CHECK: hlfir.assign %[[VAL_4]] to %[[VAL_2]]#0 : !fir.logical<4>, !fir.ref<!fir.logical<4>> 27 28subroutine scalar_real(x, y) 29 real :: x, y 30 x = y 31end subroutine 32! CHECK-LABEL: func.func @_QPscalar_real( 33! CHECK: %[[VAL_2:.*]]:2 = hlfir.declare {{.*}} {uniq_name = "_QFscalar_realEx"} : (!fir.ref<f32>, !fir.dscope) -> (!fir.ref<f32>, !fir.ref<f32>) 34! CHECK: %[[VAL_3:.*]]:2 = hlfir.declare {{.*}} {uniq_name = "_QFscalar_realEy"} : (!fir.ref<f32>, !fir.dscope) -> (!fir.ref<f32>, !fir.ref<f32>) 35! CHECK: %[[VAL_4:.*]] = fir.load %[[VAL_3]]#0 36! CHECK: hlfir.assign %[[VAL_4]] to %[[VAL_2]]#0 : f32, !fir.ref<f32> 37 38subroutine scalar_complex(x, y) 39 complex :: x, y 40 x = y 41end subroutine 42! CHECK-LABEL: func.func @_QPscalar_complex( 43! CHECK: %[[VAL_2:.*]]:2 = hlfir.declare {{.*}} {uniq_name = "_QFscalar_complexEx"} : (!fir.ref<complex<f32>>, !fir.dscope) -> (!fir.ref<complex<f32>>, !fir.ref<complex<f32>>) 44! CHECK: %[[VAL_3:.*]]:2 = hlfir.declare {{.*}} {uniq_name = "_QFscalar_complexEy"} : (!fir.ref<complex<f32>>, !fir.dscope) -> (!fir.ref<complex<f32>>, !fir.ref<complex<f32>>) 45! CHECK: %[[VAL_4:.*]] = fir.load %[[VAL_3]]#0 46! CHECK: hlfir.assign %[[VAL_4]] to %[[VAL_2]]#0 : complex<f32>, !fir.ref<complex<f32>> 47 48subroutine scalar_character(x, y) 49 character(*) :: x, y 50 x = y 51end subroutine 52! CHECK-LABEL: func.func @_QPscalar_character( 53! CHECK: %[[VAL_3:.*]]:2 = hlfir.declare {{.*}} {uniq_name = "_QFscalar_characterEx"} : (!fir.ref<!fir.char<1,?>>, index, !fir.dscope) -> (!fir.boxchar<1>, !fir.ref<!fir.char<1,?>>) 54! CHECK: %[[VAL_5:.*]]:2 = hlfir.declare {{.*}} {uniq_name = "_QFscalar_characterEy"} : (!fir.ref<!fir.char<1,?>>, index, !fir.dscope) -> (!fir.boxchar<1>, !fir.ref<!fir.char<1,?>>) 55! CHECK: hlfir.assign %[[VAL_5]]#0 to %[[VAL_3]]#0 : !fir.boxchar<1>, !fir.boxchar<1> 56 57! ----------------------------------------------------------------------------- 58! Test assignments with scalar variable LHS and expression RHS 59! ----------------------------------------------------------------------------- 60 61subroutine scalar_int_2(x) 62 integer :: x 63 x = 42 64end subroutine 65! CHECK-LABEL: func.func @_QPscalar_int_2( 66! CHECK: %[[VAL_1:.*]]:2 = hlfir.declare {{.*}} {uniq_name = "_QFscalar_int_2Ex"} : (!fir.ref<i32>, !fir.dscope) -> (!fir.ref<i32>, !fir.ref<i32>) 67! CHECK: %[[VAL_2:.*]] = arith.constant 42 : i32 68! CHECK: hlfir.assign %[[VAL_2]] to %[[VAL_1]]#0 : i32, !fir.ref<i32> 69 70subroutine scalar_logical_2(x) 71 logical :: x 72 x = .true. 73end subroutine 74! CHECK-LABEL: func.func @_QPscalar_logical_2( 75! CHECK: %[[VAL_1:.*]]:2 = hlfir.declare {{.*}} {uniq_name = "_QFscalar_logical_2Ex"} : (!fir.ref<!fir.logical<4>>, !fir.dscope) -> (!fir.ref<!fir.logical<4>>, !fir.ref<!fir.logical<4>>) 76! CHECK: %[[VAL_2:.*]] = arith.constant true 77! CHECK: %[[VAL_3:.*]] = fir.convert %[[VAL_2]] : (i1) -> !fir.logical<4> 78! CHECK: hlfir.assign %[[VAL_3]] to %[[VAL_1]]#0 : !fir.logical<4>, !fir.ref<!fir.logical<4>> 79 80subroutine scalar_real_2(x) 81 real :: x 82 x = 3.14 83end subroutine 84! CHECK-LABEL: func.func @_QPscalar_real_2( 85! CHECK: %[[VAL_1:.*]]:2 = hlfir.declare {{.*}} {uniq_name = "_QFscalar_real_2Ex"} : (!fir.ref<f32>, !fir.dscope) -> (!fir.ref<f32>, !fir.ref<f32>) 86! CHECK: %[[VAL_2:.*]] = arith.constant 3.140000e+00 : f32 87! CHECK: hlfir.assign %[[VAL_2]] to %[[VAL_1]]#0 : f32, !fir.ref<f32> 88 89subroutine scalar_complex_2(x) 90 complex :: x 91 x = (1., -1.) 92end subroutine 93! CHECK-LABEL: func.func @_QPscalar_complex_2( 94! CHECK: %[[VAL_1:.*]]:2 = hlfir.declare {{.*}} {uniq_name = "_QFscalar_complex_2Ex"} : (!fir.ref<complex<f32>>, !fir.dscope) -> (!fir.ref<complex<f32>>, !fir.ref<complex<f32>>) 95! CHECK: %[[VAL_2:.*]] = arith.constant 1.000000e+00 : f32 96! CHECK: %[[VAL_3:.*]] = arith.constant -1.000000e+00 : f32 97! CHECK: %[[VAL_4:.*]] = fir.undefined complex<f32> 98! CHECK: %[[VAL_5:.*]] = fir.insert_value %[[VAL_4]], %[[VAL_2]], [0 : index] : (complex<f32>, f32) -> complex<f32> 99! CHECK: %[[VAL_6:.*]] = fir.insert_value %[[VAL_5]], %[[VAL_3]], [1 : index] : (complex<f32>, f32) -> complex<f32> 100! CHECK: hlfir.assign %[[VAL_6]] to %[[VAL_1]]#0 : complex<f32>, !fir.ref<complex<f32>> 101 102subroutine scalar_character_2(x) 103 character(*) :: x 104 x = "hello" 105end subroutine 106! CHECK-LABEL: func.func @_QPscalar_character_2( 107! CHECK: %[[VAL_2:.*]]:2 = hlfir.declare {{.*}} {uniq_name = "_QFscalar_character_2Ex"} : (!fir.ref<!fir.char<1,?>>, index, !fir.dscope) -> (!fir.boxchar<1>, !fir.ref<!fir.char<1,?>>) 108! CHECK: %[[VAL_5:.*]]:2 = hlfir.declare {{.*}} {fortran_attrs = #fir.var_attrs<parameter>, uniq_name = "_QQclX68656C6C6F"} : (!fir.ref<!fir.char<1,5>>, index) -> (!fir.ref<!fir.char<1,5>>, !fir.ref<!fir.char<1,5>>) 109! CHECK: hlfir.assign %[[VAL_5]]#0 to %[[VAL_2]]#0 : !fir.ref<!fir.char<1,5>>, !fir.boxchar<1> 110 111! ----------------------------------------------------------------------------- 112! Test assignments with array variable LHS and RHS 113! ----------------------------------------------------------------------------- 114 115subroutine array(x, y) 116 integer :: x(:), y(100) 117 x = y 118end subroutine 119! CHECK-LABEL: func.func @_QParray( 120! CHECK: %[[VAL_2:.*]]:2 = hlfir.declare {{.*}} {uniq_name = "_QFarrayEx"} : (!fir.box<!fir.array<?xi32>>, !fir.dscope) -> (!fir.box<!fir.array<?xi32>>, !fir.box<!fir.array<?xi32>>) 121! CHECK: %[[VAL_5:.*]]:2 = hlfir.declare {{.*}} {uniq_name = "_QFarrayEy"} : (!fir.ref<!fir.array<100xi32>>, !fir.shape<1>, !fir.dscope) -> (!fir.ref<!fir.array<100xi32>>, !fir.ref<!fir.array<100xi32>>) 122! CHECK: hlfir.assign %[[VAL_5]]#0 to %[[VAL_2]]#0 : !fir.ref<!fir.array<100xi32>>, !fir.box<!fir.array<?xi32>> 123 124subroutine array_lbs(x, y) 125 logical :: x(2:21), y(3:22) 126 x = y 127end subroutine 128! CHECK-LABEL: func.func @_QParray_lbs( 129! CHECK: %[[VAL_5:.*]]:2 = hlfir.declare {{.*}} {uniq_name = "_QFarray_lbsEx"} : (!fir.ref<!fir.array<20x!fir.logical<4>>>, !fir.shapeshift<1>, !fir.dscope) -> (!fir.box<!fir.array<20x!fir.logical<4>>>, !fir.ref<!fir.array<20x!fir.logical<4>>>) 130! CHECK: %[[VAL_9:.*]]:2 = hlfir.declare {{.*}} {uniq_name = "_QFarray_lbsEy"} : (!fir.ref<!fir.array<20x!fir.logical<4>>>, !fir.shapeshift<1>, !fir.dscope) -> (!fir.box<!fir.array<20x!fir.logical<4>>>, !fir.ref<!fir.array<20x!fir.logical<4>>>) 131! CHECK: hlfir.assign %[[VAL_9]]#0 to %[[VAL_5]]#0 : !fir.box<!fir.array<20x!fir.logical<4>>>, !fir.box<!fir.array<20x!fir.logical<4>>> 132 133 134subroutine array_character(x, y) 135 character(*) :: x(10), y(10) 136 x = y 137end subroutine 138! CHECK-LABEL: func.func @_QParray_character( 139! CHECK: %[[VAL_6:.*]]:2 = hlfir.declare {{.*}} {uniq_name = "_QFarray_characterEx"} : (!fir.ref<!fir.array<10x!fir.char<1,?>>>, !fir.shape<1>, index, !fir.dscope) -> (!fir.box<!fir.array<10x!fir.char<1,?>>>, !fir.ref<!fir.array<10x!fir.char<1,?>>>) 140! CHECK: %[[VAL_11:.*]]:2 = hlfir.declare {{.*}} {uniq_name = "_QFarray_characterEy"} : (!fir.ref<!fir.array<10x!fir.char<1,?>>>, !fir.shape<1>, index, !fir.dscope) -> (!fir.box<!fir.array<10x!fir.char<1,?>>>, !fir.ref<!fir.array<10x!fir.char<1,?>>>) 141! CHECK: hlfir.assign %[[VAL_11]]#0 to %[[VAL_6]]#0 : !fir.box<!fir.array<10x!fir.char<1,?>>>, !fir.box<!fir.array<10x!fir.char<1,?>>> 142 143subroutine array_pointer(x, y) 144 real, pointer :: x(:), y(:) 145 x = y 146end subroutine 147! CHECK-LABEL: func.func @_QParray_pointer( 148! CHECK: %[[VAL_1:.*]]:2 = hlfir.declare %{{.*}}Ex 149! CHECK: %[[VAL_2:.*]]:2 = hlfir.declare %{{.*}}Ey 150! CHECK: %[[VAL_3:.*]] = fir.load %[[VAL_2]]#0 : !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>> 151! CHECK: %[[VAL_4:.*]] = fir.load %[[VAL_1]]#0 : !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>> 152! CHECK: hlfir.assign %[[VAL_3]] to %[[VAL_4]] : !fir.box<!fir.ptr<!fir.array<?xf32>>>, !fir.box<!fir.ptr<!fir.array<?xf32>>> 153 154! ----------------------------------------------------------------------------- 155! Test assignments with array LHS and scalar RHS 156! ----------------------------------------------------------------------------- 157 158subroutine array_scalar(x, y) 159 integer :: x(100), y 160 x = y 161end subroutine 162! CHECK-LABEL: func.func @_QParray_scalar( 163! CHECK: %[[VAL_4:.*]]:2 = hlfir.declare {{.*}} {uniq_name = "_QFarray_scalarEx"} : (!fir.ref<!fir.array<100xi32>>, !fir.shape<1>, !fir.dscope) -> (!fir.ref<!fir.array<100xi32>>, !fir.ref<!fir.array<100xi32>>) 164! CHECK: %[[VAL_5:.*]]:2 = hlfir.declare {{.*}} {uniq_name = "_QFarray_scalarEy"} : (!fir.ref<i32>, !fir.dscope) -> (!fir.ref<i32>, !fir.ref<i32>) 165! CHECK: %[[VAL_6:.*]] = fir.load %[[VAL_5]]#0 166! CHECK: hlfir.assign %[[VAL_6]] to %[[VAL_4]]#0 : i32, !fir.ref<!fir.array<100xi32>> 167 168! ----------------------------------------------------------------------------- 169! Test assignments with whole allocatable LHS 170! ----------------------------------------------------------------------------- 171 172subroutine test_whole_allocatable_assignment(x, y) 173 integer, allocatable :: x(:) 174 integer :: y(:) 175 x = y 176end subroutine 177! CHECK-LABEL: func.func @_QPtest_whole_allocatable_assignment( 178! CHECK: %[[VAL_2:.*]]:2 = hlfir.declare {{.*}}Ex" 179! CHECK: %[[VAL_3:.*]]:2 = hlfir.declare {{.*}}Ey" 180! CHECK: hlfir.assign %[[VAL_3]]#0 to %[[VAL_2]]#0 realloc : !fir.box<!fir.array<?xi32>>, !fir.ref<!fir.box<!fir.heap<!fir.array<?xi32>>>> 181 182subroutine test_whole_allocatable_deferred_char(x, y) 183 character(:), allocatable :: x 184 character(*) :: y 185 x = y 186end subroutine 187! CHECK-LABEL: func.func @_QPtest_whole_allocatable_deferred_char( 188! CHECK: %[[VAL_2:.*]]:2 = hlfir.declare {{.*}}Ex" 189! CHECK: %[[VAL_4:.*]]:2 = hlfir.declare {{.*}}Ey" 190! CHECK: hlfir.assign %[[VAL_4]]#0 to %[[VAL_2]]#0 realloc : !fir.boxchar<1>, !fir.ref<!fir.box<!fir.heap<!fir.char<1,?>>>> 191 192subroutine test_whole_allocatable_assumed_char(x, y) 193 character(*), allocatable :: x 194 character(*) :: y 195 x = y 196end subroutine 197! CHECK-LABEL: func.func @_QPtest_whole_allocatable_assumed_char( 198! CHECK: %[[VAL_4:.*]]:2 = hlfir.declare {{.*}}Ex" 199! CHECK: %[[VAL_6:.*]]:2 = hlfir.declare {{.*}}Ey" 200! CHECK: hlfir.assign %[[VAL_6]]#0 to %[[VAL_4]]#0 realloc keep_lhs_len : !fir.boxchar<1>, !fir.ref<!fir.box<!fir.heap<!fir.char<1,?>>>> 201