1! RUN: bbc -hlfir=false --use-desc-for-alloc=false %s -o - | FileCheck %s 2 3! Constant array ctor. 4! CHECK-LABEL: func @_QPtest1( 5subroutine test1(a, b) 6 real :: a(3) 7 integer :: b(4) 8 integer, parameter :: constant_array(4) = [6, 7, 42, 9] 9 10 ! Array ctors for constant arrays should be outlined as constant globals. 11 12 ! Look at inline constructor case 13 ! CHECK: %{{.*}} = fir.address_of(@_QQro.3xr4.0) : !fir.ref<!fir.array<3xf32>> 14 a = (/ 1.0, 2.0, 3.0 /) 15 16 ! Look at PARAMETER case 17 ! CHECK: %{{.*}} = fir.address_of(@_QQro.4xi4.1) : !fir.ref<!fir.array<4xi32>> 18 b = constant_array 19end subroutine test1 20 21! Dynamic array ctor with constant extent. 22! CHECK-LABEL: func @_QPtest2( 23! CHECK-SAME: %[[a:[^:]*]]: !fir.ref<!fir.array<5xf32>>{{.*}}, %[[b:[^:]*]]: !fir.ref<f32>{{.*}}) 24subroutine test2(a, b) 25 real :: a(5), b 26 real, external :: f 27 28 ! Look for the 5 store patterns 29 ! CHECK: %[[tmp:.*]] = fir.allocmem !fir.array<5xf32> 30 ! CHECK: %[[val:.*]] = fir.call @_QPf(%[[b]]) {{.*}}: (!fir.ref<f32>) -> f32 31 ! CHECK: %[[loc:.*]] = fir.coordinate_of %{{.*}}, %{{.*}} : (!fir.heap<!fir.array<5xf32>>, index) -> !fir.ref<f32> 32 ! CHECK: fir.store %[[val]] to %[[loc]] : !fir.ref<f32> 33 ! CHECK: fir.call @_QPf(%{{.*}}) {{.*}}: (!fir.ref<f32>) -> f32 34 ! CHECK: fir.coordinate_of %{{.*}}, %{{.*}} : (!fir.heap<!fir.array<5xf32>>, index) -> !fir.ref<f32> 35 ! CHECK: fir.store 36 ! CHECK: fir.call @_QPf( 37 ! CHECK: fir.coordinate_of % 38 ! CHECK: fir.store 39 ! CHECK: fir.call @_QPf( 40 ! CHECK: fir.coordinate_of % 41 ! CHECK: fir.store 42 ! CHECK: fir.call @_QPf( 43 ! CHECK: fir.coordinate_of % 44 ! CHECK: fir.store 45 46 ! After the ctor done, loop to copy result to `a` 47 ! CHECK-DAG: fir.array_coor %[[tmp:.*]](% 48 ! CHECK-DAG: %[[ai:.*]] = fir.array_coor %[[a]](% 49 ! CHECK: fir.store %{{.*}} to %[[ai]] : !fir.ref<f32> 50 ! CHECK: fir.freemem %[[tmp]] : !fir.heap<!fir.array<5xf32>> 51 52 a = [f(b), f(b+1), f(b+2), f(b+5), f(b+11)] 53end subroutine test2 54 55! Dynamic array ctor with dynamic extent. 56! CHECK-LABEL: func @_QPtest3( 57! CHECK-SAME: %[[a:.*]]: !fir.box<!fir.array<?xf32>>{{.*}}) 58subroutine test3(a) 59 real :: a(:) 60 real, allocatable :: b(:), c(:) 61 interface 62 subroutine test3b(x) 63 real, allocatable :: x(:) 64 end subroutine test3b 65 end interface 66 interface 67 function test3c 68 real, allocatable :: test3c(:) 69 end function test3c 70 end interface 71 72 ! CHECK: fir.call @_QPtest3b 73 ! CHECK: %{{.*}}:3 = fir.box_dims %{{.*}}, %{{.*}} : (!fir.box<!fir.heap<!fir.array<?xf32>>>, index) -> (index, index, index) 74 ! CHECK: %{{.*}} = fir.box_addr %{{.*}} : (!fir.box<!fir.heap<!fir.array<?xf32>>>) -> !fir.heap<!fir.array<?xf32>> 75 ! CHECK: %[[tmp:.*]] = fir.allocmem f32, %c32 76 call test3b(b) 77 ! CHECK: %[[hp1:.*]] = fir.allocmem !fir.array<?xf32>, %{{.*}} {uniq_name = ".array.expr"} 78 ! CHECK-DAG: %[[rep:.*]] = fir.convert %{{.*}} : (!fir.heap<f32>) -> !fir.ref<i8> 79 ! CHECK-DAG: %[[res:.*]] = fir.convert %{{.*}} : (index) -> i64 80 ! CHECK: %{{.*}} = fir.call @realloc(%[[rep]], %[[res]]) {{.*}}: (!fir.ref<i8>, i64) -> !fir.ref<i8> 81 ! CHECK: fir.call @llvm.memcpy.p0.p0.i64(%{{.*}}, %{{.*}}, %{{.*}}, %false{{.*}}) {{.*}}: (!fir.ref<i8>, !fir.ref<i8>, i64, i1) -> () 82 ! CHECK: fir.call @_QPtest3c 83 ! CHECK: fir.save_result 84 ! CHECK: %[[tmp2:.*]] = fir.allocmem !fir.array<?xf32>, %{{.*}}#1 {uniq_name = ".array.expr"} 85 ! CHECK: fir.call @realloc 86 ! CHECK: fir.call @llvm.memcpy.p0.p0.i64(% 87 ! CHECK: fir.array_coor %[[tmp:.*]](%{{.*}}) %{{.*}} : (!fir.heap<!fir.array<?xf32>>, !fir.shape<1>, index) -> !fir.ref<f32> 88 ! CHECK-NEXT: fir.load 89 ! CHECK-NEXT: fir.array_coor %arg0 %{{.*}} : (!fir.box<!fir.array<?xf32>>, index) -> !fir.ref<f32> 90 ! CHECK-NEXT: fir.store 91 ! CHECK: fir.freemem %[[tmp]] 92 ! CHECK: fir.freemem %[[tmp2]] 93 ! CHECK: %[[alli:.*]] = fir.box_addr %{{.*}} : (!fir.box<!fir.heap<!fir.array<?xf32>>>) -> !fir.heap<!fir.array<?xf32>> 94 ! CHECK: fir.freemem %[[alli]] 95 ! CHECK: fir.freemem %[[hp1]] 96 a = (/ b, test3c() /) 97end subroutine test3 98 99! CHECK-LABEL: func @_QPtest4( 100subroutine test4(a, b, n1, m1) 101 real :: a(:) 102 real :: b(:,:) 103 integer, external :: f1, f2, f3 104 105 ! Dynamic array ctor with dynamic extent using implied do loops. 106 ! CHECK-DAG: fir.alloca index {bindc_name = ".buff.pos"} 107 ! CHECK-DAG: fir.alloca index {bindc_name = ".buff.size"} 108 ! CHECK-DAG: %[[c32:.*]] = arith.constant 32 : index 109 ! CHECK: fir.allocmem f32, %[[c32]] 110 ! CHECK: fir.call @_QPf1(%{{.*}}) {{.*}}: (!fir.ref<i32>) -> i32 111 ! CHECK: fir.call @_QPf2(%arg2) {{.*}}: (!fir.ref<i32>) -> i32 112 ! CHECK: fir.call @_QPf3(%{{.*}}) {{.*}}: (!fir.ref<i32>) -> i32 113 ! CHECK: %[[q:.*]] = fir.coordinate_of %arg1, %{{.*}}, %{{.*}} : (!fir.box<!fir.array<?x?xf32>>, i64, i64) -> !fir.ref<f32> 114 ! CHECK: %[[q2:.*]] = fir.load %[[q]] : !fir.ref<f32> 115 ! CHECK: fir.store %[[q2]] to %{{.*}} : !fir.ref<f32> 116 ! CHECK: fir.freemem %{{.*}} : !fir.heap<!fir.array<?xf32>> 117 ! CHECK-NEXT: return 118 a = [ ((b(i,j), j=f1(i),f2(n1),f3(m1+i)), i=1,n1,m1) ] 119end subroutine test4 120 121! CHECK-LABEL: func @_QPtest5( 122! CHECK-SAME: %[[a:[^:]*]]: !fir.box<!fir.array<?xf32>>{{.*}}, %[[array2:[^:]*]]: !fir.ref<!fir.array<2xf32>>{{.*}}) 123subroutine test5(a, array2) 124 real :: a(:) 125 real, parameter :: const_array1(2) = [ 1.0, 2.0 ] 126 real :: array2(2) 127 128 ! Array ctor with runtime element values and constant extents. 129 ! Concatenation of array values of constant extent. 130 ! CHECK: %[[res:.*]] = fir.allocmem !fir.array<4xf32> 131 ! CHECK: fir.address_of(@_QQro.2xr4.2) : !fir.ref<!fir.array<2xf32>> 132 ! CHECK: %[[tmp1:.*]] = fir.allocmem !fir.array<2xf32> 133 ! CHECK: fir.call @llvm.memcpy.p0.p0.i64(%{{.*}}, %{{.*}}, %{{.*}}, %false{{.*}}) {{.*}}: (!fir.ref<i8>, !fir.ref<i8>, i64, i1) -> () 134 ! CHECK: %[[tmp2:.*]] = fir.allocmem !fir.array<2xf32> 135 ! CHECK: = fir.array_coor %[[array2]](%{{.*}}) %{{.*}} : (!fir.ref<!fir.array<2xf32>>, !fir.shape<1>, index) -> !fir.ref<f32> 136 ! CHECK: = fir.array_coor %[[tmp2]](%{{.*}}) %{{.*}} : (!fir.heap<!fir.array<2xf32>>, !fir.shape<1>, index) -> !fir.ref<f32> 137 ! CHECK: fir.call @llvm.memcpy.p0.p0.i64(%{{.*}}, %{{.*}}, %{{.*}}, %false{{.*}}) {{.*}}: (!fir.ref<i8>, !fir.ref<i8>, i64, i1) -> () 138 ! CHECK: = fir.array_coor %{{.*}}(%{{.*}}) %{{.*}} : (!fir.heap<!fir.array<4xf32>>, !fir.shape<1>, index) -> !fir.ref<f32> 139 ! CHECK: = fir.array_coor %[[a]] %{{.*}} : (!fir.box<!fir.array<?xf32>>, index) -> !fir.ref<f32> 140 ! CHECK-DAG: fir.freemem %{{.*}} : !fir.heap<!fir.array<4xf32>> 141 ! CHECK-DAG: fir.freemem %[[tmp2]] : !fir.heap<!fir.array<2xf32>> 142 ! CHECK-DAG: fir.freemem %[[tmp1]] : !fir.heap<!fir.array<2xf32>> 143 ! CHECK: return 144 a = [ const_array1, array2 ] 145end subroutine test5 146 147! CHECK-LABEL: func @_QPtest6( 148subroutine test6(c, d, e) 149 character(5) :: c(2) 150 character(5) :: d, e 151 ! CHECK: = fir.allocmem !fir.array<2x!fir.char<1,5>> 152 ! CHECK: fir.call @realloc 153 ! CHECK: %[[t:.*]] = fir.coordinate_of %{{.*}}, %{{.*}} : (!fir.heap<!fir.array<2x!fir.char<1,5>>>, index) -> !fir.ref<!fir.char<1,5>> 154 ! CHECK: %[[to:.*]] = fir.convert %[[t]] : (!fir.ref<!fir.char<1,5>>) -> !fir.ref<i8> 155 ! CHECK: fir.call @llvm.memcpy.p0.p0.i64(%[[to]], %{{.*}}, %{{.*}}, %false) {{.*}}: (!fir.ref<i8>, !fir.ref<i8>, i64, i1) -> () 156 ! CHECK: fir.call @realloc 157 ! CHECK: %[[t:.*]] = fir.coordinate_of %{{.*}}, %{{.*}} : (!fir.heap<!fir.array<2x!fir.char<1,5>>>, index) -> !fir.ref<!fir.char<1,5>> 158 ! CHECK: %[[to:.*]] = fir.convert %[[t]] : (!fir.ref<!fir.char<1,5>>) -> !fir.ref<i8> 159 ! CHECK: fir.call @llvm.memcpy.p0.p0.i64(%[[to]], %{{.*}}, %{{.*}}, %false) {{.*}}: (!fir.ref<i8>, !fir.ref<i8>, i64, i1) -> () 160 ! CHECK: fir.freemem %{{.*}} : !fir.heap<!fir.array<2x!fir.char<1,5>>> 161 c = (/ d, e /) 162end subroutine test6 163 164! CHECK-LABEL: func @_QPtest7( 165! CHECK: %[[i:.*]] = fir.convert %{{.*}} : (index) -> i8 166! CHECK: %[[und:.*]] = fir.undefined !fir.char<1> 167! CHECK: %[[scalar:.*]] = fir.insert_value %[[und]], %[[i]], [0 : index] : (!fir.char<1>, i8) -> !fir.char<1> 168! CHECK: ^bb{{[0-9]+}}(%{{.*}}: !fir.heap<!fir.char<1>>): // 2 preds 169! CHECK: fir.store %[[scalar]] to %{{.*}} : !fir.ref<!fir.char<1>> 170subroutine test7(a, n) 171 character(1) :: a(n) 172 a = (/ (CHAR(i), i=1,n) /) 173end subroutine test7 174 175! CHECK: fir.global internal @_QQro.3xr4.0(dense<[1.000000e+00, 2.000000e+00, 3.000000e+00]> : tensor<3xf32>) constant : !fir.array<3xf32> 176 177! CHECK: fir.global internal @_QQro.4xi4.1(dense<[6, 7, 42, 9]> : tensor<4xi32>) constant : !fir.array<4xi32> 178