1! RUN: bbc -emit-fir -hlfir=false %s -o - | FileCheck %s 2! RUN: bbc -emit-fir -hlfir=false -gen-array-coor %s -o - | FileCheck %s --check-prefix=ArrayCoorCHECK 3 4! Test that non-contiguous assumed-shape memory layout is handled in lowering. 5! In practice, test that input fir.box is propagated to fir operations 6 7! Also test that when the contiguous keyword is present, lowering adds the 8! attribute to the fir argument and that is takes the contiguity into account 9! In practice, test that the input fir.box is not propagated to fir operations. 10 11! CHECK-LABEL: func @_QPtest_element_ref(%arg0: !fir.box<!fir.array<?xf32>> {fir.bindc_name = "x", fir.contiguous}, %arg1: !fir.box<!fir.array<?xf32>>{{.*}}) { 12! ArrayCoorCHECK-LABEL: func @_QPtest_element_ref 13subroutine test_element_ref(x, y) 14 real, contiguous :: x(:) 15 ! CHECK-DAG: %[[xaddr:.*]] = fir.box_addr %arg0 : (!fir.box<!fir.array<?xf32>>) -> !fir.ref<!fir.array<?xf32>> 16 real :: y(4:) 17 ! CHECK-DAG: %[[c4:.*]] = fir.convert %c4{{.*}} : (i64) -> index 18 19 call bar(x(100)) 20 ! CHECK: fir.coordinate_of %[[xaddr]], %{{.*}} : (!fir.ref<!fir.array<?xf32>>, i64) -> !fir.ref<f32> 21 call bar(y(100)) 22 ! Test that for an entity that is not know to be contiguous, the fir.box is passed 23 ! to coordinate of and that the lower bounds is already applied by lowering. 24 ! CHECK: %[[c4_2:.*]] = fir.convert %[[c4]] : (index) -> i64 25 ! CHECK: %[[index:.*]] = arith.subi %c100{{.*}}, %[[c4_2]] : i64 26 ! CHECK: fir.coordinate_of %arg1, %{{.*}} : (!fir.box<!fir.array<?xf32>>, i64) -> !fir.ref<f32> 27 28 29 ! Repeat test when lowering is using fir.array_coor 30 ! ArrayCoorCHECK-DAG: %[[xaddr:.*]] = fir.box_addr %arg0 : (!fir.box<!fir.array<?xf32>>) -> !fir.ref<!fir.array<?xf32>> 31 ! ArrayCoorCHECK-DAG: %[[xshape:.*]] = fir.shape 32 ! ArrayCoorCHECK-DAG: %[[c100:.*]] = fir.convert %c100{{.*}} : (i64) -> index 33 ! ArrayCoorCHECK: fir.array_coor %[[xaddr]](%[[xshape]]) %[[c100]] : (!fir.ref<!fir.array<?xf32>>, !fir.shapeshift<1>, index) -> !fir.ref<f32> 34 35 ! ArrayCoorCHECK-DAG: %[[c100_1:.*]] = fir.convert %c100{{.*}} : (i64) -> index 36 ! ArrayCoorCHECK-DAG: %[[shift:.*]] = fir.shift %{{.*}} : (index) -> !fir.shift<1> 37 ! ArrayCoorCHECK: fir.array_coor %arg1(%[[shift]]) %[[c100_1]] : (!fir.box<!fir.array<?xf32>>, !fir.shift<1>, index) -> !fir.ref<f32> 38end subroutine 39 40! CHECK-LABEL: func @_QPtest_element_assign(%arg0: !fir.box<!fir.array<?xf32>> {fir.bindc_name = "x", fir.contiguous}, %arg1: !fir.box<!fir.array<?xf32>>{{.*}}) { 41! ArrayCoorCHECK-LABEL: func @_QPtest_element_assign 42subroutine test_element_assign(x, y) 43 real, contiguous :: x(:) 44 ! CHECK-DAG: %[[xaddr:.*]] = fir.box_addr %arg0 : (!fir.box<!fir.array<?xf32>>) -> !fir.ref<!fir.array<?xf32>> 45 real :: y(4:) 46 ! CHECK-DAG: %[[c4:.*]] = fir.convert %c4{{.*}} : (i64) -> index 47 x(100) = 42. 48 ! CHECK: fir.coordinate_of %[[xaddr]], %{{.*}} : (!fir.ref<!fir.array<?xf32>>, i64) -> !fir.ref<f32> 49 y(100) = 42. 50 ! CHECK: %[[c4_2:.*]] = fir.convert %[[c4]] : (index) -> i64 51 ! CHECK: %[[index:.*]] = arith.subi %c100{{.*}}, %[[c4_2]] : i64 52 ! CHECK: fir.coordinate_of %arg1, %{{.*}} : (!fir.box<!fir.array<?xf32>>, i64) -> !fir.ref<f32> 53 54 ! ArrayCoorCHECK-DAG: %[[xaddr:.*]] = fir.box_addr %arg0 : (!fir.box<!fir.array<?xf32>>) -> !fir.ref<!fir.array<?xf32>> 55 ! ArrayCoorCHECK-DAG: %[[xshape:.*]] = fir.shape 56 ! ArrayCoorCHECK-DAG: %[[c100:.*]] = fir.convert %c100{{.*}} : (i64) -> index 57 ! ArrayCoorCHECK: fir.array_coor %[[xaddr]](%[[xshape]]) %[[c100]] : (!fir.ref<!fir.array<?xf32>>, !fir.shapeshift<1>, index) -> !fir.ref<f32> 58 59 ! ArrayCoorCHECK-DAG: %[[c100_1:.*]] = fir.convert %c100{{.*}} : (i64) -> index 60 ! ArrayCoorCHECK-DAG: %[[shift:.*]] = fir.shift %{{.*}} : (index) -> !fir.shift<1> 61 ! ArrayCoorCHECK: fir.array_coor %arg1(%[[shift]]) %[[c100_1]] : (!fir.box<!fir.array<?xf32>>, !fir.shift<1>, index) -> !fir.ref<f32> 62end subroutine 63 64! CHECK-LABEL: func @_QPtest_ref_in_array_expr(%arg0: !fir.box<!fir.array<?xf32>> {fir.bindc_name = "x", fir.contiguous}, %arg1: !fir.box<!fir.array<?xf32>>{{.*}}) { 65subroutine test_ref_in_array_expr(x, y) 66 real, contiguous :: x(:) 67 ! CHECK: %[[xaddr:.*]] = fir.box_addr %arg0 : (!fir.box<!fir.array<?xf32>>) -> !fir.ref<!fir.array<?xf32>> 68 real :: y(:) 69 call bar2(x+1.) 70 ! CHECK: fir.array_load %[[xaddr]](%{{.*}}) : (!fir.ref<!fir.array<?xf32>>, !fir.shapeshift<1>) -> !fir.array<?xf32> 71 call bar2(y+1.) 72 ! CHECK: fir.array_load %arg1 : (!fir.box<!fir.array<?xf32>>) -> !fir.array<?xf32> 73end subroutine 74 75 76! CHECK-LABEL: func @_QPtest_assign_in_array_ref(%arg0: !fir.box<!fir.array<?xf32>> {fir.bindc_name = "x", fir.contiguous}, %arg1: !fir.box<!fir.array<?xf32>>{{.*}}) { 77subroutine test_assign_in_array_ref(x, y) 78 real, contiguous :: x(:) 79 ! CHECK: %[[xaddr:.*]] = fir.box_addr %arg0 : (!fir.box<!fir.array<?xf32>>) -> !fir.ref<!fir.array<?xf32>> 80 real :: y(:) 81 x = 42. 82 ! CHECK: %[[xload:.*]] = fir.array_load %[[xaddr]]({{.*}}) : (!fir.ref<!fir.array<?xf32>>, !fir.shapeshift<1>) -> !fir.array<?xf32> 83 ! CHECK: %[[xloop:.*]] = fir.do_loop {{.*}} iter_args(%arg3 = %[[xload]]) -> (!fir.array<?xf32>) 84 ! CHECK: fir.array_merge_store %[[xload]], %[[xloop]] to %[[xaddr]] : !fir.array<?xf32>, !fir.array<?xf32>, !fir.ref<!fir.array<?xf32>> 85 y = 42. 86 ! CHECK: %[[yload:.*]] = fir.array_load %arg1 : (!fir.box<!fir.array<?xf32>>) -> !fir.array<?xf32> 87 ! CHECK: %[[yloop:.*]] = fir.do_loop {{.*}} iter_args(%arg3 = %[[yload]]) -> (!fir.array<?xf32>) { 88 ! CHECK: fir.array_merge_store %[[yload]], %[[yloop]] to %arg1 : !fir.array<?xf32>, !fir.array<?xf32>, !fir.box<!fir.array<?xf32>> 89end subroutine 90 91! CHECK-LABEL: func @_QPtest_slice_ref(%arg0: !fir.box<!fir.array<?xf32>> {fir.bindc_name = "x", fir.contiguous}, %arg1: !fir.box<!fir.array<?xf32>> 92subroutine test_slice_ref(x, y, z1, z2, i, j, k, n) 93 real, contiguous :: x(:) 94 ! CHECK: %[[xaddr:.*]] = fir.box_addr %arg0 : (!fir.box<!fir.array<?xf32>>) -> !fir.ref<!fir.array<?xf32>> 95 real :: y(:) 96 integer :: i, j, k, n 97 real :: z1(n), z2(n) 98 z2 = x(i:j:k) 99 ! CHECK: %[[xslice:.*]] = fir.slice 100 ! CHECK: fir.array_load %[[xaddr]]{{.*}}%[[xslice]]{{.*}}: (!fir.ref<!fir.array<?xf32>>, !fir.shapeshift<1>, !fir.slice<1>) -> !fir.array<?xf32> 101 z1 = y(i:j:k) 102 ! CHECK: %[[yslice:.*]] = fir.slice 103 ! CHECK: fir.array_load %arg1 {{.*}}%[[yslice]]{{.*}} : (!fir.box<!fir.array<?xf32>>, !fir.slice<1>) -> !fir.array<?xf32> 104end subroutine 105 106! CHECK-LABEL: func @_QPtest_slice_assign(%arg0: !fir.box<!fir.array<?xf32>> {fir.bindc_name = "x", fir.contiguous}, %arg1: !fir.box<!fir.array<?xf32>> 107subroutine test_slice_assign(x, y, i, j, k) 108 real, contiguous :: x(:) 109 ! CHECK: %[[xaddr:.*]] = fir.box_addr %arg0 : (!fir.box<!fir.array<?xf32>>) -> !fir.ref<!fir.array<?xf32>> 110 real :: y(:) 111 integer :: i, j, k 112 x(i:j:k) = 42. 113 ! CHECK: %[[xslice:.*]] = fir.slice 114 ! CHECK: fir.array_load %[[xaddr]]{{.*}}%[[xslice]]{{.*}}: (!fir.ref<!fir.array<?xf32>>, !fir.shapeshift<1>, !fir.slice<1>) -> !fir.array<?xf32> 115 y(i:j:k) = 42. 116 ! CHECK: %[[yslice:.*]] = fir.slice 117 ! CHECK: fir.array_load %arg1 {{.*}}%[[yslice]]{{.*}}: (!fir.box<!fir.array<?xf32>>, !fir.slice<1>) -> !fir.array<?xf32> 118end subroutine 119 120! test that allocatable are considered contiguous. 121! CHECK-LABEL: func @_QPfoo 122subroutine foo(x) 123 real, allocatable :: x(:) 124 call bar(x(100)) 125 ! CHECK: fir.coordinate_of %{{.*}}, %{{.*}} (!fir.heap<!fir.array<?xf32>>, i64) -> !fir.ref<f32> 126end subroutine 127 128! Test that non-contiguous dummy are propagated with their memory layout (we 129! mainly do not want to create a new box that would ignore the original layout). 130! CHECK: func @_QPpropagate(%arg0: !fir.box<!fir.array<?xf32>> {fir.bindc_name = "x"}) 131subroutine propagate(x) 132 interface 133 subroutine bar3(x) 134 real :: x(:) 135 end subroutine 136 end interface 137 real :: x(:) 138 call bar3(x) 139 ! CHECK: fir.call @_QPbar3(%arg0) {{.*}}: (!fir.box<!fir.array<?xf32>>) -> () 140end subroutine 141