120 lines · plain
1! Test lowering of whole allocatable and pointer components to HLFIR2! RUN: bbc -emit-hlfir -o - %s -I nw | FileCheck %s3 4module def_test_types5 type t16 real, pointer :: p(:)7 end type8 type t29 real, allocatable :: a(:)10 end type11 type t312 real, pointer, contiguous :: p_contiguous(:)13 end type14 type t415 character(:), pointer :: char_p(:)16 end type17 type t518 character(10), allocatable :: char_a(:)19 end type20 interface21 subroutine takes_pointer(y)22 real, pointer :: y(:)23 end subroutine24 subroutine takes_contiguous_pointer(y)25 real, pointer, contiguous :: y(:)26 end subroutine27 subroutine takes_allocatable(y)28 real, allocatable :: y(:)29 end subroutine30 subroutine takes_char_pointer(y)31 character(:), pointer :: y(:)32 end subroutine33 subroutine takes_char_alloc_cst_len(y)34 character(10), allocatable :: y(:)35 end subroutine36 subroutine takes_array(y)37 real :: y(*)38 end subroutine39 subroutine takes_char_array(y)40 character(*) :: y(*)41 end subroutine42 43 end interface44end module45 46subroutine passing_pointer(x)47 use def_test_types48 implicit none49 type(t1) :: x50 call takes_pointer(x%p)51end subroutine52! CHECK-LABEL: func.func @_QPpassing_pointer(53! CHECK: %[[VAL_1:.*]]:2 = hlfir.declare %[[VAL_0:[a-z0-9]*]] {{.*}}Ex54! CHECK: %[[VAL_2:.*]] = hlfir.designate %[[VAL_1]]#0{"p"} {fortran_attrs = #fir.var_attrs<pointer>} : (!fir.ref<!fir.type<_QMdef_test_typesTt1{p:!fir.box<!fir.ptr<!fir.array<?xf32>>>}>>) -> !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>55! CHECK: fir.call @_QPtakes_pointer(%[[VAL_2]]) {{.*}}: (!fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>) -> ()56 57subroutine passing_allocatable(x)58 use def_test_types59 implicit none60 type(t2) :: x61 call takes_allocatable(x%a)62 call takes_array(x%a)63end subroutine64! CHECK-LABEL: func.func @_QPpassing_allocatable(65! CHECK: %[[VAL_1:.*]]:2 = hlfir.declare %[[VAL_0:[a-z0-9]*]] {{.*}}Ex66! CHECK: %[[VAL_2:.*]] = hlfir.designate %[[VAL_1]]#0{"a"} {fortran_attrs = #fir.var_attrs<allocatable>} : (!fir.ref<!fir.type<_QMdef_test_typesTt2{a:!fir.box<!fir.heap<!fir.array<?xf32>>>}>>) -> !fir.ref<!fir.box<!fir.heap<!fir.array<?xf32>>>>67! CHECK: fir.call @_QPtakes_allocatable(%[[VAL_2]]) {{.*}}: (!fir.ref<!fir.box<!fir.heap<!fir.array<?xf32>>>>) -> ()68! CHECK: %[[VAL_3:.*]] = hlfir.designate %[[VAL_1]]#0{"a"} {fortran_attrs = #fir.var_attrs<allocatable>} : (!fir.ref<!fir.type<_QMdef_test_typesTt2{a:!fir.box<!fir.heap<!fir.array<?xf32>>>}>>) -> !fir.ref<!fir.box<!fir.heap<!fir.array<?xf32>>>>69! CHECK: %[[VAL_4:.*]] = fir.load %[[VAL_3]] : !fir.ref<!fir.box<!fir.heap<!fir.array<?xf32>>>>70! CHECK: %[[VAL_5:.*]] = fir.box_addr %[[VAL_4]] : (!fir.box<!fir.heap<!fir.array<?xf32>>>) -> !fir.heap<!fir.array<?xf32>>71! CHECK: %[[VAL_6:.*]] = fir.convert %[[VAL_5]] : (!fir.heap<!fir.array<?xf32>>) -> !fir.ref<!fir.array<?xf32>>72! CHECK: fir.call @_QPtakes_array(%[[VAL_6]]) {{.*}}: (!fir.ref<!fir.array<?xf32>>) -> ()73 74subroutine passing_contiguous_pointer(x)75 use def_test_types76 type(t3) :: x77 call takes_contiguous_pointer(x%p_contiguous)78 call takes_array(x%p_contiguous)79end subroutine80! CHECK-LABEL: func.func @_QPpassing_contiguous_pointer(81! CHECK: %[[VAL_1:.*]]:2 = hlfir.declare %[[VAL_0:[a-z0-9]*]] {{.*}}Ex82! CHECK: %[[VAL_2:.*]] = hlfir.designate %[[VAL_1]]#0{"p_contiguous"} {fortran_attrs = #fir.var_attrs<contiguous, pointer>} : (!fir.ref<!fir.type<_QMdef_test_typesTt3{p_contiguous:!fir.box<!fir.ptr<!fir.array<?xf32>>>}>>) -> !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>83! CHECK: fir.call @_QPtakes_contiguous_pointer(%[[VAL_2]]) {{.*}}: (!fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>) -> ()84! CHECK: %[[VAL_3:.*]] = hlfir.designate %[[VAL_1]]#0{"p_contiguous"} {fortran_attrs = #fir.var_attrs<contiguous, pointer>} : (!fir.ref<!fir.type<_QMdef_test_typesTt3{p_contiguous:!fir.box<!fir.ptr<!fir.array<?xf32>>>}>>) -> !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>85! CHECK: %[[VAL_4:.*]] = fir.load %[[VAL_3]] : !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>86! CHECK: %[[VAL_5:.*]] = fir.box_addr %[[VAL_4]] : (!fir.box<!fir.ptr<!fir.array<?xf32>>>) -> !fir.ptr<!fir.array<?xf32>>87! CHECK: %[[VAL_6:.*]] = fir.convert %[[VAL_5]] : (!fir.ptr<!fir.array<?xf32>>) -> !fir.ref<!fir.array<?xf32>>88! CHECK: fir.call @_QPtakes_array(%[[VAL_6]]) {{.*}}: (!fir.ref<!fir.array<?xf32>>) -> ()89 90subroutine passing_char_pointer(x)91 use def_test_types92 implicit none93 type(t4) :: x94 call takes_char_pointer(x%char_p)95end subroutine96! CHECK-LABEL: func.func @_QPpassing_char_pointer(97! CHECK: %[[VAL_1:.*]]:2 = hlfir.declare %[[VAL_0:[a-z0-9]*]] {{.*}}Ex98! CHECK: %[[VAL_2:.*]] = hlfir.designate %[[VAL_1]]#0{"char_p"} {fortran_attrs = #fir.var_attrs<pointer>} : (!fir.ref<!fir.type<_QMdef_test_typesTt4{char_p:!fir.box<!fir.ptr<!fir.array<?x!fir.char<1,?>>>>}>>) -> !fir.ref<!fir.box<!fir.ptr<!fir.array<?x!fir.char<1,?>>>>>99! CHECK: fir.call @_QPtakes_char_pointer(%[[VAL_2]]) {{.*}}: (!fir.ref<!fir.box<!fir.ptr<!fir.array<?x!fir.char<1,?>>>>>) -> ()100 101subroutine passing_char_alloc_cst_len(x)102 use def_test_types103 implicit none104 type(t5) :: x105 call takes_char_alloc_cst_len(x%char_a)106 call takes_char_array(x%char_a)107end subroutine108! CHECK-LABEL: func.func @_QPpassing_char_alloc_cst_len(109! CHECK: %[[VAL_1:.*]]:2 = hlfir.declare %[[VAL_0:[a-z0-9]*]] {{.*}}Ex110! CHECK: %[[VAL_2:.*]] = arith.constant 10 : index111! CHECK: %[[VAL_3:.*]] = hlfir.designate %[[VAL_1]]#0{"char_a"} typeparams %[[VAL_2]] {fortran_attrs = #fir.var_attrs<allocatable>} : (!fir.ref<!fir.type<_QMdef_test_typesTt5{char_a:!fir.box<!fir.heap<!fir.array<?x!fir.char<1,10>>>>}>>, index) -> !fir.ref<!fir.box<!fir.heap<!fir.array<?x!fir.char<1,10>>>>>112! CHECK: fir.call @_QPtakes_char_alloc_cst_len(%[[VAL_3]]) {{.*}}: (!fir.ref<!fir.box<!fir.heap<!fir.array<?x!fir.char<1,10>>>>>) -> ()113! CHECK: %[[VAL_4:.*]] = arith.constant 10 : index114! CHECK: %[[VAL_5:.*]] = hlfir.designate %[[VAL_1]]#0{"char_a"} typeparams %[[VAL_4]] {fortran_attrs = #fir.var_attrs<allocatable>} : (!fir.ref<!fir.type<_QMdef_test_typesTt5{char_a:!fir.box<!fir.heap<!fir.array<?x!fir.char<1,10>>>>}>>, index) -> !fir.ref<!fir.box<!fir.heap<!fir.array<?x!fir.char<1,10>>>>>115! CHECK: %[[VAL_6:.*]] = fir.load %[[VAL_5]] : !fir.ref<!fir.box<!fir.heap<!fir.array<?x!fir.char<1,10>>>>>116! CHECK: %[[VAL_7:.*]] = fir.box_addr %[[VAL_6]] : (!fir.box<!fir.heap<!fir.array<?x!fir.char<1,10>>>>) -> !fir.heap<!fir.array<?x!fir.char<1,10>>>117! CHECK: %[[VAL_8:.*]] = fir.convert %[[VAL_7]] : (!fir.heap<!fir.array<?x!fir.char<1,10>>>) -> !fir.ref<!fir.char<1,10>>118! CHECK: %[[VAL_9:.*]] = fir.emboxchar %[[VAL_8]], %[[VAL_4]] : (!fir.ref<!fir.char<1,10>>, index) -> !fir.boxchar<1>119! CHECK: fir.call @_QPtakes_char_array(%[[VAL_9]]) {{.*}}: (!fir.boxchar<1>) -> ()120