1! RUN: bbc -emit-fir -hlfir=false %s -o - | FileCheck %s 2 3! Tests the different possible type involving polymorphic entities. 4 5module polymorphic_types 6 type p1 7 integer :: a 8 integer :: b 9 contains 10 procedure :: polymorphic_dummy 11 end type 12contains 13 14! ------------------------------------------------------------------------------ 15! Test polymorphic entity types 16! ------------------------------------------------------------------------------ 17 18 subroutine polymorphic_dummy(p) 19 class(p1) :: p 20 end subroutine 21 22! CHECK-LABEL: func.func @_QMpolymorphic_typesPpolymorphic_dummy( 23! CHECK-SAME: %{{.*}}: !fir.class<!fir.type<_QMpolymorphic_typesTp1{a:i32,b:i32}>> 24 25 subroutine polymorphic_dummy_assumed_shape_array(pa) 26 class(p1) :: pa(:) 27 end subroutine 28 29! CHECK-LABEL: func.func @_QMpolymorphic_typesPpolymorphic_dummy_assumed_shape_array( 30! CHECK-SAME: %{{.*}}: !fir.class<!fir.array<?x!fir.type<_QMpolymorphic_typesTp1{a:i32,b:i32}>>> 31 32 subroutine polymorphic_dummy_explicit_shape_array(pa) 33 class(p1) :: pa(10) 34 end subroutine 35 36! CHECK-LABEL: func.func @_QMpolymorphic_typesPpolymorphic_dummy_explicit_shape_array( 37! CHECK-SAME: %{{.*}}: !fir.class<!fir.array<10x!fir.type<_QMpolymorphic_typesTp1{a:i32,b:i32}>>> 38 39 subroutine polymorphic_allocatable(p) 40 class(p1), allocatable :: p 41 end subroutine 42 43! CHECK-LABEL: func.func @_QMpolymorphic_typesPpolymorphic_allocatable( 44! CHECK-SAME: %{{.*}}: !fir.ref<!fir.class<!fir.heap<!fir.type<_QMpolymorphic_typesTp1{a:i32,b:i32}>>>> 45 46 subroutine polymorphic_pointer(p) 47 class(p1), pointer :: p 48 end subroutine 49 50! CHECK-LABEL: func.func @_QMpolymorphic_typesPpolymorphic_pointer( 51! CHECK-SAME: %{{.*}}: !fir.ref<!fir.class<!fir.ptr<!fir.type<_QMpolymorphic_typesTp1{a:i32,b:i32}>>>> 52 53 subroutine polymorphic_allocatable_intentout(p) 54 class(p1), allocatable, intent(out) :: p 55 end subroutine 56 57! CHECK-LABEL: func.func @_QMpolymorphic_typesPpolymorphic_allocatable_intentout( 58! CHECK-SAME: %[[ARG0:.*]]: !fir.ref<!fir.class<!fir.heap<!fir.type<_QMpolymorphic_typesTp1{a:i32,b:i32}>>>> 59! CHECK: %[[BOX_NONE:.*]] = fir.convert %[[ARG0]] : (!fir.ref<!fir.class<!fir.heap<!fir.type<_QMpolymorphic_typesTp1{a:i32,b:i32}>>>>) -> !fir.ref<!fir.box<none>> 60! CHECK: %{{.*}} = fir.call @_FortranAAllocatableDeallocatePolymorphic(%[[BOX_NONE]], %{{.*}}, %{{.*}}, %{{.*}}, %{{.*}}) {{.*}}: (!fir.ref<!fir.box<none>>, !fir.ref<none>, i1, !fir.box<none>, !fir.ref<i8>, i32) -> i32 61 62! ------------------------------------------------------------------------------ 63! Test unlimited polymorphic dummy argument types 64! ------------------------------------------------------------------------------ 65 66 subroutine unlimited_polymorphic_dummy(u) 67 class(*) :: u 68 end subroutine 69 70! CHECK-LABEL: func.func @_QMpolymorphic_typesPunlimited_polymorphic_dummy( 71! CHECK-SAME: %{{.*}}: !fir.class<none> 72 73 subroutine unlimited_polymorphic_assumed_shape_array(ua) 74 class(*) :: ua(:) 75 end subroutine 76 77! CHECK-LABEL: func.func @_QMpolymorphic_typesPunlimited_polymorphic_assumed_shape_array( 78! CHECK-SAME: %{{.*}}: !fir.class<!fir.array<?xnone>> 79 80 subroutine unlimited_polymorphic_explicit_shape_array(ua) 81 class(*) :: ua(20) 82 end subroutine 83 84! CHECK-LABEL: func.func @_QMpolymorphic_typesPunlimited_polymorphic_explicit_shape_array( 85! CHECK-SAME: %{{.*}}: !fir.class<!fir.array<20xnone>> 86 87 subroutine unlimited_polymorphic_allocatable(p) 88 class(*), allocatable :: p 89 end subroutine 90 91! CHECK-LABEL: func.func @_QMpolymorphic_typesPunlimited_polymorphic_allocatable( 92! CHECK-SAME: %{{.*}}: !fir.ref<!fir.class<!fir.heap<none>>> 93 94 subroutine unlimited_polymorphic_pointer(p) 95 class(*), pointer :: p 96 end subroutine 97 98! CHECK-LABEL: func.func @_QMpolymorphic_typesPunlimited_polymorphic_pointer( 99! CHECK-SAME: %{{.*}}: !fir.ref<!fir.class<!fir.ptr<none>>> 100 101 subroutine unlimited_polymorphic_allocatable_intentout(p) 102 class(*), allocatable, intent(out) :: p 103 end subroutine 104 105! CHECK-LABEL: func.func @_QMpolymorphic_typesPunlimited_polymorphic_allocatable_intentout( 106! CHECK-SAME: %[[ARG0:.*]]: !fir.ref<!fir.class<!fir.heap<none>>> 107! CHECK: %[[BOX_NONE:.*]] = fir.convert %[[ARG0]] : (!fir.ref<!fir.class<!fir.heap<none>>>) -> !fir.ref<!fir.box<none>> 108! CHECK: %{{.*}} = fir.call @_FortranAAllocatableDeallocatePolymorphic(%[[BOX_NONE]], %{{.*}}, %{{.*}}, %{{.*}}, %{{.*}}) {{.*}}: (!fir.ref<!fir.box<none>>, !fir.ref<none>, i1, !fir.box<none>, !fir.ref<i8>, i32) -> i32 109 110! ------------------------------------------------------------------------------ 111! Test polymorphic function return types 112! ------------------------------------------------------------------------------ 113 114 function ret_polymorphic_allocatable() result(ret) 115 class(p1), allocatable :: ret 116 end function 117 118! CHECK-LABEL: func.func @_QMpolymorphic_typesPret_polymorphic_allocatable() -> !fir.class<!fir.heap<!fir.type<_QMpolymorphic_typesTp1{a:i32,b:i32}>>> 119! CHECK: %[[MEM:.*]] = fir.alloca !fir.class<!fir.heap<!fir.type<_QMpolymorphic_typesTp1{a:i32,b:i32}>>> {bindc_name = "ret", uniq_name = "_QMpolymorphic_typesFret_polymorphic_allocatableEret"} 120! CHECK: %[[ZERO:.*]] = fir.zero_bits !fir.heap<!fir.type<_QMpolymorphic_typesTp1{a:i32,b:i32}>> 121! CHECK: %[[BOX:.*]] = fir.embox %[[ZERO]] : (!fir.heap<!fir.type<_QMpolymorphic_typesTp1{a:i32,b:i32}>>) -> !fir.class<!fir.heap<!fir.type<_QMpolymorphic_typesTp1{a:i32,b:i32}>>> 122! CHECK: fir.store %[[BOX]] to %[[MEM]] : !fir.ref<!fir.class<!fir.heap<!fir.type<_QMpolymorphic_typesTp1{a:i32,b:i32}>>>> 123! CHECK: %[[LOAD:.*]] = fir.load %[[MEM]] : !fir.ref<!fir.class<!fir.heap<!fir.type<_QMpolymorphic_typesTp1{a:i32,b:i32}>>>> 124! CHECK: return %[[LOAD]] : !fir.class<!fir.heap<!fir.type<_QMpolymorphic_typesTp1{a:i32,b:i32}>>> 125 126 function ret_polymorphic_pointer() result(ret) 127 class(p1), pointer :: ret 128 end function 129 130! CHECK-LABEL: func.func @_QMpolymorphic_typesPret_polymorphic_pointer() -> !fir.class<!fir.ptr<!fir.type<_QMpolymorphic_typesTp1{a:i32,b:i32}>>> 131! CHECK: %[[MEM:.*]] = fir.alloca !fir.class<!fir.ptr<!fir.type<_QMpolymorphic_typesTp1{a:i32,b:i32}>>> {bindc_name = "ret", uniq_name = "_QMpolymorphic_typesFret_polymorphic_pointerEret"} 132! CHECK: %[[ZERO:.*]] = fir.zero_bits !fir.ptr<!fir.type<_QMpolymorphic_typesTp1{a:i32,b:i32}>> 133! CHECK: %[[BOX:.*]] = fir.embox %[[ZERO]] : (!fir.ptr<!fir.type<_QMpolymorphic_typesTp1{a:i32,b:i32}>>) -> !fir.class<!fir.ptr<!fir.type<_QMpolymorphic_typesTp1{a:i32,b:i32}>>> 134! CHECK: fir.store %[[BOX]] to %[[MEM]] : !fir.ref<!fir.class<!fir.ptr<!fir.type<_QMpolymorphic_typesTp1{a:i32,b:i32}>>>> 135! CHECK: %[[LOAD:.*]] = fir.load %[[MEM]] : !fir.ref<!fir.class<!fir.ptr<!fir.type<_QMpolymorphic_typesTp1{a:i32,b:i32}>>>> 136! CHECK: return %[[LOAD]] : !fir.class<!fir.ptr<!fir.type<_QMpolymorphic_typesTp1{a:i32,b:i32}>>> 137 138! ------------------------------------------------------------------------------ 139! Test unlimited polymorphic function return types 140! ------------------------------------------------------------------------------ 141 142 function ret_unlimited_polymorphic_allocatable() result(ret) 143 class(*), allocatable :: ret 144 end function 145 146! CHECK-LABEL: func.func @_QMpolymorphic_typesPret_unlimited_polymorphic_allocatable() -> !fir.class<!fir.heap<none>> 147! CHECK: %[[MEM:.*]] = fir.alloca !fir.class<!fir.heap<none>> {bindc_name = "ret", uniq_name = "_QMpolymorphic_typesFret_unlimited_polymorphic_allocatableEret"} 148! CHECK: %[[ZERO:.*]] = fir.zero_bits !fir.heap<none> 149! CHECK: %[[BOX:.*]] = fir.embox %[[ZERO]] : (!fir.heap<none>) -> !fir.class<!fir.heap<none>> 150! CHECK: fir.store %[[BOX]] to %[[MEM]] : !fir.ref<!fir.class<!fir.heap<none>>> 151! CHECK: %[[LOAD:.*]] = fir.load %[[MEM]] : !fir.ref<!fir.class<!fir.heap<none>>> 152! CHECK: return %[[LOAD]] : !fir.class<!fir.heap<none>> 153 154 function ret_unlimited_polymorphic_pointer() result(ret) 155 class(*), pointer :: ret 156 end function 157 158! CHECK-LABEL: func.func @_QMpolymorphic_typesPret_unlimited_polymorphic_pointer() -> !fir.class<!fir.ptr<none>> 159! CHECK: %[[MEM:.*]] = fir.alloca !fir.class<!fir.ptr<none>> {bindc_name = "ret", uniq_name = "_QMpolymorphic_typesFret_unlimited_polymorphic_pointerEret"} 160! CHECK: %[[ZERO:.*]] = fir.zero_bits !fir.ptr<none> 161! CHECK: %[[BOX:.*]] = fir.embox %[[ZERO]] : (!fir.ptr<none>) -> !fir.class<!fir.ptr<none>> 162! CHECK: fir.store %[[BOX]] to %[[MEM]] : !fir.ref<!fir.class<!fir.ptr<none>>> 163! CHECK: %[[LOAD:.*]] = fir.load %[[MEM]] : !fir.ref<!fir.class<!fir.ptr<none>>> 164! CHECK: return %[[LOAD]] : !fir.class<!fir.ptr<none>> 165 166! ------------------------------------------------------------------------------ 167! Test assumed type argument types 168! ------------------------------------------------------------------------------ 169 170 subroutine assumed_type_dummy(a) bind(c) 171 type(*) :: a 172 end subroutine assumed_type_dummy 173 174 ! CHECK-LABEL: func.func @assumed_type_dummy( 175 ! CHECK-SAME: %{{.*}}: !fir.ref<none> 176 177 subroutine assumed_type_dummy_array(a) bind(c) 178 type(*) :: a(:) 179 end subroutine assumed_type_dummy_array 180 181 ! CHECK-LABEL: func.func @assumed_type_dummy_array( 182 ! CHECK-SAME: %{{.*}}: !fir.box<!fir.array<?xnone>> 183 184end module 185