|
| 1 | +! RUN: bbc %s -o - | FileCheck %s |
| 2 | + |
| 3 | +! CHECK-LABEL: func @_QPss1() |
| 4 | +subroutine ss1 |
| 5 | + ! CHECK: %[[aa:[0-9]+]] = fir.alloca !fir.array<2650000xf32> {bindc_name = "aa", uniq_name = "_QFss1Eaa"} |
| 6 | + ! CHECK: %[[shape:[0-9]+]] = fir.shape {{.*}} : (index) -> !fir.shape<1> |
| 7 | + integer, parameter :: N = 2650000 |
| 8 | + real aa(N) |
| 9 | + ! CHECK: fir.array_coor %[[aa]](%[[shape]]) {{.*}} : (!fir.ref<!fir.array<2650000xf32>>, !fir.shape<1>, index) -> !fir.ref<f32> |
| 10 | + aa = -2 |
| 11 | + ! CHECK: %[[temp:[0-9]+]] = fir.allocmem !fir.array<2650000xf32> |
| 12 | + ! CHECK: fir.array_coor %[[aa]](%[[shape]]) {{.*}} : (!fir.ref<!fir.array<2650000xf32>>, !fir.shape<1>, index) -> !fir.ref<f32> |
| 13 | + ! CHECK: fir.array_coor %[[temp]](%[[shape]]) {{.*}} : (!fir.heap<!fir.array<2650000xf32>>, !fir.shape<1>, index) -> !fir.ref<f32> |
| 14 | + ! CHECK: fir.array_coor %[[aa]](%[[shape]]) [{{.*}}] {{.*}} : (!fir.ref<!fir.array<2650000xf32>>, !fir.shape<1>, !fir.slice<1>, index) -> !fir.ref<f32> |
| 15 | + ! CHECK: fir.array_coor %[[temp]](%[[shape]]) [{{.*}}] {{.*}} : (!fir.heap<!fir.array<2650000xf32>>, !fir.shape<1>, !fir.slice<1>, index) -> !fir.ref<f32> |
| 16 | + ! CHECK: fir.array_coor %[[temp]](%[[shape]]) {{.*}} : (!fir.heap<!fir.array<2650000xf32>>, !fir.shape<1>, index) -> !fir.ref<f32> |
| 17 | + ! CHECK: fir.array_coor %[[aa]](%[[shape]]) {{.*}} : (!fir.ref<!fir.array<2650000xf32>>, !fir.shape<1>, index) -> !fir.ref<f32> |
| 18 | + ! CHECK: fir.freemem %[[temp]] : !fir.heap<!fir.array<2650000xf32>> |
| 19 | + aa(2:N) = aa(1:N-1) + 7.0 |
| 20 | +! print*, aa(1:2), aa(N-1:N) |
| 21 | +end |
| 22 | + |
| 23 | +! CHECK-LABEL: func @_QPss2 |
| 24 | +subroutine ss2(N) |
| 25 | + ! CHECK: %[[arg:[0-9]+]] = fir.load %arg0 : !fir.ref<i32> |
| 26 | + ! CHECK: %[[n:[0-9]+]] = fir.convert %[[arg]] : (i32) -> index |
| 27 | + ! CHECK: %[[aa:[0-9]+]] = fir.alloca !fir.array<?xf32>, %[[n]] {bindc_name = "aa", uniq_name = "_QFss2Eaa"} |
| 28 | + real aa(N) |
| 29 | + ! CHECK: %[[shape:[0-9]+]] = fir.shape %[[n]] : (index) -> !fir.shape<1> |
| 30 | + ! CHECK: fir.array_coor %[[aa]](%[[shape]]) {{.*}} : (!fir.ref<!fir.array<?xf32>>, !fir.shape<1>, index) -> !fir.ref<f32> |
| 31 | + aa = -2 |
| 32 | + ! CHECK: %[[temp:[0-9]+]] = fir.allocmem !fir.array<?xf32>, %[[n]] |
| 33 | + ! CHECK: fir.array_coor %[[aa]](%[[shape]]) {{.*}} : (!fir.ref<!fir.array<?xf32>>, !fir.shape<1>, index) -> !fir.ref<f32> |
| 34 | + ! CHECK: fir.array_coor %[[temp]](%[[shape]]) {{.*}} : (!fir.heap<!fir.array<?xf32>>, !fir.shape<1>, index) -> !fir.ref<f32> |
| 35 | + ! CHECK: fir.array_coor %[[aa]](%[[shape]]) [{{.*}}] {{.*}} : (!fir.ref<!fir.array<?xf32>>, !fir.shape<1>, !fir.slice<1>, index) -> !fir.ref<f32> |
| 36 | + ! CHECK: fir.array_coor %[[temp]](%[[shape]]) [{{.*}}] {{.*}} : (!fir.heap<!fir.array<?xf32>>, !fir.shape<1>, !fir.slice<1>, index) -> !fir.ref<f32> |
| 37 | + ! CHECK: fir.array_coor %[[temp]](%[[shape]]) {{.*}} : (!fir.heap<!fir.array<?xf32>>, !fir.shape<1>, index) -> !fir.ref<f32> |
| 38 | + ! CHECK: fir.array_coor %[[aa]](%[[shape]]) {{.*}} : (!fir.ref<!fir.array<?xf32>>, !fir.shape<1>, index) -> !fir.ref<f32> |
| 39 | + ! CHECK: fir.freemem %[[temp]] : !fir.heap<!fir.array<?xf32>> |
| 40 | + aa(2:N) = aa(1:N-1) + 7.0 |
| 41 | +! print*, aa(1:2), aa(N-1:N) |
| 42 | +end |
| 43 | + |
| 44 | +! CHECK-LABEL: func @_QPss3 |
| 45 | +subroutine ss3(N) |
| 46 | + ! CHECK: %[[arg:[0-9]+]] = fir.load %arg0 : !fir.ref<i32> |
| 47 | + ! CHECK: %[[n:[0-9]+]] = fir.convert %[[arg]] : (i32) -> index |
| 48 | + ! CHECK: %[[aa:[0-9]+]] = fir.alloca !fir.array<2x?xf32>, %[[n]] {bindc_name = "aa", uniq_name = "_QFss3Eaa"} |
| 49 | + real aa(2,N) |
| 50 | + ! CHECK: %[[shape:[0-9]+]] = fir.shape {{.*}} %[[n]] : (index, index) -> !fir.shape<2> |
| 51 | + ! CHECK: fir.array_coor %[[aa]](%[[shape]]) {{.*}}, {{.*}} : (!fir.ref<!fir.array<2x?xf32>>, !fir.shape<2>, index, index) -> !fir.ref<f32> |
| 52 | + aa = -2 |
| 53 | + ! CHECK: %[[temp:[0-9]+]] = fir.allocmem !fir.array<2x?xf32>, %[[n]] |
| 54 | + ! CHECK: fir.array_coor %[[aa]](%[[shape]]) {{.*}}, {{.*}} : (!fir.ref<!fir.array<2x?xf32>>, !fir.shape<2>, index, index) -> !fir.ref<f32> |
| 55 | + ! CHECK: fir.array_coor %[[temp]](%[[shape]]) {{.*}}, {{.*}} : (!fir.heap<!fir.array<2x?xf32>>, !fir.shape<2>, index, index) -> !fir.ref<f32> |
| 56 | + ! CHECK: fir.array_coor %[[aa]](%[[shape]]) [{{.*}}] {{.*}}, {{.*}} : (!fir.ref<!fir.array<2x?xf32>>, !fir.shape<2>, !fir.slice<2>, index, index) -> !fir.ref<f32> |
| 57 | + ! CHECK: fir.array_coor %[[temp]](%[[shape]]) [{{.*}}] {{.*}}, {{.*}} : (!fir.heap<!fir.array<2x?xf32>>, !fir.shape<2>, !fir.slice<2>, index, index) -> !fir.ref<f32> |
| 58 | + ! CHECK: fir.array_coor %[[temp]](%[[shape]]) {{.*}}, {{.*}} : (!fir.heap<!fir.array<2x?xf32>>, !fir.shape<2>, index, index) -> !fir.ref<f32> |
| 59 | + ! CHECK: fir.array_coor %[[aa]](%[[shape]]) {{.*}}, {{.*}} : (!fir.ref<!fir.array<2x?xf32>>, !fir.shape<2>, index, index) -> !fir.ref<f32> |
| 60 | + ! CHECK: fir.freemem %[[temp]] : !fir.heap<!fir.array<2x?xf32>> |
| 61 | + aa(:,2:N) = aa(:,1:N-1) + 7.0 |
| 62 | +! print*, aa(:,1:2), aa(:,N-1:N) |
| 63 | +end |
| 64 | + |
| 65 | +! CHECK-LABEL: func @_QPss4 |
| 66 | +subroutine ss4(N) |
| 67 | + ! CHECK: %[[arg:[0-9]+]] = fir.load %arg0 : !fir.ref<i32> |
| 68 | + ! CHECK: %[[n:[0-9]+]] = fir.convert %[[arg]] : (i32) -> index |
| 69 | + ! CHECK: %[[aa:[0-9]+]] = fir.alloca !fir.array<?x2xf32>, %[[n]] {bindc_name = "aa", uniq_name = "_QFss4Eaa"} |
| 70 | + real aa(N,2) |
| 71 | + ! CHECK: %[[shape:[0-9]+]] = fir.shape %[[n]], {{.*}} : (index, index) -> !fir.shape<2> |
| 72 | + ! CHECK: fir.array_coor %[[aa]](%[[shape]]) {{.*}}, {{.*}} : (!fir.ref<!fir.array<?x2xf32>>, !fir.shape<2>, index, index) -> !fir.ref<f32> |
| 73 | + aa = -2 |
| 74 | + ! CHECK: %[[temp:[0-9]+]] = fir.allocmem !fir.array<?x2xf32>, %[[n]] |
| 75 | + ! CHECK: fir.array_coor %[[aa]](%[[shape]]) {{.*}}, {{.*}} : (!fir.ref<!fir.array<?x2xf32>>, !fir.shape<2>, index, index) -> !fir.ref<f32> |
| 76 | + ! CHECK: fir.array_coor %[[temp]](%[[shape]]) {{.*}}, {{.*}} : (!fir.heap<!fir.array<?x2xf32>>, !fir.shape<2>, index, index) -> !fir.ref<f32> |
| 77 | + ! CHECK: fir.array_coor %[[aa]](%[[shape]]) [{{.*}}] {{.*}}, {{.*}} : (!fir.ref<!fir.array<?x2xf32>>, !fir.shape<2>, !fir.slice<2>, index, index) -> !fir.ref<f32> |
| 78 | + ! CHECK: fir.array_coor %[[temp]](%[[shape]]) [{{.*}}] {{.*}}, {{.*}} : (!fir.heap<!fir.array<?x2xf32>>, !fir.shape<2>, !fir.slice<2>, index, index) -> !fir.ref<f32> |
| 79 | + ! CHECK: fir.array_coor %[[temp]](%[[shape]]) {{.*}}, {{.*}} : (!fir.heap<!fir.array<?x2xf32>>, !fir.shape<2>, index, index) -> !fir.ref<f32> |
| 80 | + ! CHECK: fir.array_coor %[[aa]](%[[shape]]) {{.*}}, {{.*}} : (!fir.ref<!fir.array<?x2xf32>>, !fir.shape<2>, index, index) -> !fir.ref<f32> |
| 81 | + ! CHECK: fir.freemem %[[temp]] : !fir.heap<!fir.array<?x2xf32>> |
| 82 | + aa(2:N,:) = aa(1:N-1,:) + 7.0 |
| 83 | +! print*, aa(1:2,:), aa(N-1:N,:) |
| 84 | +end |
| 85 | + |
| 86 | +program p |
| 87 | +! call ss1 |
| 88 | +! call ss2(2650000) |
| 89 | +! call ss3(2650000) |
| 90 | +! call ss4(2650000) |
| 91 | +end |
0 commit comments