152 lines · plain
1! Test different ways of passing the parent component of an extended2! derived-type to a subroutine or the runtime.3 4! RUN: bbc -emit-hlfir %s -o - | FileCheck %s5 6program parent_comp7 type p8 integer :: a9 end type10 11 type, extends(p) :: c12 integer :: b13 end type14 15 type z16 integer :: k17 type(c) :: c18 end type19 20 type(c) :: t(2) = [ c(11, 21), c(12, 22) ]21 call init_with_slice()22 call init_no_slice()23 call init_allocatable()24 call init_scalar()25 call init_assumed(t)26contains27 28 subroutine print_scalar(a)29 type(p), intent(in) :: a30 print*, a31 end subroutine32 ! CHECK-LABEL: func.func private @_QFPprint_scalar(%{{.*}}: !fir.ref<!fir.type<_QFTp{a:i32}>> {fir.bindc_name = "a"})33 34 subroutine print_p(a)35 type(p), intent(in) :: a(2)36 print*, a37 end subroutine38 ! CHECK-LABEL: func.func private @_QFPprint_p(%{{.*}}: !fir.ref<!fir.array<2x!fir.type<_QFTp{a:i32}>>> {fir.bindc_name = "a"})39 40 subroutine init_with_slice()41 type(c) :: y(2) = [ c(11, 21), c(12, 22) ]42 call print_p(y(:)%p)43 print*,y(:)%p44 end subroutine45 ! CHECK-LABEL: func.func private @_QFPinit_with_slice()46 ! CHECK: %[[VAL_0:.*]] = fir.alloca !fir.box<!fir.heap<!fir.array<2x!fir.type<_QFTp{a:i32}>>>>47 ! CHECK: %[[VAL_1:.*]] = fir.address_of(@_QFFinit_with_sliceEy) : !fir.ref<!fir.array<2x!fir.type<_QFTc{p:!fir.type<_QFTp{a:i32}>,b:i32}>>>48 ! CHECK: %[[VAL_2:.*]] = arith.constant 2 : index49 ! CHECK: %[[VAL_3:.*]] = fir.shape %[[VAL_2]] : (index) -> !fir.shape<1>50 ! CHECK: %[[VAL_4:.*]]:2 = hlfir.declare %[[VAL_1]](%[[VAL_3]]) {uniq_name = "_QFFinit_with_sliceEy"} : (!fir.ref<!fir.array<2x!fir.type<_QFTc{p:!fir.type<_QFTp{a:i32}>,b:i32}>>>, !fir.shape<1>) -> (!fir.ref<!fir.array<2x!fir.type<_QFTc{p:!fir.type<_QFTp{a:i32}>,b:i32}>>>, !fir.ref<!fir.array<2x!fir.type<_QFTc{p:!fir.type<_QFTp{a:i32}>,b:i32}>>>)51 ! CHECK: %[[VAL_5:.*]] = arith.constant 1 : index52 ! CHECK: %[[VAL_6:.*]] = arith.constant 1 : index53 ! CHECK: %[[VAL_7:.*]] = arith.constant 2 : index54 ! CHECK: %[[VAL_8:.*]] = fir.shape %[[VAL_7]] : (index) -> !fir.shape<1>55 ! CHECK: %[[VAL_9:.*]] = hlfir.designate %[[VAL_4]]#0 (%[[VAL_5]]:%[[VAL_2]]:%[[VAL_6]]) shape %[[VAL_8]] : (!fir.ref<!fir.array<2x!fir.type<_QFTc{p:!fir.type<_QFTp{a:i32}>,b:i32}>>>, index, index, index, !fir.shape<1>) -> !fir.ref<!fir.array<2x!fir.type<_QFTc{p:!fir.type<_QFTp{a:i32}>,b:i32}>>>56 ! CHECK: %[[VAL_10:.*]] = hlfir.designate %[[VAL_9]]{"p"} shape %[[VAL_8]] : (!fir.ref<!fir.array<2x!fir.type<_QFTc{p:!fir.type<_QFTp{a:i32}>,b:i32}>>>, !fir.shape<1>) -> !fir.box<!fir.array<2x!fir.type<_QFTp{a:i32}>>>57 ! CHECK: %[[VAL_11:.*]]:2 = hlfir.copy_in %[[VAL_10]] to %[[VAL_0]] : (!fir.box<!fir.array<2x!fir.type<_QFTp{a:i32}>>>, !fir.ref<!fir.box<!fir.heap<!fir.array<2x!fir.type<_QFTp{a:i32}>>>>>) -> (!fir.box<!fir.array<2x!fir.type<_QFTp{a:i32}>>>, i1)58 ! CHECK: %[[VAL_12:.*]] = fir.box_addr %[[VAL_11]]#0 : (!fir.box<!fir.array<2x!fir.type<_QFTp{a:i32}>>>) -> !fir.ref<!fir.array<2x!fir.type<_QFTp{a:i32}>>>59 ! CHECK: fir.call @_QFPprint_p(%[[VAL_12]]) fastmath<contract> : (!fir.ref<!fir.array<2x!fir.type<_QFTp{a:i32}>>>) -> ()60 ! CHECK: hlfir.copy_out %[[VAL_0]], %[[VAL_11]]#1 : (!fir.ref<!fir.box<!fir.heap<!fir.array<2x!fir.type<_QFTp{a:i32}>>>>>, i1) -> ()61 62 subroutine init_no_slice()63 type(c) :: y(2) = [ c(11, 21), c(12, 22) ]64 call print_p(y%p)65 print*,y%p66 end subroutine67 ! CHECK-LABEL: func.func private @_QFPinit_no_slice()68 ! CHECK: %[[VAL_0:.*]] = fir.alloca !fir.box<!fir.heap<!fir.array<2x!fir.type<_QFTp{a:i32}>>>>69 ! CHECK: %[[VAL_1:.*]] = fir.address_of(@_QFFinit_no_sliceEy) : !fir.ref<!fir.array<2x!fir.type<_QFTc{p:!fir.type<_QFTp{a:i32}>,b:i32}>>>70 ! CHECK: %[[VAL_2:.*]] = arith.constant 2 : index71 ! CHECK: %[[VAL_3:.*]] = fir.shape %[[VAL_2]] : (index) -> !fir.shape<1>72 ! CHECK: %[[VAL_4:.*]]:2 = hlfir.declare %[[VAL_1]](%[[VAL_3]]) {uniq_name = "_QFFinit_no_sliceEy"} : (!fir.ref<!fir.array<2x!fir.type<_QFTc{p:!fir.type<_QFTp{a:i32}>,b:i32}>>>, !fir.shape<1>) -> (!fir.ref<!fir.array<2x!fir.type<_QFTc{p:!fir.type<_QFTp{a:i32}>,b:i32}>>>, !fir.ref<!fir.array<2x!fir.type<_QFTc{p:!fir.type<_QFTp{a:i32}>,b:i32}>>>)73 ! CHECK: %[[VAL_5:.*]] = hlfir.designate %[[VAL_4]]#0{"p"} shape %[[VAL_3]] : (!fir.ref<!fir.array<2x!fir.type<_QFTc{p:!fir.type<_QFTp{a:i32}>,b:i32}>>>, !fir.shape<1>) -> !fir.box<!fir.array<2x!fir.type<_QFTp{a:i32}>>>74 ! CHECK: %[[VAL_6:.*]]:2 = hlfir.copy_in %[[VAL_5]] to %[[VAL_0]] : (!fir.box<!fir.array<2x!fir.type<_QFTp{a:i32}>>>, !fir.ref<!fir.box<!fir.heap<!fir.array<2x!fir.type<_QFTp{a:i32}>>>>>) -> (!fir.box<!fir.array<2x!fir.type<_QFTp{a:i32}>>>, i1)75 ! CHECK: %[[VAL_7:.*]] = fir.box_addr %[[VAL_6]]#0 : (!fir.box<!fir.array<2x!fir.type<_QFTp{a:i32}>>>) -> !fir.ref<!fir.array<2x!fir.type<_QFTp{a:i32}>>>76 ! CHECK: fir.call @_QFPprint_p(%[[VAL_7]]) fastmath<contract> : (!fir.ref<!fir.array<2x!fir.type<_QFTp{a:i32}>>>) -> ()77 ! CHECK: hlfir.copy_out %[[VAL_0]], %[[VAL_6]]#1 : (!fir.ref<!fir.box<!fir.heap<!fir.array<2x!fir.type<_QFTp{a:i32}>>>>>, i1) -> ()78 79 subroutine init_allocatable()80 type(c), allocatable :: y(:)81 allocate(y(2))82 y(1) = c(11, 21)83 y(2) = c(12, 22)84 call print_p(y%p)85 print*,y%p86 end subroutine87 88 ! CHECK-LABEL: func.func private @_QFPinit_allocatable()89 ! CHECK: %[[VAL_6:.*]]:2 = hlfir.declare %{{.*}}_QFFinit_allocatableEy"90 ! CHECK: hlfir.assign91 ! CHECK: hlfir.assign92 ! CHECK: %[[VAL_30:.*]] = fir.load %[[VAL_6]]#0 : !fir.ref<!fir.box<!fir.heap<!fir.array<?x!fir.type<_QFTc{p:!fir.type<_QFTp{a:i32}>,b:i32}>>>>>93 ! CHECK: %[[VAL_31:.*]] = arith.constant 0 : index94 ! CHECK: %[[VAL_32:.*]]:3 = fir.box_dims %[[VAL_30]], %[[VAL_31]] : (!fir.box<!fir.heap<!fir.array<?x!fir.type<_QFTc{p:!fir.type<_QFTp{a:i32}>,b:i32}>>>>, index) -> (index, index, index)95 ! CHECK: %[[VAL_33:.*]] = fir.shape %[[VAL_32]]#1 : (index) -> !fir.shape<1>96 ! CHECK: %[[VAL_34:.*]] = hlfir.designate %[[VAL_30]]{"p"} shape %[[VAL_33]] : (!fir.box<!fir.heap<!fir.array<?x!fir.type<_QFTc{p:!fir.type<_QFTp{a:i32}>,b:i32}>>>>, !fir.shape<1>) -> !fir.box<!fir.array<?x!fir.type<_QFTp{a:i32}>>>97 ! CHECK: %[[VAL_35:.*]]:2 = hlfir.copy_in %[[VAL_34]] to %[[VAL_0:.*]] : (!fir.box<!fir.array<?x!fir.type<_QFTp{a:i32}>>>, !fir.ref<!fir.box<!fir.heap<!fir.array<?x!fir.type<_QFTp{a:i32}>>>>>) -> (!fir.box<!fir.array<?x!fir.type<_QFTp{a:i32}>>>, i1)98 ! CHECK: %[[VAL_36:.*]] = fir.box_addr %[[VAL_35]]#0 : (!fir.box<!fir.array<?x!fir.type<_QFTp{a:i32}>>>) -> !fir.ref<!fir.array<?x!fir.type<_QFTp{a:i32}>>>99 ! CHECK: %[[VAL_37:.*]] = fir.convert %[[VAL_36]] : (!fir.ref<!fir.array<?x!fir.type<_QFTp{a:i32}>>>) -> !fir.ref<!fir.array<2x!fir.type<_QFTp{a:i32}>>>100 ! CHECK: fir.call @_QFPprint_p(%[[VAL_37]]) fastmath<contract> : (!fir.ref<!fir.array<2x!fir.type<_QFTp{a:i32}>>>) -> ()101 ! CHECK: hlfir.copy_out %[[VAL_0]], %[[VAL_35]]#1 : (!fir.ref<!fir.box<!fir.heap<!fir.array<?x!fir.type<_QFTp{a:i32}>>>>>, i1) -> ()102 103 subroutine init_scalar()104 type(c) :: s = c(11, 21)105 call print_scalar(s%p)106 print*,s%p107 end subroutine108 109 ! CHECK-LABEL: func.func private @_QFPinit_scalar()110 ! CHECK: %[[VAL_0:.*]] = fir.address_of(@_QFFinit_scalarEs) : !fir.ref<!fir.type<_QFTc{p:!fir.type<_QFTp{a:i32}>,b:i32}>>111 ! CHECK: %[[VAL_1:.*]]:2 = hlfir.declare %[[VAL_0]] {uniq_name = "_QFFinit_scalarEs"} : (!fir.ref<!fir.type<_QFTc{p:!fir.type<_QFTp{a:i32}>,b:i32}>>) -> (!fir.ref<!fir.type<_QFTc{p:!fir.type<_QFTp{a:i32}>,b:i32}>>, !fir.ref<!fir.type<_QFTc{p:!fir.type<_QFTp{a:i32}>,b:i32}>>)112 ! CHECK: %[[VAL_2:.*]] = hlfir.designate %[[VAL_1]]#0{"p"} : (!fir.ref<!fir.type<_QFTc{p:!fir.type<_QFTp{a:i32}>,b:i32}>>) -> !fir.ref<!fir.type<_QFTp{a:i32}>>113 ! CHECK: fir.call @_QFPprint_scalar(%[[VAL_2]]) fastmath<contract> : (!fir.ref<!fir.type<_QFTp{a:i32}>>) -> ()114 115 subroutine init_assumed(y)116 type(c) :: y(:)117 call print_p(y%p)118 print*,y%p119 end subroutine120 121 ! CHECK-LABEL: func.func private @_QFPinit_assumed(122 ! CHECK: %[[VAL_3:.*]]:2 = hlfir.declare %{{.*}}"_QFFinit_assumedEy"123 ! CHECK: %[[VAL_4:.*]] = arith.constant 0 : index124 ! CHECK: %[[VAL_5:.*]]:3 = fir.box_dims %[[VAL_3]]#0, %[[VAL_4]] : (!fir.box<!fir.array<?x!fir.type<_QFTc{p:!fir.type<_QFTp{a:i32}>,b:i32}>>>, index) -> (index, index, index)125 ! CHECK: %[[VAL_6:.*]] = fir.shape %[[VAL_5]]#1 : (index) -> !fir.shape<1>126 ! CHECK: %[[VAL_7:.*]] = hlfir.designate %[[VAL_3]]#0{"p"} shape %[[VAL_6]] : (!fir.box<!fir.array<?x!fir.type<_QFTc{p:!fir.type<_QFTp{a:i32}>,b:i32}>>>, !fir.shape<1>) -> !fir.box<!fir.array<?x!fir.type<_QFTp{a:i32}>>>127 128 subroutine init_existing_field()129 type(z) :: y(2)130 call print_p(y%c%p)131 end subroutine132 133 ! CHECK-LABEL: func.func private @_QFPinit_existing_field134 ! CHECK: %[[VAL_4:.*]]:2 = hlfir.declare %{{.*}}"_QFFinit_existing_fieldEy"135 ! CHECK: %[[VAL_5:.*]] = hlfir.designate %[[VAL_4]]#0{"c"} shape %[[VAL_3:.*]] : (!fir.ref<!fir.array<2x!fir.type<_QFTz{k:i32,c:!fir.type<_QFTc{p:!fir.type<_QFTp{a:i32}>,b:i32}>}>>>, !fir.shape<1>) -> !fir.box<!fir.array<2x!fir.type<_QFTc{p:!fir.type<_QFTp{a:i32}>,b:i32}>>>136 ! CHECK: %[[VAL_6:.*]] = hlfir.designate %[[VAL_5]]{"p"} shape %[[VAL_3]] : (!fir.box<!fir.array<2x!fir.type<_QFTc{p:!fir.type<_QFTp{a:i32}>,b:i32}>>>, !fir.shape<1>) -> !fir.box<!fir.array<2x!fir.type<_QFTp{a:i32}>>>137 138 subroutine parent_comp_lhs()139 type(c) :: a140 type(p) :: b141 142 a%p = B143 end subroutine144 145! CHECK-LABEL: func.func private @_QFPparent_comp_lhs146! CHECK: %[[VAL_1:.*]]:2 = hlfir.declare %{{.*}}"_QFFparent_comp_lhsEa"147! CHECK: %[[VAL_3:.*]]:2 = hlfir.declare %{{.*}}"_QFFparent_comp_lhsEb"148! CHECK: %[[VAL_4:.*]] = hlfir.designate %[[VAL_1]]#0{"p"} : (!fir.ref<!fir.type<_QFTc{p:!fir.type<_QFTp{a:i32}>,b:i32}>>) -> !fir.ref<!fir.type<_QFTp{a:i32}>>149! CHECK: hlfir.assign %[[VAL_3]]#0 to %[[VAL_4]] : !fir.ref<!fir.type<_QFTp{a:i32}>>, !fir.ref<!fir.type<_QFTp{a:i32}>>150 151end152