1! Test array-value-copy 2 3! RUN: bbc -hlfir=false %s -o - | FileCheck %s 4 5! Copy not needed 6! CHECK-LABEL: func @_QPtest1( 7! CHECK: ^bb{{[0-9]+}}(%{{.*}}: index, %{{.*}}: index): 8! CHECK-NOT: ^bb{{[0-9]+}}(%{{.*}}: index, %{{.*}}: index): 9! CHECK-NOT: fir.freemem % 10! CHECK: return 11! CHECK: } 12subroutine test1(a) 13 integer :: a(3) 14 15 a = a + 1 16end subroutine test1 17 18! Copy not needed 19! CHECK-LABEL: func @_QPtest2( 20! CHECK: ^bb{{[0-9]+}}(%{{.*}}: index, %{{.*}}: index): 21! CHECK-NOT: ^bb{{[0-9]+}}(%{{.*}}: index, %{{.*}}: index): 22! CHECK-NOT: fir.freemem % 23! CHECK: return 24! CHECK: } 25subroutine test2(a, b) 26 integer :: a(3), b(3) 27 28 a = b + 1 29end subroutine test2 30 31! Copy not needed 32! CHECK-LABEL: func @_QPtest3( 33! CHECK: ^bb{{[0-9]+}}(%{{.*}}: index, %{{.*}}: index): 34! CHECK-NOT: ^bb{{[0-9]+}}(%{{.*}}: index, %{{.*}}: index): 35! CHECK-NOT: fir.freemem % 36! CHECK: return 37! CHECK: } 38subroutine test3(a) 39 integer :: a(3) 40 41 forall (i=1:3) 42 a(i) = a(i) + 1 43 end forall 44end subroutine test3 45 46! Make a copy. (Crossing dependence) 47! CHECK-LABEL: func @_QPtest4( 48! CHECK: ^bb{{[0-9]+}}(%{{.*}}: index, %{{.*}}: index): 49! CHECK: ^bb{{[0-9]+}}(%{{.*}}: index, %{{.*}}: index): 50! CHECK: fir.freemem %{{.*}} : !fir.heap<!fir.array<3xi32>> 51! CHECK: return 52! CHECK: } 53subroutine test4(a) 54 integer :: a(3) 55 56 forall (i=1:3) 57 a(i) = a(4-i) + 1 58 end forall 59end subroutine test4 60 61! Make a copy. (Carried dependence) 62! CHECK-LABEL: func @_QPtest5( 63! CHECK: ^bb{{[0-9]+}}(%{{.*}}: index, %{{.*}}: index): 64! CHECK: ^bb{{[0-9]+}}(%{{.*}}: index, %{{.*}}: index): 65! CHECK: fir.freemem %{{.*}} : !fir.heap<!fir.array<3xi32>> 66! CHECK: return 67! CHECK: } 68subroutine test5(a) 69 integer :: a(3) 70 71 forall (i=2:3) 72 a(i) = a(i-1) + 14 73 end forall 74end subroutine test5 75 76! Make a copy. (Carried dependence) 77! CHECK-LABEL: func @_QPtest6( 78! CHECK: ^bb{{[0-9]+}}(%{{.*}}: index, %{{.*}}: index): 79! CHECK: ^bb{{[0-9]+}}(%{{.*}}: index, %{{.*}}: index): 80! CHECK: fir.freemem %{{.*}} : !fir.heap<!fir.array<3x!fir.type<_QFtest6Tt{m:!fir.array<3xi32>}>>> 81! CHECK: return 82! CHECK: } 83subroutine test6(a) 84 type t 85 integer :: m(3) 86 end type t 87 type(t) :: a(3) 88 89 forall (i=2:3) 90 a(i)%m = a(i-1)%m + 14 91 end forall 92end subroutine test6 93 94! Make a copy. (Overlapping partial CHARACTER update.) 95! CHECK-LABEL: func @_QPtest7( 96! CHECK: ^bb{{[0-9]+}}(%{{.*}}: index, %{{.*}}: index): 97! CHECK: ^bb{{[0-9]+}}(%{{.*}}: index, %{{.*}}: index): 98! CHECK: ^bb{{[0-9]+}}(%{{.*}}: index, %{{.*}}: index): 99! CHECK: ^bb{{[0-9]+}}(%{{.*}}: index, %{{.*}}: index): 100! CHECK: fir.freemem %{{.*}} : !fir.heap<!fir.array<3x!fir.char<1,8>>> 101! CHECK: return 102! CHECK: } 103subroutine test7(a) 104 character(8) :: a(3) 105 106 a(:)(2:5) = a(:)(3:6) 107end subroutine test7 108 109! Do not make a copy. 110! CHECK-LABEL: func @_QPtest8( 111! CHECK: ^bb{{[0-9]+}}(%{{.*}}: index, %{{.*}}: index): 112! CHECK: ^bb{{[0-9]+}}(%{{.*}}: index, %{{.*}}: index): 113! CHECK: ^bb{{[0-9]+}}(%{{.*}}: index, %{{.*}}: index): 114! CHECK-NOT: ^bb{{[0-9]+}}(%{{.*}}: index, %{{.*}}: index): 115! CHECK-NOT: fir.freemem % 116! CHECK: return 117! CHECK: } 118subroutine test8(a,b) 119 character(8) :: a(3), b(3) 120 121 a(:)(2:5) = b(:)(3:6) 122end subroutine test8 123 124! Do make a copy. Assume vector subscripts cause dependences. 125! CHECK-LABEL: func @_QPtest9( 126! CHECK-SAME: %[[a:[^:]+]]: !fir.ref<!fir.array<?x?xf32>> 127! CHECK: %[[und:.*]] = fir.undefined index 128! CHECK: %[[slice:.*]] = fir.slice %[[und]], %[[und]], %[[und]], 129! CHECK: %[[heap:.*]] = fir.allocmem !fir.array<?x?xf32>, %{{.*}}, %{{.*}} 130! CHECK: ^bb{{[0-9]+}}(%{{.*}}: index, %{{.*}}: index): 131! CHECK: ^bb{{[0-9]+}}(%{{.*}}: index, %{{.*}}: index): 132! CHECK: ^bb{{[0-9]+}}(%{{.*}}: index, %{{.*}}: index): 133! CHECK: ^bb{{[0-9]+}}(%{{.*}}: index, %{{.*}}: index): 134! CHECK: = fir.array_coor %[[a]](%{{.*}}) [%[[slice]]] %{{.*}}, %{{.*}} : (!fir.ref<!fir.array<?x?xf32>>, !fir.shape<2>, !fir.slice<2>, index, index) -> !fir.ref<f32> 135! CHECK: = fir.array_coor %[[heap]](%{{.*}}) [%[[slice]]] %{{.*}}, %{{.*}} : (!fir.heap<!fir.array<?x?xf32>>, !fir.shape<2>, !fir.slice<2>, index, index) -> !fir.ref<f32> 136! CHECK: ^bb{{[0-9]+}}(%{{.*}}: index, %{{.*}}: index): 137! CHECK: ^bb{{[0-9]+}}(%{{.*}}: index, %{{.*}}: index): 138! CHECK-NOT: ^bb{{[0-9]+}}(%{{.*}}: index, %{{.*}}: index): 139! CHECK: fir.freemem %[[heap]] 140subroutine test9(a,v1,v2,n) 141 real :: a(n,n) 142 integer :: v1(n), v2(n) 143 a(v1,:) = a(v2,:) 144end subroutine test9 145