1! RUN: bbc -emit-fir -hlfir=false %s -o - | FileCheck %s 2 3! Test passing allocatables on caller side 4 5! CHECK-LABEL: func @_QPtest_scalar_call( 6subroutine test_scalar_call() 7 interface 8 subroutine test_scalar(x) 9 real, allocatable :: x 10 end subroutine 11 end interface 12 real, allocatable :: x 13 ! CHECK: %[[box:.*]] = fir.alloca !fir.box<!fir.heap<f32>> {{{.*}}uniq_name = "_QFtest_scalar_callEx"} 14 call test_scalar(x) 15 ! CHECK: fir.call @_QPtest_scalar(%[[box]]) {{.*}}: (!fir.ref<!fir.box<!fir.heap<f32>>>) -> () 16end subroutine 17 18! CHECK-LABEL: func @_QPtest_array_call( 19subroutine test_array_call() 20 interface 21 subroutine test_array(x) 22 integer, allocatable :: x(:) 23 end subroutine 24 end interface 25 integer, allocatable :: x(:) 26 ! CHECK: %[[box:.*]] = fir.alloca !fir.box<!fir.heap<!fir.array<?xi32>>> {{{.*}}uniq_name = "_QFtest_array_callEx"} 27 call test_array(x) 28 ! CHECK: fir.call @_QPtest_array(%[[box]]) {{.*}}: (!fir.ref<!fir.box<!fir.heap<!fir.array<?xi32>>>>) -> () 29end subroutine 30 31! CHECK-LABEL: func @_QPtest_char_scalar_deferred_call( 32subroutine test_char_scalar_deferred_call() 33 interface 34 subroutine test_char_scalar_deferred(x) 35 character(:), allocatable :: x 36 end subroutine 37 end interface 38 character(:), allocatable :: x 39 ! CHECK: %[[box:.*]] = fir.alloca !fir.box<!fir.heap<!fir.char<1,?>>> {{{.*}}uniq_name = "_QFtest_char_scalar_deferred_callEx"} 40 call test_char_scalar_deferred(x) 41 ! CHECK: fir.call @_QPtest_char_scalar_deferred(%[[box]]) {{.*}}: (!fir.ref<!fir.box<!fir.heap<!fir.char<1,?>>>>) -> () 42end subroutine 43 44! CHECK-LABEL: func @_QPtest_char_scalar_explicit_call( 45subroutine test_char_scalar_explicit_call(n) 46 integer :: n 47 interface 48 subroutine test_char_scalar_explicit(x) 49 character(10), allocatable :: x 50 end subroutine 51 end interface 52 character(10), allocatable :: x 53 character(n), allocatable :: x2 54 ! CHECK-DAG: %[[box:.*]] = fir.alloca !fir.box<!fir.heap<!fir.char<1,10>>> {{{.*}}uniq_name = "_QFtest_char_scalar_explicit_callEx"} 55 ! CHECK-DAG: %[[box2:.*]] = fir.alloca !fir.box<!fir.heap<!fir.char<1,?>>> {{{.*}}uniq_name = "_QFtest_char_scalar_explicit_callEx2"} 56 call test_char_scalar_explicit(x) 57 ! CHECK: fir.call @_QPtest_char_scalar_explicit(%[[box]]) {{.*}}: (!fir.ref<!fir.box<!fir.heap<!fir.char<1,10>>>>) -> () 58 call test_char_scalar_explicit(x2) 59 ! CHECK: %[[box2cast:.*]] = fir.convert %[[box2]] : (!fir.ref<!fir.box<!fir.heap<!fir.char<1,?>>>>) -> !fir.ref<!fir.box<!fir.heap<!fir.char<1,10>>>> 60 ! CHECK: fir.call @_QPtest_char_scalar_explicit(%[[box2cast]]) {{.*}}: (!fir.ref<!fir.box<!fir.heap<!fir.char<1,10>>>>) -> () 61end subroutine 62 63! CHECK-LABEL: func @_QPtest_char_array_deferred_call( 64subroutine test_char_array_deferred_call() 65 interface 66 subroutine test_char_array_deferred(x) 67 character(:), allocatable :: x(:) 68 end subroutine 69 end interface 70 character(:), allocatable :: x(:) 71 ! CHECK: %[[box:.*]] = fir.alloca !fir.box<!fir.heap<!fir.array<?x!fir.char<1,?>>>> {{{.*}}uniq_name = "_QFtest_char_array_deferred_callEx"} 72 call test_char_array_deferred(x) 73 ! CHECK: fir.call @_QPtest_char_array_deferred(%[[box]]) {{.*}}: (!fir.ref<!fir.box<!fir.heap<!fir.array<?x!fir.char<1,?>>>>>) -> () 74end subroutine 75 76! CHECK-LABEL: func @_QPtest_char_array_explicit_call( 77subroutine test_char_array_explicit_call(n) 78 integer :: n 79 interface 80 subroutine test_char_array_explicit(x) 81 character(10), allocatable :: x(:) 82 end subroutine 83 end interface 84 character(10), allocatable :: x(:) 85 character(n), allocatable :: x2(:) 86 ! CHECK-DAG: %[[box:.*]] = fir.alloca !fir.box<!fir.heap<!fir.array<?x!fir.char<1,10>>>> {{{.*}}uniq_name = "_QFtest_char_array_explicit_callEx"} 87 ! CHECK-DAG: %[[box2:.*]] = fir.alloca !fir.box<!fir.heap<!fir.array<?x!fir.char<1,?>>>> {{{.*}}uniq_name = "_QFtest_char_array_explicit_callEx2"} 88 call test_char_array_explicit(x) 89 ! CHECK: fir.call @_QPtest_char_array_explicit(%[[box]]) {{.*}}: (!fir.ref<!fir.box<!fir.heap<!fir.array<?x!fir.char<1,10>>>>>) -> () 90 call test_char_array_explicit(x2) 91 ! CHECK: %[[box2cast:.*]] = fir.convert %[[box2]] : (!fir.ref<!fir.box<!fir.heap<!fir.array<?x!fir.char<1,?>>>>>) -> !fir.ref<!fir.box<!fir.heap<!fir.array<?x!fir.char<1,10>>>>> 92 ! CHECK: fir.call @_QPtest_char_array_explicit(%[[box2cast]]) {{.*}}: (!fir.ref<!fir.box<!fir.heap<!fir.array<?x!fir.char<1,10>>>>>) -> () 93end subroutine 94