1166 lines · plain
1! RUN: bbc --use-desc-for-alloc=false -emit-fir -hlfir=false %s -o - | FileCheck %s2 3! Tests various aspect of the lowering of polymorphic entities.4 5module polymorphic_test6 type p17 integer :: a8 integer :: b9 contains10 procedure :: print11 procedure :: assign_p1_int12 procedure :: elemental_fct13 procedure :: elemental_sub14 procedure, pass(this) :: elemental_sub_pass15 procedure :: read_p116 procedure :: write_p117 generic :: read(formatted) => read_p118 generic :: write(formatted) => write_p119 generic :: assignment(=) => assign_p1_int20 procedure :: host_assoc21 procedure, pass(poly) :: lt22 generic :: operator(<) => lt23 end type24 25 type, extends(p1) :: p226 real :: c = 10.527 end type28 29 type r130 real, pointer :: rp(:) => null()31 end type32 33 type c134 character(2) :: tmp = 'c1'35 contains36 procedure :: get_tmp37 end type38 39 type p340 class(p3), pointer :: p(:)41 end type42 43 type outer44 type(p1) :: inner45 end type46 47 type non_extensible48 sequence49 integer :: d50 end type51 52 type :: p453 class(p1), allocatable :: a(:)54 end type55 56 type :: p557 class(*), allocatable :: up58 end type59 60 contains61 62 elemental subroutine assign_p1_int(lhs, rhs)63 class(p1), intent(inout) :: lhs64 integer, intent(in) :: rhs65 lhs%a = rhs66 lhs%b = rhs67 End Subroutine68 69! CHECK-LABEL: func.func @_QMpolymorphic_testPhost_assoc(70! CHECK-SAME: %[[THIS:.*]]: !fir.class<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>) {71! CHECK: %[[TUPLE:.*]] = fir.alloca tuple<!fir.class<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>>72! CHECK: %[[POS_IN_TUPLE:.*]] = arith.constant 0 : i3273! CHECK: %[[COORD_OF_CLASS:.*]] = fir.coordinate_of %[[TUPLE]], %[[POS_IN_TUPLE]] : (!fir.ref<tuple<!fir.class<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>>>, i32) -> !fir.ref<!fir.class<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>>74! CHECK: fir.store %[[THIS]] to %[[COORD_OF_CLASS]] : !fir.ref<!fir.class<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>>75! CHECK: fir.call @_QMpolymorphic_testFhost_assocPinternal(%[[TUPLE]]) {{.*}} : (!fir.ref<tuple<!fir.class<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>>>) -> ()76 77 elemental integer function elemental_fct(this)78 class(p1), intent(in) :: this79 elemental_fct = this%a80 end function81 82 elemental subroutine elemental_sub(this)83 class(p1), intent(inout) :: this84 this%a = this%a * this%b85 end subroutine86 87 elemental subroutine elemental_sub_pass(c, this)88 integer, intent(in) :: c89 class(p1), intent(inout) :: this90 this%a = this%a * this%b + c91 end subroutine92 93 logical elemental function lt(i, poly)94 integer, intent(in) :: i95 class(p1), intent(in) :: poly96 lt = i < poly%a97 End Function98 99 ! Test correct access to polymorphic entity component.100 subroutine component_access(p)101 class(p1) :: p102 print*, p%a103 end subroutine104 105! CHECK-LABEL: func.func @_QMpolymorphic_testPcomponent_access(106! CHECK-SAME: %[[P:.*]]: !fir.class<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>> {fir.bindc_name = "p"}) {107! CHECK: %[[COORD:.*]] = fir.coordinate_of %[[P]], a : (!fir.class<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>) -> !fir.ref<i32>108! CHECK: %[[LOAD:.*]] = fir.load %[[COORD]] : !fir.ref<i32>109! CHECK: %{{.*}} = fir.call @_FortranAioOutputInteger32(%{{.*}}, %[[LOAD]]) {{.*}}: (!fir.ref<i8>, i32) -> i1110 111 subroutine print(this)112 class(p1) :: this113 end subroutine114 115 ! Test embox of fir.type to fir.class to be passed-object.116 subroutine check()117 type(p1) :: t1118 type(p2) :: t2119 call t1%print()120 call t2%print()121 end subroutine122 123! CHECK-LABEL: func.func @_QMpolymorphic_testPcheck()124! CHECK: %[[DT1:.*]] = fir.alloca !fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}> {bindc_name = "t1", uniq_name = "_QMpolymorphic_testFcheckEt1"}125! CHECK: %[[DT2:.*]] = fir.alloca !fir.type<_QMpolymorphic_testTp2{a:i32,b:i32,c:f32}> {bindc_name = "t2", uniq_name = "_QMpolymorphic_testFcheckEt2"}126! CHECK: %[[CLASS1:.*]] = fir.embox %[[DT1]] : (!fir.ref<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>) -> !fir.class<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>127! CHECK: fir.call @_QMpolymorphic_testPprint(%[[CLASS1]]) {{.*}}: (!fir.class<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>) -> ()128! CHECK: %[[BOX2:.*]] = fir.embox %[[DT2]] : (!fir.ref<!fir.type<_QMpolymorphic_testTp2{a:i32,b:i32,c:f32}>>) -> !fir.class<!fir.type<_QMpolymorphic_testTp2{a:i32,b:i32,c:f32}>>129! CHECK: %[[CLASS2:.*]] = fir.convert %[[BOX2]] : (!fir.class<!fir.type<_QMpolymorphic_testTp2{a:i32,b:i32,c:f32}>>) -> !fir.class<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>130! CHECK: fir.call @_QMpolymorphic_testPprint(%[[CLASS2]]) {{.*}}: (!fir.class<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>) -> ()131 132 subroutine test_allocate_unlimited_polymorphic_non_derived()133 class(*), pointer :: u134 allocate(integer::u)135 end subroutine136 137! CHECK-LABEL: test_allocate_unlimited_polymorphic_non_derived138! CHECK-NOT: _FortranAPointerNullifyDerived139! CHECK: fir.call @_FortranAPointerAllocate140 141 function test_fct_ret_class()142 class(p1), pointer :: test_fct_ret_class143 end function144 145 subroutine call_fct()146 class(p1), pointer :: p147 p => test_fct_ret_class()148 end subroutine149 150! CHECK-LABEL: func.func @_QMpolymorphic_testPtest_fct_ret_class() -> !fir.class<!fir.ptr<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>>151! CHECK: return %{{.*}} : !fir.class<!fir.ptr<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>>152 153! CHECK-LABEL: func.func @_QMpolymorphic_testPcall_fct()154! CHECK: %[[RESULT:.*]] = fir.alloca !fir.class<!fir.ptr<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>> {bindc_name = ".result"}155! CHECK: %[[CALL_RES:.*]] = fir.call @_QMpolymorphic_testPtest_fct_ret_class() {{.*}}: () -> !fir.class<!fir.ptr<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>>156! CHECK: fir.save_result %[[CALL_RES]] to %[[RESULT]] : !fir.class<!fir.ptr<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>>, !fir.ref<!fir.class<!fir.ptr<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>>>157 158 subroutine implicit_loop_with_polymorphic()159 class(p1), allocatable :: p(:)160 allocate(p(3))161 p%a = [ 1, 2, 3 ]162 end subroutine163 164! CHECK-LABEL: func.func @_QMpolymorphic_testPimplicit_loop_with_polymorphic() {165! CHECK: %{{.*}} = fir.array_load %{{.*}}(%{{.*}}) [%{{.*}}] : (!fir.class<!fir.heap<!fir.array<?x!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>>>, !fir.shift<1>, !fir.slice<1>) -> !fir.array<?xi32>166! CHECK: %{{.*}} = fir.do_loop %{{.*}} = %{{.*}} to %{{.*}} step %{{.*}} unordered iter_args(%{{.*}} = %{{.*}}) -> (!fir.array<?xi32>) {167! CHECK: %{{.*}} = fir.array_fetch %{{.*}}, %{{.*}} : (!fir.array<3xi32>, index) -> i32168! CHECK: %{{.*}} = fir.array_update %{{.*}}, %{{.*}}, %{{.*}} : (!fir.array<?xi32>, i32, index) -> !fir.array<?xi32>169! CHECK: }170! CHECK: fir.array_merge_store %{{.*}}, %{{.*}} to %{{.*}}[%{{.*}}] : !fir.array<?xi32>, !fir.array<?xi32>, !fir.class<!fir.heap<!fir.array<?x!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>>>, !fir.slice<1>171 172 subroutine polymorphic_to_nonpolymorphic(p)173 class(p1), pointer :: p(:)174 type(p1), allocatable, target :: t(:)175 t = p176 end subroutine177 178! CHECK-LABEL: func.func @_QMpolymorphic_testPpolymorphic_to_nonpolymorphic179! Just checking that FIR is generated without error.180 181 subroutine nonpolymorphic_to_polymorphic(p, t)182 type p1183 end type184 type(p1), pointer :: p(:)185 class(p1), target :: t(:)186 p(0:1) => t187 end subroutine188 189! CHECK-LABEL: func.func @_QMpolymorphic_testPnonpolymorphic_to_polymorphic190! CHECK: fir.call @_FortranAPointerAssociateRemappingMonomorphic191 192! Test that lowering does not crash for function return with unlimited193! polymoprhic value.194 195 function up_ret()196 class(*), pointer :: up_ret(:)197 end function198 199! CHECK-LABEL: func.func @_QMpolymorphic_testPup_ret() -> !fir.class<!fir.ptr<!fir.array<?xnone>>> {200 201 subroutine call_up_ret()202 class(*), pointer :: p(:)203 p => up_ret()204 end subroutine205 206! CHECK-LABEL: func.func @_QMpolymorphic_testPcall_up_ret() {207! CHECK: %{{.*}} = fir.call @_QMpolymorphic_testPup_ret() {{.*}} : () -> !fir.class<!fir.ptr<!fir.array<?xnone>>>208 209 subroutine associate_up_pointer(r)210 class(r1) :: r211 class(*), pointer :: p(:)212 p => r%rp213 end subroutine214 215! CHECK-LABEL: func.func @_QMpolymorphic_testPassociate_up_pointer(216! CHECK-SAME: %[[ARG0:.*]]: !fir.class<!fir.type<_QMpolymorphic_testTr1{rp:!fir.box<!fir.ptr<!fir.array<?xf32>>>}>> {fir.bindc_name = "r"}) {217! CHECK: %[[P:.*]] = fir.alloca !fir.class<!fir.ptr<!fir.array<?xnone>>> {bindc_name = "p", uniq_name = "_QMpolymorphic_testFassociate_up_pointerEp"}218! CHECK: %[[COORD_RP:.*]] = fir.coordinate_of %[[ARG0]], rp : (!fir.class<!fir.type<_QMpolymorphic_testTr1{rp:!fir.box<!fir.ptr<!fir.array<?xf32>>>}>>) -> !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>219! CHECK: %[[LOAD_RP:.*]] = fir.load %[[COORD_RP]] : !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>220! CHECK: %[[REBOX_RP:.*]] = fir.rebox %[[LOAD_RP]](%{{.*}}) : (!fir.box<!fir.ptr<!fir.array<?xf32>>>, !fir.shift<1>) -> !fir.box<!fir.array<?xf32>>221! CHECK: %[[CONV_P:.*]] = fir.convert %[[P]] : (!fir.ref<!fir.class<!fir.ptr<!fir.array<?xnone>>>>) -> !fir.ref<!fir.box<none>>222! CHECK: %[[RP_BOX_NONE:.*]] = fir.convert %[[REBOX_RP]] : (!fir.box<!fir.array<?xf32>>) -> !fir.box<none>223! CHECK: fir.call @_FortranAPointerAssociate(%[[CONV_P]], %[[RP_BOX_NONE]]) {{.*}} : (!fir.ref<!fir.box<none>>, !fir.box<none>) -> ()224! CHECK: return225 226! Test that the fir.dispatch operation is created with the correct pass object227! and the pass_arg_pos attribute is incremented correctly when character228! function result is added as argument.229 230 function get_tmp(this)231 class(c1) :: this232 character(2) :: get_tmp233 get_tmp = this%tmp234 end function235 236 subroutine call_get_tmp(c)237 class(c1) :: c238 print*, c%get_tmp()239 end subroutine240 241! CHECK-LABEL: func.func @_QMpolymorphic_testPcall_get_tmp(242! CHECK-SAME: %[[ARG0:.*]]: !fir.class<!fir.type<_QMpolymorphic_testTc1{tmp:!fir.char<1,2>}>> {fir.bindc_name = "c"}) {243! CHECK: %{{.*}} = fir.dispatch "get_tmp"(%[[ARG0]] : !fir.class<!fir.type<_QMpolymorphic_testTc1{tmp:!fir.char<1,2>}>>) (%{{.*}}, %{{.*}}, %[[ARG0]] : !fir.ref<!fir.char<1,2>>, index, !fir.class<!fir.type<_QMpolymorphic_testTc1{tmp:!fir.char<1,2>}>>) -> !fir.boxchar<1> {pass_arg_pos = 2 : i32}244 245 subroutine sub_with_type_array(a)246 type(p1) :: a(:)247 end subroutine248 249! CHECK-LABEL: func.func @_QMpolymorphic_testPsub_with_type_array(%{{.*}}: !fir.box<!fir.array<?x!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>> {fir.bindc_name = "a"})250 251 subroutine call_sub_with_type_array(p)252 class(p1), pointer :: p(:)253 call sub_with_type_array(p)254 end subroutine255 256! CHECK-LABEL: func.func @_QMpolymorphic_testPcall_sub_with_type_array(257! CHECK-SAME: %[[ARG0:.*]]: !fir.ref<!fir.class<!fir.ptr<!fir.array<?x!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>>>> {fir.bindc_name = "p"}) {258! CHECK: %[[CLASS:.*]] = fir.load %[[ARG0]] : !fir.ref<!fir.class<!fir.ptr<!fir.array<?x!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>>>>259! CHECK: %[[REBOX:.*]] = fir.rebox %[[CLASS]] : (!fir.class<!fir.ptr<!fir.array<?x!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>>>) -> !fir.box<!fir.array<?x!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>>260! CHECK: fir.call @_QMpolymorphic_testPsub_with_type_array(%[[REBOX]]) {{.*}} : (!fir.box<!fir.array<?x!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>>) -> ()261 262 subroutine derived_type_assignment_with_class()263 type(p3) :: a264 type(p3), target :: b(10)265 a = p3(b)266 end subroutine267 268 subroutine takes_p1(p)269 class(p1), intent(in) :: p270 end subroutine271 272! TODO: implement polymorphic temporary in lowering273! subroutine no_reassoc_poly_value(a, i)274! class(p1), intent(in) :: a(:)275! integer :: i276! call takes_p1((a(i)))277! end subroutine278 279! Test pointer assignment with non polymorphic lhs and polymorphic rhs280 281 subroutine pointer_assign_parent(p)282 type(p2), target :: p283 type(p1), pointer :: tp284 tp => p%p1285 end subroutine286 287! First test is here to have a reference with non polymorphic on both sides.288! CHECK-LABEL: func.func @_QMpolymorphic_testPpointer_assign_parent(289! CHECK-SAME: %[[ARG0:.*]]: !fir.ref<!fir.type<_QMpolymorphic_testTp2{a:i32,b:i32,c:f32}>> {fir.bindc_name = "p", fir.target}) {290! CHECK: %[[PTR:.*]] = fir.alloca !fir.ptr<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>> {uniq_name = "_QMpolymorphic_testFpointer_assign_parentEtp.addr"}291! CHECK: %[[ZERO:.*]] = fir.zero_bits !fir.ptr<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>292! CHECK: fir.store %[[ZERO]] to %[[PTR]] : !fir.ref<!fir.ptr<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>>293! CHECK: %[[CONVERT:.*]] = fir.convert %[[ARG0]] : (!fir.ref<!fir.type<_QMpolymorphic_testTp2{a:i32,b:i32,c:f32}>>) -> !fir.ptr<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>294! CHECK: fir.store %[[CONVERT]] to %[[PTR]] : !fir.ref<!fir.ptr<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>>295 296 subroutine pointer_assign_non_poly(p)297 class(p1), target :: p298 type(p1), pointer :: tp299 tp => p300 end subroutine301 302! CHECK-LABEL: func.func @_QMpolymorphic_testPpointer_assign_non_poly(303! CHECK-SAME: %arg0: !fir.class<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>> {fir.bindc_name = "p", fir.target}) {304! CHECK: %[[PTR:.*]] = fir.alloca !fir.ptr<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>> {uniq_name = "_QMpolymorphic_testFpointer_assign_non_polyEtp.addr"}305! CHECK: %[[ZERO:.*]] = fir.zero_bits !fir.ptr<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>306! CHECK: fir.store %[[ZERO]] to %[[PTR]] : !fir.ref<!fir.ptr<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>>307! CHECK: %[[BOX_ADDR:.*]] = fir.box_addr %[[ARG0]] : (!fir.class<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>) -> !fir.ref<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>308! CHECK: %[[CONVERT:.*]] = fir.convert %{{[0-9]+}} : (!fir.ref<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>) -> !fir.ptr<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>309! CHECK: fir.store %[[CONVERT]] to %[[PTR]] : !fir.ref<!fir.ptr<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>>310 311 subroutine nullify_pointer_array(a)312 type(p3) :: a313 nullify(a%p)314 end subroutine315 316! CHECK-LABEL: func.func @_QMpolymorphic_testPnullify_pointer_array(317! CHECK-SAME: %[[ARG0:.*]]: !fir.ref<!fir.type<_QMpolymorphic_testTp3{p:!fir.class<!fir.ptr<!fir.array<?x!fir.type<_QMpolymorphic_testTp3>>>>}>> {fir.bindc_name = "a"}) {318! CHECK: %[[COORD_P:.*]] = fir.coordinate_of %[[ARG0]], p : (!fir.ref<!fir.type<_QMpolymorphic_testTp3{p:!fir.class<!fir.ptr<!fir.array<?x!fir.type<_QMpolymorphic_testTp3>>>>}>>) -> !fir.ref<!fir.class<!fir.ptr<!fir.array<?x!fir.type<_QMpolymorphic_testTp3{p:!fir.class<!fir.ptr<!fir.array<?x!fir.type<_QMpolymorphic_testTp3>>>>}>>>>>319! CHECK: %[[TYPE_DESC:.*]] = fir.type_desc !fir.type<_QMpolymorphic_testTp3{p:!fir.class<!fir.ptr<!fir.array<?x!fir.type<_QMpolymorphic_testTp3>>>>}>320! CHECK: %[[CONV_P:.*]] = fir.convert %[[COORD_P]] : (!fir.ref<!fir.class<!fir.ptr<!fir.array<?x!fir.type<_QMpolymorphic_testTp3{p:!fir.class<!fir.ptr<!fir.array<?x!fir.type<_QMpolymorphic_testTp3>>>>}>>>>>) -> !fir.ref<!fir.box<none>>321! CHECK: %[[CONV_TDESC:.*]] = fir.convert %[[TYPE_DESC]] : (!fir.tdesc<!fir.type<_QMpolymorphic_testTp3{p:!fir.class<!fir.ptr<!fir.array<?x!fir.type<_QMpolymorphic_testTp3>>>>}>>) -> !fir.ref<none>322! CHECK: %[[C1:.*]] = arith.constant 1 : i32323! CHECK: %[[C0:.*]] = arith.constant 0 : i32324! CHECK: fir.call @_FortranAPointerNullifyDerived(%[[CONV_P]], %[[CONV_TDESC]], %[[C1]], %[[C0]]) {{.*}} : (!fir.ref<!fir.box<none>>, !fir.ref<none>, i32, i32) -> ()325 326 subroutine up_input(a)327 class(*), intent(in) :: a328 end subroutine329 330 subroutine pass_trivial_to_up()331 call up_input('hello')332 call up_input(1)333 call up_input(2.5)334 call up_input(.true.)335 call up_input((-1.0,3))336 end subroutine337 338! CHECK-LABEL: func.func @_QMpolymorphic_testPpass_trivial_to_up() {339! CHECK: %[[CHAR:.*]] = fir.address_of(@_QQclX{{.*}}) : !fir.ref<!fir.char<1,5>>340! CHECK: %[[BOX_CHAR:.*]] = fir.embox %[[CHAR]] : (!fir.ref<!fir.char<1,5>>) -> !fir.class<none>341! CHECK: fir.call @_QMpolymorphic_testPup_input(%[[BOX_CHAR]]) {{.*}} : (!fir.class<none>) -> ()342 343! CHECK: %[[BOX_INT:.*]] = fir.embox %{{.*}} : (!fir.ref<i32>) -> !fir.class<none>344! CHECK: fir.call @_QMpolymorphic_testPup_input(%[[BOX_INT]]) {{.*}} : (!fir.class<none>) -> ()345 346! CHECK: %[[BOX_REAL:.*]] = fir.embox %{{.*}} : (!fir.ref<f32>) -> !fir.class<none>347! CHECK: fir.call @_QMpolymorphic_testPup_input(%[[BOX_REAL]]) {{.*}} : (!fir.class<none>) -> ()348 349! CHECK: %[[BOX_LOG:.*]] = fir.embox %{{.*}} : (!fir.ref<!fir.logical<4>>) -> !fir.class<none>350! CHECK: fir.call @_QMpolymorphic_testPup_input(%[[BOX_LOG]]) {{.*}} : (!fir.class<none>) -> ()351 352! CHECK: %[[BOX_COMPLEX:.*]] = fir.embox %{{.*}} : (!fir.ref<complex<f32>>) -> !fir.class<none>353! CHECK: fir.call @_QMpolymorphic_testPup_input(%[[BOX_COMPLEX]]) {{.*}} : (!fir.class<none>) -> ()354 355 subroutine up_arr_input(a)356 class(*), intent(in) :: a(2)357 end subroutine358 359 subroutine pass_trivial_arr_to_up()360 character :: c(2)361 integer :: i(2)362 real :: r(2)363 logical :: l(2)364 complex :: cx(2)365 366 call up_arr_input(c)367 call up_arr_input(i)368 call up_arr_input(r)369 call up_arr_input(l)370 call up_arr_input(cx)371 end subroutine372 373! CHECK-LABEL: func.func @_QMpolymorphic_testPpass_trivial_arr_to_up() {374! CHECK: %[[BOX_CHAR:.*]] = fir.embox %{{.*}}(%{{.*}}) : (!fir.ref<!fir.array<2x!fir.char<1>>>, !fir.shape<1>) -> !fir.class<!fir.array<2xnone>>375! CHECK: fir.call @_QMpolymorphic_testPup_arr_input(%[[BOX_CHAR]]) {{.*}} : (!fir.class<!fir.array<2xnone>>) -> ()376 377! CHECK: %[[BOX_INT:.*]] = fir.embox %{{.*}}(%{{.*}}) : (!fir.ref<!fir.array<2xi32>>, !fir.shape<1>) -> !fir.class<!fir.array<2xnone>>378! CHECK: fir.call @_QMpolymorphic_testPup_arr_input(%[[BOX_INT]]) {{.*}} : (!fir.class<!fir.array<2xnone>>) -> ()379 380! CHECK: %[[BOX_REAL:.*]] = fir.embox %{{.*}}(%{{.*}}) : (!fir.ref<!fir.array<2xf32>>, !fir.shape<1>) -> !fir.class<!fir.array<2xnone>>381! CHECK: fir.call @_QMpolymorphic_testPup_arr_input(%[[BOX_REAL]]) {{.*}} : (!fir.class<!fir.array<2xnone>>) -> ()382 383! CHECK: %[[BOX_LOG:.*]] = fir.embox %{{.*}}(%{{.*}}) : (!fir.ref<!fir.array<2x!fir.logical<4>>>, !fir.shape<1>) -> !fir.class<!fir.array<2xnone>>384! CHECK: fir.call @_QMpolymorphic_testPup_arr_input(%[[BOX_LOG]]) {{.*}} : (!fir.class<!fir.array<2xnone>>) -> ()385 386! CHECK: %[[BOX_COMPLEX:.*]] = fir.embox %{{.*}}(%{{.*}}) : (!fir.ref<!fir.array<2xcomplex<f32>>>, !fir.shape<1>) -> !fir.class<!fir.array<2xnone>>387! CHECK: fir.call @_QMpolymorphic_testPup_arr_input(%[[BOX_COMPLEX]]) {{.*}} : (!fir.class<!fir.array<2xnone>>) -> ()388 389 subroutine assign_polymorphic_allocatable()390 type(p1), target :: t(10,20)391 class(p1), allocatable :: c(:,:)392 c = t393 end subroutine394 395! CHECK-LABEL: func.func @_QMpolymorphic_testPassign_polymorphic_allocatable() {396! CHECK: %[[C:.*]] = fir.alloca !fir.class<!fir.heap<!fir.array<?x?x!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>>> {bindc_name = "c", uniq_name = "_QMpolymorphic_testFassign_polymorphic_allocatableEc"}397! CHECK: %[[ZERO:.*]] = fir.zero_bits !fir.heap<!fir.array<?x?x!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>>398! CHECK: %[[C0:.*]] = arith.constant 0 : index399! CHECK: %[[SHAPE_C:.*]] = fir.shape %[[C0]], %[[C0]] : (index, index) -> !fir.shape<2>400! CHECK: %[[EMBOX:.*]] = fir.embox %[[ZERO]](%[[SHAPE_C]]) : (!fir.heap<!fir.array<?x?x!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>>, !fir.shape<2>) -> !fir.class<!fir.heap<!fir.array<?x?x!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>>>401! CHECK: fir.store %[[EMBOX]] to %[[C]] : !fir.ref<!fir.class<!fir.heap<!fir.array<?x?x!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>>>>402! CHECK: %[[C10:.*]] = arith.constant 10 : index403! CHECK: %[[C20:.*]] = arith.constant 20 : index404! CHECK: %[[T:.*]] = fir.alloca !fir.array<10x20x!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>> {bindc_name = "t", fir.target, uniq_name = "_QMpolymorphic_testFassign_polymorphic_allocatableEt"}405! CHECK: %[[SHAPE:.*]] = fir.shape %[[C10]], %[[C20]] : (index, index) -> !fir.shape<2>406! CHECK: %[[BOXED_T:.*]] = fir.embox %[[T]](%[[SHAPE]]) : (!fir.ref<!fir.array<10x20x!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>>, !fir.shape<2>) -> !fir.box<!fir.array<10x20x!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>>407! CHECK: %[[CONV_C:.*]] = fir.convert %[[C]] : (!fir.ref<!fir.class<!fir.heap<!fir.array<?x?x!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>>>>) -> !fir.ref<!fir.box<none>>408! CHECK: %[[CONV_BOXED_T:.*]] = fir.convert %[[BOXED_T]] : (!fir.box<!fir.array<10x20x!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>>) -> !fir.box<none>409! CHECK: fir.call @_FortranAAssignPolymorphic(%[[CONV_C]], %[[CONV_BOXED_T]], %{{.*}}, %{{.*}}) fastmath<contract> : (!fir.ref<!fir.box<none>>, !fir.box<none>, !fir.ref<i8>, i32) -> ()410! CHECK: return411 412 subroutine pointer_assign_remap()413 class(p1), pointer :: a(:)414 class(p1), pointer :: p(:,:)415 class(p1), pointer :: q(:)416 allocate(a(100))417 p(1:10,1:10) => a418 q(0:99) => a419 end subroutine420 421! CHECK-LABEL: func.func @_QMpolymorphic_testPpointer_assign_remap() {422! CHECK: %[[A:.*]] = fir.alloca !fir.class<!fir.ptr<!fir.array<?x!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>>> {bindc_name = "a", uniq_name = "_QMpolymorphic_testFpointer_assign_remapEa"}423! CHECK: %[[P:.*]] = fir.alloca !fir.class<!fir.ptr<!fir.array<?x?x!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>>> {bindc_name = "p", uniq_name = "_QMpolymorphic_testFpointer_assign_remapEp"}424! CHECK: %[[Q:.*]] = fir.alloca !fir.class<!fir.ptr<!fir.array<?x!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>>> {bindc_name = "q", uniq_name = "_QMpolymorphic_testFpointer_assign_remapEq"}425! CHECK: %[[C1_0:.*]] = arith.constant 1 : i64426! CHECK: %[[C10_0:.*]] = arith.constant 10 : i64427! CHECK: %[[C1_1:.*]] = arith.constant 1 : i64428! CHECK: %[[C10_1:.*]] = arith.constant 10 : i64429! CHECK: %[[LOAD_A:.*]] = fir.load %[[A]] : !fir.ref<!fir.class<!fir.ptr<!fir.array<?x!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>>>>430! CHECK: %[[REBOX_A:.*]] = fir.rebox %[[LOAD_A]](%{{.*}}) : (!fir.class<!fir.ptr<!fir.array<?x!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>>>, !fir.shift<1>) -> !fir.class<!fir.array<?x!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>>431! CHECK: %[[BOUND_ARRAY:.*]] = fir.alloca !fir.array<2x2xi64>432! CHECK: %[[ARRAY:.*]] = fir.undefined !fir.array<2x2xi64>433! CHECK: %[[ARRAY0:.*]] = fir.insert_value %[[ARRAY]], %[[C1_0]], [0 : index, 0 : index] : (!fir.array<2x2xi64>, i64) -> !fir.array<2x2xi64>434! CHECK: %[[ARRAY1:.*]] = fir.insert_value %[[ARRAY0]], %[[C10_0]], [1 : index, 0 : index] : (!fir.array<2x2xi64>, i64) -> !fir.array<2x2xi64>435! CHECK: %[[ARRAY2:.*]] = fir.insert_value %[[ARRAY1]], %[[C1_1]], [0 : index, 1 : index] : (!fir.array<2x2xi64>, i64) -> !fir.array<2x2xi64>436! CHECK: %[[ARRAY3:.*]] = fir.insert_value %[[ARRAY2]], %[[C10_1]], [1 : index, 1 : index] : (!fir.array<2x2xi64>, i64) -> !fir.array<2x2xi64>437! CHECK: fir.store %[[ARRAY3]] to %[[BOUND_ARRAY]] : !fir.ref<!fir.array<2x2xi64>>438! CHECK: %[[C2_0:.*]] = arith.constant 2 : index439! CHECK: %[[C2_1:.*]] = arith.constant 2 : index440! CHECK: %[[BOUND_ARRAY_SHAPE:.*]] = fir.shape %[[C2_1]], %[[C2_0]] : (index, index) -> !fir.shape<2>441! CHECK: %[[BOXED_BOUND_ARRAY:.*]] = fir.embox %[[BOUND_ARRAY]](%[[BOUND_ARRAY_SHAPE]]) : (!fir.ref<!fir.array<2x2xi64>>, !fir.shape<2>) -> !fir.box<!fir.array<2x2xi64>>442! CHECK: %[[ARG0:.*]] = fir.convert %[[P]] : (!fir.ref<!fir.class<!fir.ptr<!fir.array<?x?x!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>>>>) -> !fir.ref<!fir.box<none>>443! CHECK: %[[ARG1:.*]] = fir.convert %[[REBOX_A]] : (!fir.class<!fir.array<?x!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>>) -> !fir.box<none>444! CHECK: %[[ARG2:.*]] = fir.convert %[[BOXED_BOUND_ARRAY]] : (!fir.box<!fir.array<2x2xi64>>) -> !fir.box<none>445! CHECK: fir.call @_FortranAPointerAssociateRemapping(%[[ARG0]], %[[ARG1]], %[[ARG2]], %{{.*}}, %{{.*}}) {{.*}} : (!fir.ref<!fir.box<none>>, !fir.box<none>, !fir.box<none>, !fir.ref<i8>, i32) -> ()446 447! CHECK: %[[C0:.*]] = arith.constant 0 : i64448! CHECK: %[[C99:.*]] = arith.constant 99 : i64449! CHECK: %[[LOAD_A:.*]] = fir.load %[[A]] : !fir.ref<!fir.class<!fir.ptr<!fir.array<?x!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>>>>450! CHECK: %[[REBOX_A:.*]] = fir.rebox %[[LOAD_A]](%{{.*}}) : (!fir.class<!fir.ptr<!fir.array<?x!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>>>, !fir.shift<1>) -> !fir.class<!fir.array<?x!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>>451! CHECK: %[[BOUND_ARRAY:.*]] = fir.alloca !fir.array<2x1xi64>452! CHECK: %[[ARRAY:.*]] = fir.undefined !fir.array<2x1xi64>453! CHECK: %[[ARRAY0:.*]] = fir.insert_value %[[ARRAY]], %[[C0]], [0 : index, 0 : index] : (!fir.array<2x1xi64>, i64) -> !fir.array<2x1xi64>454! CHECK: %[[ARRAY1:.*]] = fir.insert_value %[[ARRAY0]], %[[C99]], [1 : index, 0 : index] : (!fir.array<2x1xi64>, i64) -> !fir.array<2x1xi64>455! CHECK: fir.store %[[ARRAY1]] to %[[BOUND_ARRAY]] : !fir.ref<!fir.array<2x1xi64>>456! CHECK: %[[C1:.*]] = arith.constant 1 : index457! CHECK: %[[C2:.*]] = arith.constant 2 : index458! CHECK: %[[BOUND_ARRAY_SHAPE:.*]] = fir.shape %[[C2]], %[[C1]] : (index, index) -> !fir.shape<2>459! CHECK: %[[BOXED_BOUND_ARRAY:.*]] = fir.embox %[[BOUND_ARRAY]](%[[BOUND_ARRAY_SHAPE]]) : (!fir.ref<!fir.array<2x1xi64>>, !fir.shape<2>) -> !fir.box<!fir.array<2x1xi64>>460! CHECK: %[[ARG0:.*]] = fir.convert %[[Q]] : (!fir.ref<!fir.class<!fir.ptr<!fir.array<?x!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>>>>) -> !fir.ref<!fir.box<none>>461! CHECK: %[[ARG1:.*]] = fir.convert %[[REBOX_A]] : (!fir.class<!fir.array<?x!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>>) -> !fir.box<none>462! CHECK: %[[ARG2:.*]] = fir.convert %[[BOXED_BOUND_ARRAY]] : (!fir.box<!fir.array<2x1xi64>>) -> !fir.box<none>463! CHECK: fir.call @_FortranAPointerAssociateRemapping(%[[ARG0]], %[[ARG1]], %[[ARG2]], %{{.*}}, %{{.*}}) {{.*}} : (!fir.ref<!fir.box<none>>, !fir.box<none>, !fir.box<none>, !fir.ref<i8>, i32) -> ()464 465 subroutine pointer_assign_lower_bounds()466 class(p1), allocatable, target :: a(:)467 class(p1), pointer :: p(:)468 allocate(a(100))469 p(-50:) => a470 end subroutine471 472! CHECK-LABEL: func.func @_QMpolymorphic_testPpointer_assign_lower_bounds() {473! CHECK: %[[A:.*]] = fir.alloca !fir.class<!fir.heap<!fir.array<?x!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>>> {bindc_name = "a", fir.target, uniq_name = "_QMpolymorphic_testFpointer_assign_lower_boundsEa"}474! CHECK: %[[P:.*]] = fir.alloca !fir.class<!fir.ptr<!fir.array<?x!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>>> {bindc_name = "p", uniq_name = "_QMpolymorphic_testFpointer_assign_lower_boundsEp"}475! CHECK: %[[LB:.*]] = arith.constant -50 : i64476! CHECK: %[[REBOX_A:.*]] = fir.rebox %{{.*}}(%{{.*}}) : (!fir.class<!fir.heap<!fir.array<?x!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>>>, !fir.shift<1>) -> !fir.class<!fir.array<?x!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>>477! CHECK: %[[LBOUND_ARRAY:.*]] = fir.alloca !fir.array<1xi64>478! CHECK: %[[ARRAY:.*]] = fir.undefined !fir.array<1xi64>479! CHECK: %[[ARRAY0:.*]] = fir.insert_value %[[ARRAY]], %[[LB]], [0 : index] : (!fir.array<1xi64>, i64) -> !fir.array<1xi64>480! CHECK: fir.store %[[ARRAY0]] to %[[LBOUND_ARRAY]] : !fir.ref<!fir.array<1xi64>>481! CHECK: %[[C1:.*]] = arith.constant 1 : index482! CHECK: %[[LBOUND_ARRAY_SHAPE:.*]] = fir.shape %[[C1]] : (index) -> !fir.shape<1>483! CHECK: %[[LBOUND_ARRAY_BOXED:.*]] = fir.embox %[[LBOUND_ARRAY]](%[[LBOUND_ARRAY_SHAPE]]) : (!fir.ref<!fir.array<1xi64>>, !fir.shape<1>) -> !fir.box<!fir.array<1xi64>>484! CHECK: %[[P_BOX_NONE:.*]] = fir.convert %[[P]] : (!fir.ref<!fir.class<!fir.ptr<!fir.array<?x!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>>>>) -> !fir.ref<!fir.box<none>>485! CHECK: %[[A_BOX_NONE:.*]] = fir.convert %[[REBOX_A]] : (!fir.class<!fir.array<?x!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>>) -> !fir.box<none>486! CHECK: %[[LBOUNDS_BOX_NONE:.*]] = fir.convert %[[LBOUND_ARRAY_BOXED]] : (!fir.box<!fir.array<1xi64>>) -> !fir.box<none>487! CHECK: fir.call @_FortranAPointerAssociateLowerBounds(%[[P_BOX_NONE]], %[[A_BOX_NONE]], %[[LBOUNDS_BOX_NONE]]) {{.*}} : (!fir.ref<!fir.box<none>>, !fir.box<none>, !fir.box<none>) -> ()488 489 subroutine test_elemental_assign()490 type(p1) :: pa(3)491 pa = [ 1, 2, 3 ]492 end subroutine493 494! CHECK-LABEL: func.func @_QMpolymorphic_testPtest_elemental_assign() {495! CHECK: %[[INT:.*]] = fir.alloca i32496! CHECK: %[[C3_0:.*]] = arith.constant 3 : index497! CHECK: %[[PA:.*]] = fir.alloca !fir.array<3x!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>> {bindc_name = "pa", uniq_name = "_QMpolymorphic_testFtest_elemental_assignEpa"}498! CHECK: %[[SHAPE:.*]] = fir.shape %[[C3_0]] : (index) -> !fir.shape<1>499! CHECK: %[[LOAD_PA:.*]] = fir.array_load %[[PA]](%[[SHAPE]]) : (!fir.ref<!fir.array<3x!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>>, !fir.shape<1>) -> !fir.array<3x!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>500! CHECK: %[[ADDR_INT:.*]] = fir.address_of(@_QQro.3xi4.{{.*}}) : !fir.ref<!fir.array<3xi32>>501! CHECK: %[[C3:.*]] = arith.constant 3 : index502! CHECK: %[[SHAPE:.*]] = fir.shape %[[C3]] : (index) -> !fir.shape<1>503! CHECK: %[[LOAD_INT_ARRAY:.*]] = fir.array_load %[[ADDR_INT]](%[[SHAPE]]) : (!fir.ref<!fir.array<3xi32>>, !fir.shape<1>) -> !fir.array<3xi32>504! CHECK: %[[C1:.*]] = arith.constant 1 : index505! CHECK: %[[C0:.*]] = arith.constant 0 : index506! CHECK: %[[UB:.*]] = arith.subi %[[C3_0]], %[[C1]] : index507! CHECK: %[[DO_RES:.*]] = fir.do_loop %[[ARG0:.*]] = %[[C0]] to %[[UB]] step %[[C1]] unordered iter_args(%[[ARG1:.*]] = %[[LOAD_PA]]) -> (!fir.array<3x!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>) {508! CHECK: %[[FETCH_INT:.*]] = fir.array_fetch %[[LOAD_INT_ARRAY]], %[[ARG0]] : (!fir.array<3xi32>, index) -> i32509! CHECK: %[[ARRAY_MOD:.*]]:2 = fir.array_modify %[[ARG1]], %[[ARG0]] : (!fir.array<3x!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>, index) -> (!fir.ref<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>, !fir.array<3x!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>)510! CHECK: %[[EMBOXED:.*]] = fir.embox %{{.*}}#0 : (!fir.ref<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>) -> !fir.class<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>511! CHECK: fir.store %[[FETCH_INT]] to %[[INT]] : !fir.ref<i32>512! CHECK: fir.call @_QMpolymorphic_testPassign_p1_int(%[[EMBOXED]], %[[INT]]) fastmath<contract> : (!fir.class<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>, !fir.ref<i32>) -> ()513! CHECK: fir.result %[[ARRAY_MOD]]#1 : !fir.array<3x!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>514! CHECK: }515! CHECK: fir.array_merge_store %[[LOAD_PA]], %[[DO_RES]] to %[[PA]] : !fir.array<3x!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>, !fir.array<3x!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>, !fir.ref<!fir.array<3x!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>>516! CHECK: return517 518 subroutine host_assoc(this)519 class(p1) :: this520 521 call internal522 contains523 subroutine internal524 print*, this%a, this%b525 end subroutine526 end subroutine527 528! CHECK-LABEL: func.func private @_QMpolymorphic_testFhost_assocPinternal(529! CHECK-SAME: %[[TUPLE:.*]]: !fir.ref<tuple<!fir.class<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>>> {fir.host_assoc}) attributes {fir.host_symbol = {{.*}}, llvm.linkage = #llvm.linkage<internal>} {530! CHECK: %[[POS_IN_TUPLE:.*]] = arith.constant 0 : i32531! CHECK: %[[COORD_OF_CLASS:.*]] = fir.coordinate_of %[[TUPLE]], %[[POS_IN_TUPLE]] : (!fir.ref<tuple<!fir.class<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>>>, i32) -> !fir.ref<!fir.class<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>>532! CHECK: %[[CLASS:.*]] = fir.load %[[COORD_OF_CLASS]] : !fir.ref<!fir.class<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>>533! CHECK: %[[COORD_A:.*]] = fir.coordinate_of %[[CLASS]], a : (!fir.class<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>) -> !fir.ref<i32>534! CHECK: %[[A:.*]] = fir.load %[[COORD_A]] : !fir.ref<i32>535! CHECK: %{{.*}} = fir.call @_FortranAioOutputInteger32(%{{.*}}, %[[A]]) {{.*}} : (!fir.ref<i8>, i32) -> i1536! CHECK: %[[COORD_B:.*]] = fir.coordinate_of %[[CLASS]], b : (!fir.class<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>) -> !fir.ref<i32>537! CHECK: %[[B:.*]] = fir.load %[[COORD_B]] : !fir.ref<i32>538! CHECK: %{{.*}} = fir.call @_FortranAioOutputInteger32(%{{.*}}, %[[B]]) {{.*}} : (!fir.ref<i8>, i32) -> i1539 540 subroutine test_elemental_array()541 type(p1) :: p(5)542 print *, p%elemental_fct()543 end subroutine544 545! CHECK-LABEL: func.func @_QMpolymorphic_testPtest_elemental_array() {546! CHECK: %[[P:.*]] = fir.alloca !fir.array<5x!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>> {bindc_name = "p", uniq_name = "_QMpolymorphic_testFtest_elemental_arrayEp"}547! CHECK: %[[C5:.*]] = arith.constant 5 : index548! CHECK: %[[TMP:.*]] = fir.allocmem !fir.array<5xi32>549! CHECK: %[[SHAPE:.*]] = fir.shape %[[C5]] : (index) -> !fir.shape<1>550! CHECK: %[[ARRAY_LOAD_TMP:.*]] = fir.array_load %[[TMP]](%[[SHAPE]]) : (!fir.heap<!fir.array<5xi32>>, !fir.shape<1>) -> !fir.array<5xi32>551! CHECK: %[[C1:.*]] = arith.constant 1 : index552! CHECK: %[[C0:.*]] = arith.constant 0 : index553! CHECK: %[[UB:.*]] = arith.subi %[[C5]], %[[C1]] : index554! CHECK: %[[LOOP_RES:.*]] = fir.do_loop %[[IND:.*]] = %[[C0]] to %[[UB]] step %[[C1]] unordered iter_args(%[[ARG1:.*]] = %[[ARRAY_LOAD_TMP]]) -> (!fir.array<5xi32>) {555! CHECK: %[[COORD:.*]] = fir.coordinate_of %[[P]], %[[IND]] : (!fir.ref<!fir.array<5x!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>>, index) -> !fir.ref<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>556! CHECK: %[[EMBOXED:.*]] = fir.embox %[[COORD]] : (!fir.ref<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>) -> !fir.class<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>557! CHECK: %[[RES:.*]] = fir.call @_QMpolymorphic_testPelemental_fct(%[[EMBOXED]]) {{.*}} : (!fir.class<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>) -> i32558! CHECK: %[[ARR_UP:.*]] = fir.array_update %[[ARG1]], %[[RES]], %[[IND]] : (!fir.array<5xi32>, i32, index) -> !fir.array<5xi32>559! CHECK: fir.result %[[ARR_UP]] : !fir.array<5xi32>560! CHECK: }561! CHECK: fir.array_merge_store %[[ARRAY_LOAD_TMP]], %[[LOOP_RES]] to %[[TMP]] : !fir.array<5xi32>, !fir.array<5xi32>, !fir.heap<!fir.array<5xi32>>562! CHECK: %[[SHAPE:.*]] = fir.shape %[[C5]] : (index) -> !fir.shape<1>563! CHECK: %[[EMBOXED_TMP:.*]] = fir.embox %[[TMP]](%[[SHAPE]]) : (!fir.heap<!fir.array<5xi32>>, !fir.shape<1>) -> !fir.box<!fir.array<5xi32>>564! CHECK: %[[BOX_NONE:.*]] = fir.convert %[[EMBOXED_TMP]] : (!fir.box<!fir.array<5xi32>>) -> !fir.box<none>565! CHECK: %{{.*}} = fir.call @_FortranAioOutputDescriptor(%{{.*}}, %[[BOX_NONE]]) {{.*}} : (!fir.ref<i8>, !fir.box<none>) -> i1566! CHECK: fir.freemem %[[TMP]] : !fir.heap<!fir.array<5xi32>>567 568 subroutine test_elemental_poly_array(p)569 class(p1) :: p(5)570 print *, p%elemental_fct()571 end subroutine572 573! CHECK-LABEL: func.func @_QMpolymorphic_testPtest_elemental_poly_array(574! CHECK-SAME: %[[P:.*]]: !fir.class<!fir.array<5x!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>> {fir.bindc_name = "p"}) {575! CHECK: %[[C5:.*]] = arith.constant 5 : index576! CHECK: %[[TMP:.*]] = fir.allocmem !fir.array<5xi32>577! CHECK: %[[SHAPE:.*]] = fir.shape %[[C5]] : (index) -> !fir.shape<1>578! CHECK: %[[ARRAY_LOAD_TMP:.*]] = fir.array_load %[[TMP]](%[[SHAPE]]) : (!fir.heap<!fir.array<5xi32>>, !fir.shape<1>) -> !fir.array<5xi32>579! CHECK: %[[C1:.*]] = arith.constant 1 : index580! CHECK: %[[C0:.*]] = arith.constant 0 : index581! CHECK: %[[UB:.*]] = arith.subi %[[C5]], %[[C1]] : index582! CHECK: %[[LOOP_RES:.*]] = fir.do_loop %[[IND:.*]] = %[[C0]] to %[[UB]] step %[[C1]] unordered iter_args(%[[ARG:.*]] = %[[ARRAY_LOAD_TMP]]) -> (!fir.array<5xi32>) {583! CHECK: %[[COORD:.*]] = fir.coordinate_of %[[P]], %[[IND]] : (!fir.class<!fir.array<5x!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>>, index) -> !fir.ref<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>584! CHECK: %[[EMBOXED:.*]] = fir.embox %[[COORD]] source_box %[[P]] : (!fir.ref<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>, !fir.class<!fir.array<5x!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>>) -> !fir.class<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>585! CHECK: %[[RES:.*]] = fir.dispatch "elemental_fct"(%[[EMBOXED]] : !fir.class<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>) (%[[EMBOXED]] : !fir.class<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>) -> i32 proc_attrs <elemental, pure> {pass_arg_pos = 0 : i32}586! CHECK: %[[ARR_UP:.*]] = fir.array_update %[[ARG]], %[[RES]], %[[IND]] : (!fir.array<5xi32>, i32, index) -> !fir.array<5xi32>587! CHECK: fir.result %[[ARR_UP]] : !fir.array<5xi32>588! CHECK: }589! CHECK: fir.array_merge_store %[[ARRAY_LOAD_TMP]], %[[LOOP_RES]] to %[[TMP]] : !fir.array<5xi32>, !fir.array<5xi32>, !fir.heap<!fir.array<5xi32>>590! CHECK: %[[SHAPE:.*]] = fir.shape %[[C5]] : (index) -> !fir.shape<1>591! CHECK: %[[EMBOXED_TMP:.*]] = fir.embox %[[TMP]](%[[SHAPE]]) : (!fir.heap<!fir.array<5xi32>>, !fir.shape<1>) -> !fir.box<!fir.array<5xi32>>592! CHECK: %[[BOX_NONE:.*]] = fir.convert %[[EMBOXED_TMP]] : (!fir.box<!fir.array<5xi32>>) -> !fir.box<none>593! CHECK: %{{.*}} = fir.call @_FortranAioOutputDescriptor(%{{.*}}, %[[BOX_NONE]]) {{.*}} : (!fir.ref<i8>, !fir.box<none>) -> i1594! CHECK: fir.freemem %[[TMP]] : !fir.heap<!fir.array<5xi32>>595 596 subroutine test_elemental_poly_array_2d(p)597 class(p1) :: p(5,5)598 print *, p%elemental_fct()599 end subroutine600 601! CHECK-LABEL: func.func @_QMpolymorphic_testPtest_elemental_poly_array_2d(602! CHECK-SAME: %[[P]]: !fir.class<!fir.array<5x5x!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>> {fir.bindc_name = "p"}) {603! CHECK: %[[C5:.*]] = arith.constant 5 : index604! CHECK: %[[C5_0:.*]] = arith.constant 5 : index605! CHECK: %[[TMP:.*]] = fir.allocmem !fir.array<5x5xi32>606! CHECK: %[[SHAPE:.*]] = fir.shape %[[C5]], %[[C5_0]] : (index, index) -> !fir.shape<2>607! CHECK: %[[ARRAY_LOAD_TMP:.*]] = fir.array_load %[[TMP]](%[[SHAPE]]) : (!fir.heap<!fir.array<5x5xi32>>, !fir.shape<2>) -> !fir.array<5x5xi32>608! CHECK: %[[C1:.*]] = arith.constant 1 : index609! CHECK: %[[C0:.*]] = arith.constant 0 : index610! CHECK: %[[UB0:.*]] = arith.subi %[[C5]], %[[C1]] : index611! CHECK: %[[UB1:.*]] = arith.subi %[[C5_0]], %[[C1]] : index612! CHECK: %[[LOOP_RES:.*]] = fir.do_loop %[[IND0:.*]] = %[[C0]] to %[[UB1]] step %[[C1]] unordered iter_args(%[[ARG:.*]] = %[[ARRAY_LOAD_TMP]]) -> (!fir.array<5x5xi32>) {613! CHECK: %[[LOOP_RES0:.*]] = fir.do_loop %[[IND1:.*]] = %[[C0]] to %[[UB0]] step %[[C1]] unordered iter_args(%[[ARG0:.*]] = %[[ARG]]) -> (!fir.array<5x5xi32>) {614! CHECK: %[[COORD:.*]] = fir.coordinate_of %[[P]], %[[IND1]], %[[IND0]] : (!fir.class<!fir.array<5x5x!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>>, index, index) -> !fir.ref<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>615! CHECK: %[[EMBOXED:.*]] = fir.embox %[[COORD]] source_box %[[P]] : (!fir.ref<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>, !fir.class<!fir.array<5x5x!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>>) -> !fir.class<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>616! CHECK: %[[RES:.*]] = fir.dispatch "elemental_fct"(%[[EMBOXED]] : !fir.class<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>) (%[[EMBOXED]] : !fir.class<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>) -> i32 proc_attrs <elemental, pure> {pass_arg_pos = 0 : i32}617! CHECK: %[[ARR_UP:.*]] = fir.array_update %[[ARG0]], %[[RES]], %[[IND1]], %[[IND0]] : (!fir.array<5x5xi32>, i32, index, index) -> !fir.array<5x5xi32>618! CHECK: fir.result %[[ARR_UP]] : !fir.array<5x5xi32>619! CHECK: }620! CHECK: fir.result %[[LOOP_RES0]] : !fir.array<5x5xi32>621! CHECK: }622! CHECK: fir.array_merge_store %[[ARRAY_LOAD_TMP]], %[[LOOP_RES]] to %[[TMP]] : !fir.array<5x5xi32>, !fir.array<5x5xi32>, !fir.heap<!fir.array<5x5xi32>>623! CHECK: %[[SHAPE:.*]] = fir.shape %[[C5]], %[[C5_0]] : (index, index) -> !fir.shape<2>624! CHECK: %[[EMBOXED_TMP:.*]] = fir.embox %[[TMP]](%[[SHAPE]]) : (!fir.heap<!fir.array<5x5xi32>>, !fir.shape<2>) -> !fir.box<!fir.array<5x5xi32>>625! CHECK: %[[BOX_NONE:.*]] = fir.convert %[[EMBOXED_TMP]] : (!fir.box<!fir.array<5x5xi32>>) -> !fir.box<none>626! CHECK: %{{.*}} = fir.call @_FortranAioOutputDescriptor(%{{.*}}, %[[BOX_NONE]]) fastmath<contract> : (!fir.ref<i8>, !fir.box<none>) -> i1627! CHECK: fir.freemem %[[TMP]] : !fir.heap<!fir.array<5x5xi32>>628 629 subroutine test_elemental_sub_array()630 type(p1) :: t(10)631 call t%elemental_sub()632 call t%elemental_sub_pass(2)633 end subroutine634 635! CHECK-LABEL: func.func @_QMpolymorphic_testPtest_elemental_sub_array() {636! CHECK: %[[C10:.*]] = arith.constant 10 : index637! CHECK: %[[T:.*]] = fir.alloca !fir.array<10x!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>> {bindc_name = "t", uniq_name = "_QMpolymorphic_testFtest_elemental_sub_arrayEt"}638! CHECK: %[[C1:.*]] = arith.constant 1 : index639! CHECK: %[[C0:.*]] = arith.constant 0 : index640! CHECK: %[[UB:.*]] = arith.subi %[[C10]], %[[C1]] : index641! CHECK: fir.do_loop %[[IND:.*]] = %[[C0]] to %[[UB]] step %[[C1]] {642! CHECK: %[[COORD:.*]] = fir.coordinate_of %[[T]], %[[IND]] : (!fir.ref<!fir.array<10x!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>>, index) -> !fir.ref<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>643! CHECK: %[[EMBOXED:.*]] = fir.embox %[[COORD]] : (!fir.ref<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>) -> !fir.class<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>644! CHECK: fir.call @_QMpolymorphic_testPelemental_sub(%[[EMBOXED]]) {{.*}} : (!fir.class<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>) -> ()645! CHECK: }646! CHECK: %[[C1:.*]] = arith.constant 1 : index647! CHECK: %[[C0:.*]] = arith.constant 0 : index648! CHECK: %[[UB:.*]] = arith.subi %[[C10]], %[[C1]] : index649! CHECK: fir.do_loop %[[IND:.*]] = %[[C0]] to %[[UB]] step %[[C1]] {650! CHECK: %[[COORD:.*]] = fir.coordinate_of %[[T]], %[[IND]] : (!fir.ref<!fir.array<10x!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>>, index) -> !fir.ref<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>651! CHECK: %[[EMBOXED:.*]] = fir.embox %[[COORD]] : (!fir.ref<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>) -> !fir.class<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>652! CHECK: fir.call @_QMpolymorphic_testPelemental_sub_pass(%{{.*}}, %[[EMBOXED]]) {{.*}} : (!fir.ref<i32>, !fir.class<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>) -> ()653! CHECK: }654 655 subroutine test_elemental_sub_poly_array(p)656 class(p1) :: p(10)657 call p%elemental_sub()658 call p%elemental_sub_pass(3)659 end subroutine660 661! CHECK-LABEL: func.func @_QMpolymorphic_testPtest_elemental_sub_poly_array(662! CHECK-SAME: %[[P:.*]]: !fir.class<!fir.array<10x!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>> {fir.bindc_name = "p"}) {663! CHECK: %[[C10:.*]] = arith.constant 10 : index664! CHECK: %[[C1:.*]] = arith.constant 1 : index665! CHECK: %[[C0:.*]] = arith.constant 0 : index666! CHECK: %[[UB:.*]] = arith.subi %[[C10]], %[[C1]] : index667! CHECK: fir.do_loop %[[IND:.*]] = %[[C0]] to %[[UB]] step %[[C1]] {668! CHECK: %[[COORD:.*]] = fir.coordinate_of %[[P]], %[[IND]] : (!fir.class<!fir.array<10x!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>>, index) -> !fir.ref<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>669! CHECK: %[[EMBOXED:.*]] = fir.embox %[[COORD]] source_box %[[P]] : (!fir.ref<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>, !fir.class<!fir.array<10x!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>>) -> !fir.class<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>670! CHECK: fir.dispatch "elemental_sub"(%[[EMBOXED]] : !fir.class<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>) (%[[EMBOXED]] : !fir.class<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>) proc_attrs <elemental, pure> {pass_arg_pos = 0 : i32}671! CHECK: }672! CHECK: %[[C1:.*]] = arith.constant 1 : index673! CHECK: %[[C0:.*]] = arith.constant 0 : index674! CHECK: %[[UB:.*]] = arith.subi %[[C10]], %[[C1]] : index675! CHECK: fir.do_loop %[[IND:.*]] = %[[C0]] to %[[UB]] step %[[C1]] {676! CHECK: %[[COORD:.*]] = fir.coordinate_of %[[P]], %[[IND]] : (!fir.class<!fir.array<10x!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>>, index) -> !fir.ref<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>677! CHECK: %[[EMBOXED:.*]] = fir.embox %[[COORD]] source_box %[[P]] : (!fir.ref<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>, !fir.class<!fir.array<10x!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>>) -> !fir.class<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>678! CHECK: fir.dispatch "elemental_sub_pass"(%[[EMBOXED]] : !fir.class<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>) (%{{.*}}, %[[EMBOXED]] : !fir.ref<i32>, !fir.class<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>) proc_attrs <elemental, pure> {pass_arg_pos = 1 : i32}679! CHECK: }680 681 subroutine test_elemental_sub_array_assumed(t)682 type(p1) :: t(:)683 call t%elemental_sub()684 call t%elemental_sub_pass(4)685 end subroutine686 687! CHECK-LABEL: func.func @_QMpolymorphic_testPtest_elemental_sub_array_assumed(688! CHECK-SAME: %[[T:.*]]: !fir.box<!fir.array<?x!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>> {fir.bindc_name = "t"}) {689! CHECK: %[[C0:.*]] = arith.constant 0 : index690! CHECK: %[[T_DIMS:.*]]:3 = fir.box_dims %[[T]], %[[C0]] : (!fir.box<!fir.array<?x!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>>, index) -> (index, index, index)691! CHECK: %[[C1:.*]] = arith.constant 1 : index692! CHECK: %[[C0:.*]] = arith.constant 0 : index693! CHECK: %[[UB:.*]] = arith.subi %[[T_DIMS]]#1, %[[C1]] : index694! CHECK: fir.do_loop %[[IND:.*]] = %[[C0]] to %[[UB]] step %[[C1]] {695! CHECK: %[[COORD:.*]] = fir.coordinate_of %[[T]], %[[IND]] : (!fir.box<!fir.array<?x!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>>, index) -> !fir.ref<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>696! CHECK: %[[EMBOXED:.*]] = fir.embox %[[COORD]] : (!fir.ref<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>) -> !fir.class<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>697! CHECK: fir.call @_QMpolymorphic_testPelemental_sub(%[[EMBOXED]]) {{.*}} : (!fir.class<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>) -> ()698! CHECK: %[[C0:.*]] = arith.constant 0 : index699! CHECK: %[[T_DIMS:.*]]:3 = fir.box_dims %[[T]], %[[C0]] : (!fir.box<!fir.array<?x!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>>, index) -> (index, index, index)700! CHECK: %[[C1:.*]] = arith.constant 1 : index701! CHECK: %[[C0:.*]] = arith.constant 0 : index702! CHECK: %[[UB:.*]] = arith.subi %[[T_DIMS]]#1, %[[C1]] : index703! CHECK: fir.do_loop %[[IND:.*]] = %[[C0]] to %[[UB]] step %[[C1]] {704! CHECK: %[[COORD:.*]] = fir.coordinate_of %[[T]], %[[IND]] : (!fir.box<!fir.array<?x!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>>, index) -> !fir.ref<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>705! CHECK: %[[EMBOXED:.*]] = fir.embox %[[COORD]] : (!fir.ref<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>) -> !fir.class<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>706! CHECK: fir.call @_QMpolymorphic_testPelemental_sub_pass(%{{.*}}, %[[EMBOXED]]) {{.*}} : (!fir.ref<i32>, !fir.class<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>) -> ()707! CHECK: }708 709 subroutine test_elemental_sub_poly_array_assumed(p)710 class(p1) :: p(:)711 call p%elemental_sub()712 call p%elemental_sub_pass(5)713 end subroutine714 715! CHECK-LABEL: func.func @_QMpolymorphic_testPtest_elemental_sub_poly_array_assumed(716! CHECK-SAME: %[[P:.*]]: !fir.class<!fir.array<?x!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>> {fir.bindc_name = "p"}) {717! CHECK: %[[C0:.*]] = arith.constant 0 : index718! CHECK: %[[P_DIMS:.*]]:3 = fir.box_dims %[[P]], %[[C0]] : (!fir.class<!fir.array<?x!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>>, index) -> (index, index, index)719! CHECK: %[[C1:.*]] = arith.constant 1 : index720! CHECK: %[[C0:.*]] = arith.constant 0 : index721! CHECK: %[[UB:.*]] = arith.subi %[[P_DIMS]]#1, %[[C1]] : index722! CHECK: fir.do_loop %[[IND:.*]] = %[[C0]] to %[[UB]] step %[[C1]] {723! CHECK: %[[COORD:.*]] = fir.coordinate_of %[[P]], %[[IND]] : (!fir.class<!fir.array<?x!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>>, index) -> !fir.ref<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>724! CHECK: %[[EMBOXED:.*]] = fir.embox %[[COORD]] source_box %[[P]] : (!fir.ref<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>, !fir.class<!fir.array<?x!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>>) -> !fir.class<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>725! CHECK: fir.dispatch "elemental_sub"(%[[EMBOXED]] : !fir.class<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>) (%[[EMBOXED]] : !fir.class<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>) proc_attrs <elemental, pure> {pass_arg_pos = 0 : i32}726! CHECK: }727! CHECK: %[[C0:.*]] = arith.constant 0 : index728! CHECK: %[[P_DIMS:.*]]:3 = fir.box_dims %[[P]], %[[C0]] : (!fir.class<!fir.array<?x!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>>, index) -> (index, index, index)729! CHECK: %[[C1:.*]] = arith.constant 1 : index730! CHECK: %[[C0:.*]] = arith.constant 0 : index731! CHECK: %[[UB:.*]] = arith.subi %[[P_DIMS]]#1, %[[C1]] : index732! CHECK: fir.do_loop %[[IND:.*]] = %[[C0]] to %[[UB]] step %[[C1]] {733! CHECK: %[[COORD:.*]] = fir.coordinate_of %[[P]], %[[IND]] : (!fir.class<!fir.array<?x!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>>, index) -> !fir.ref<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>734! CHECK: %[[EMBOXED:.*]] = fir.embox %[[COORD]] source_box %[[P]] : (!fir.ref<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>, !fir.class<!fir.array<?x!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>>) -> !fir.class<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>735! CHECK: fir.dispatch "elemental_sub_pass"(%[[EMBOXED]] : !fir.class<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>) (%{{.*}}, %[[EMBOXED]] : !fir.ref<i32>, !fir.class<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>) proc_attrs <elemental, pure> {pass_arg_pos = 1 : i32}736! CHECK: }737 738 subroutine write_p1(dtv, unit, iotype, v_list, iostat, iomsg)739 class(p1), intent(in) :: dtv740 integer, intent(in) :: unit741 character(*), intent(in) :: iotype742 integer, intent(in) :: v_list(:)743 integer, intent(out) :: iostat744 character(*), intent(inout) :: iomsg745 ! dummy subroutine for testing purpose746 end subroutine747 748 subroutine read_p1(dtv, unit, iotype, v_list, iostat, iomsg)749 class(p1), intent(inout) :: dtv750 integer, intent(in) :: unit751 character(*), intent(in) :: iotype752 integer, intent(in) :: v_list(:)753 integer, intent(out) :: iostat754 character(*), intent(inout) :: iomsg755 ! dummy subroutine for testing purpose756 end subroutine757 758 subroutine test_polymorphic_io()759 type(p1), target :: t760 class(p1), pointer :: p761 open(17, form='formatted', access='stream')762 write(17, 1) t763 1 Format(1X,I10)764 p => t765 rewind(17)766 read(17, 1) p767 end subroutine768 769! CHECK-LABEL: func.func @_QMpolymorphic_testPtest_polymorphic_io() {770! CHECK: %[[P:.*]] = fir.alloca !fir.class<!fir.ptr<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>> {bindc_name = "p", uniq_name = "_QMpolymorphic_testFtest_polymorphic_ioEp"}771! CHECK: %[[LOAD_P:.*]] = fir.load %[[P]] : !fir.ref<!fir.class<!fir.ptr<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>>>772! CHECK: %[[BOX_NONE:.*]] = fir.convert %[[LOAD_P]] : (!fir.class<!fir.ptr<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>>) -> !fir.box<none>773! CHECK: %{{.*}} = fir.call @_FortranAioInputDerivedType(%{{.*}}, %[[BOX_NONE]], %{{.*}}) {{.*}} : (!fir.ref<i8>, !fir.box<none>, !fir.ref<none>) -> i1774 775 function unlimited_polymorphic_alloc_array_ret()776 class(*), allocatable :: unlimited_polymorphic_alloc_array_ret(:)777 end function778 779 subroutine test_unlimited_polymorphic_alloc_array_ret()780 select type (a => unlimited_polymorphic_alloc_array_ret())781 type is (real)782 print*, 'type is real'783 end select784 end subroutine785 786! CHECK-LABEL: func.func @_QMpolymorphic_testPtest_unlimited_polymorphic_alloc_array_ret() {787! CHECK: %[[RES_TMP:.*]] = fir.alloca !fir.class<!fir.heap<!fir.array<?xnone>>> {bindc_name = ".result"}788! CHECK: %[[RES:.*]] = fir.call @_QMpolymorphic_testPunlimited_polymorphic_alloc_array_ret() fastmath<contract> : () -> !fir.class<!fir.heap<!fir.array<?xnone>>>789! CHECK: fir.save_result %[[RES]] to %[[RES_TMP]] : !fir.class<!fir.heap<!fir.array<?xnone>>>, !fir.ref<!fir.class<!fir.heap<!fir.array<?xnone>>>>790 791 subroutine test_unlimited_polymorphic_intentout(a)792 class(*), intent(out) :: a793 end subroutine794 795! CHECK-LABEL: func.func @_QMpolymorphic_testPtest_unlimited_polymorphic_intentout(796! CHECK-SAME: %[[ARG0:.*]]: !fir.class<none> {fir.bindc_name = "a"}) {797! CHECK: %[[BOX_NONE:.*]] = fir.convert %[[ARG0]] : (!fir.class<none>) -> !fir.box<none>798! CHECK: fir.call @_FortranADestroy(%[[BOX_NONE]]) {{.*}} : (!fir.box<none>) -> ()799! CHECK: %[[BOX_NONE:.*]] = fir.convert %[[ARG0]] : (!fir.class<none>) -> !fir.box<none>800! CHECK: fir.call @_FortranAInitialize(%[[BOX_NONE]], %{{.*}}, %{{.*}}) {{.*}} : (!fir.box<none>, !fir.ref<i8>, i32) -> ()801 802 subroutine test_polymorphic_intentout(a)803 class(p1), intent(out) :: a804 end subroutine805 806! CHECK-LABEL: func.func @_QMpolymorphic_testPtest_polymorphic_intentout(807! CHECK-SAME: %[[ARG0:.*]]: !fir.class<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>> {fir.bindc_name = "a"}) {808! CHECK: %[[BOX_NONE:.*]] = fir.convert %[[ARG0]] : (!fir.class<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>) -> !fir.box<none>809! CHECK: fir.call @_FortranADestroy(%[[BOX_NONE]]) {{.*}} : (!fir.box<none>) -> ()810! CHECK: %[[BOX_NONE:.*]] = fir.convert %[[ARG0]] : (!fir.class<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>) -> !fir.box<none>811! CHECK: fir.call @_FortranAInitialize(%[[BOX_NONE]], %{{.*}}, %{{.*}}) {{.*}} : (!fir.box<none>, !fir.ref<i8>, i32) -> ()812 813 subroutine rebox_up_to_record_type(p)814 class(*), allocatable, target :: p(:,:)815 type(non_extensible), pointer :: t(:,:)816 t => p817 end subroutine818 819! CHECK-LABEL: func.func @_QMpolymorphic_testPrebox_up_to_record_type(820! CHECK-SAME: %[[P:.*]]: !fir.ref<!fir.class<!fir.heap<!fir.array<?x?xnone>>>> {fir.bindc_name = "p", fir.target}) {821! CHECK: %[[T:.*]] = fir.alloca !fir.box<!fir.ptr<!fir.array<?x?x!fir.type<_QMpolymorphic_testTnon_extensible{d:i32}>>>> {bindc_name = "t", uniq_name = "_QMpolymorphic_testFrebox_up_to_record_typeEt"}822! CHECK: %[[LOAD_P:.*]] = fir.load %[[P]] : !fir.ref<!fir.class<!fir.heap<!fir.array<?x?xnone>>>>823! CHECK: %[[REBOX:.*]] = fir.rebox %[[LOAD_P]](%{{.*}}) : (!fir.class<!fir.heap<!fir.array<?x?xnone>>>, !fir.shift<2>) -> !fir.box<!fir.ptr<!fir.array<?x?x!fir.type<_QMpolymorphic_testTnon_extensible{d:i32}>>>>824! CHECK: fir.store %[[REBOX]] to %[[T]] : !fir.ref<!fir.box<!fir.ptr<!fir.array<?x?x!fir.type<_QMpolymorphic_testTnon_extensible{d:i32}>>>>>825 826 subroutine sub_with_poly_optional(a)827 class(*), optional :: a828 end subroutine829 830 subroutine test_call_with_null()831 call sub_with_poly_optional(null())832 end subroutine833 834! CHECK-LABEL: func.func @_QMpolymorphic_testPtest_call_with_null() {835! CHECK: %[[NULL_PTR:.*]] = fir.alloca !fir.box<!fir.ptr<none>>836! CHECK: %[[NULL:.*]] = fir.zero_bits !fir.ptr<none>837! CHECK: %[[NULL_BOX:.*]] = fir.embox %[[NULL]] : (!fir.ptr<none>) -> !fir.box<!fir.ptr<none>>838! CHECK: fir.store %[[NULL_BOX]] to %[[NULL_PTR]] : !fir.ref<!fir.box<!fir.ptr<none>>>839! CHECK: %[[BOX_NONE:.*]] = fir.load %[[NULL_PTR]] : !fir.ref<!fir.box<!fir.ptr<none>>>840! CHECK: %[[BOX_ADDR:.*]] = fir.box_addr %[[BOX_NONE]] : (!fir.box<!fir.ptr<none>>) -> !fir.ptr<none>841! CHECK: %[[BOX_ADDR_I64:.*]] = fir.convert %[[BOX_ADDR]] : (!fir.ptr<none>) -> i64842! CHECK: %[[C0:.*]] = arith.constant 0 : i64843! CHECK: %[[IS_ALLOCATED_OR_ASSOCIATED:.*]] = arith.cmpi ne, %[[BOX_ADDR_I64]], %[[C0]] : i64844! CHECK: %[[ABSENT:.*]] = fir.absent !fir.class<none>845! CHECK: %[[PTR_LOAD2:.*]] = fir.load %[[NULL_PTR]] : !fir.ref<!fir.box<!fir.ptr<none>>>846! CHECK: %[[CLASS_NONE:.*]] = fir.rebox %[[PTR_LOAD2]] : (!fir.box<!fir.ptr<none>>) -> !fir.class<none>847! CHECK: %[[ARG:.*]] = arith.select %[[IS_ALLOCATED_OR_ASSOCIATED]], %[[CLASS_NONE]], %[[ABSENT]] : !fir.class<none>848! CHECK: fir.call @_QMpolymorphic_testPsub_with_poly_optional(%[[ARG]]) {{.*}} : (!fir.class<none>) -> ()849 850 subroutine sub_with_poly_array_optional(a)851 class(*), optional :: a(:)852 end subroutine853 854 subroutine test_call_with_pointer_to_optional()855 real, pointer :: p(:)856 call sub_with_poly_array_optional(p)857 end subroutine858 859! CHECK-LABEL: func.func @_QMpolymorphic_testPtest_call_with_pointer_to_optional() {860! CHECK: %[[P:.*]] = fir.alloca !fir.box<!fir.ptr<!fir.array<?xf32>>> {bindc_name = "p", uniq_name = "_QMpolymorphic_testFtest_call_with_pointer_to_optionalEp"}861! CHECK: %[[IS_ALLOCATED_OR_ASSOCIATED:.*]] = arith.cmpi ne862! CHECK: %[[ABSENT:.*]] = fir.absent !fir.class<!fir.array<?xnone>>863! CHECK: %[[LOAD_P:.*]] = fir.load %[[P]] : !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>864! CHECK: %[[REBOX:.*]] = fir.rebox %[[LOAD_P]] : (!fir.box<!fir.ptr<!fir.array<?xf32>>>) -> !fir.class<!fir.array<?xnone>>865! CHECK: %[[ARG:.*]] = arith.select %[[IS_ALLOCATED_OR_ASSOCIATED]], %[[REBOX]], %[[ABSENT]] : !fir.class<!fir.array<?xnone>>866! CHECK: fir.call @_QMpolymorphic_testPsub_with_poly_array_optional(%[[ARG]]) {{.*}} : (!fir.class<!fir.array<?xnone>>) -> ()867 868 subroutine sub_with_real_pointer_optional(p)869 real, optional :: p(:)870 call sub_with_poly_array_optional(p)871 end subroutine872 873! CHECK-LABEL: func.func @_QMpolymorphic_testPsub_with_real_pointer_optional(874! CHECK-SAME: %[[P:.*]]: !fir.box<!fir.array<?xf32>> {fir.bindc_name = "p", fir.optional}) {875! CHECK: %[[IS_PRESENT:.*]] = fir.is_present %[[P]] : (!fir.box<!fir.array<?xf32>>) -> i1876! CHECK: %[[BOX:.*]] = fir.if %[[IS_PRESENT]] -> (!fir.class<!fir.array<?xnone>>) {877! CHECK: %[[REBOX:.*]] = fir.rebox %[[P]] : (!fir.box<!fir.array<?xf32>>) -> !fir.class<!fir.array<?xnone>>878! CHECK: fir.result %[[REBOX]] : !fir.class<!fir.array<?xnone>>879! CHECK: } else {880! CHECK: %[[ABSENT:.*]] = fir.absent !fir.class<!fir.array<?xnone>>881! CHECK: fir.result %[[ABSENT]] : !fir.class<!fir.array<?xnone>>882! CHECK: }883! CHECK: fir.call @_QMpolymorphic_testPsub_with_poly_array_optional(%[[BOX]]) {{.*}} : (!fir.class<!fir.array<?xnone>>) -> ()884 885 subroutine pass_poly_pointer_optional(p)886 class(p1), pointer, optional :: p887 end subroutine888 889 subroutine test_poly_pointer_null()890 call pass_poly_pointer_optional(null())891 end subroutine892 893! CHECK-LABEL: func.func @_QMpolymorphic_testPtest_poly_pointer_null() {894! CHECK: %[[ALLOCA:.*]] = fir.alloca !fir.class<!fir.ptr<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>>895! CHECK: %[[ZERO:.*]] = fir.zero_bits !fir.ptr<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>896! CHECK: %[[EMBOX:.*]] = fir.embox %[[ZERO]] : (!fir.ptr<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>) -> !fir.class<!fir.ptr<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>>897! CHECK: fir.store %[[EMBOX]] to %[[ALLOCA]] : !fir.ref<!fir.class<!fir.ptr<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>>>898! CHECK: fir.call @_QMpolymorphic_testPpass_poly_pointer_optional(%[[ALLOCA]]) fastmath<contract> : (!fir.ref<!fir.class<!fir.ptr<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>>>) -> ()899 900 subroutine test_poly_array_component_output(p)901 class(p1), pointer :: p(:)902 print*, p(:)%a903 end subroutine904 905! CHECK-LABEL: func.func @_QMpolymorphic_testPtest_poly_array_component_output(906! CHECK-SAME: %[[P]]: !fir.ref<!fir.class<!fir.ptr<!fir.array<?x!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>>>> {fir.bindc_name = "p"}) {907! CHECK: %[[LOAD_P:.*]] = fir.load %[[P]] : !fir.ref<!fir.class<!fir.ptr<!fir.array<?x!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>>>>908! CHECK: %[[FIELD_INDEX_A:.*]] = fir.field_index a, !fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>909! CHECK: %[[SLICE:.*]] = fir.slice %{{.*}}#0, %{{.*}}, %{{.*}} path %[[FIELD_INDEX_A]] : (index, index, index, !fir.field) -> !fir.slice<1>910! CHECK: %[[REBOX:.*]] = fir.rebox %[[LOAD_P]](%{{.*}}) [%[[SLICE]]] : (!fir.class<!fir.ptr<!fir.array<?x!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>>>, !fir.shift<1>, !fir.slice<1>) -> !fir.box<!fir.array<?xi32>>911! CHECK: %[[BOX_NONE:.*]] = fir.convert %[[REBOX]] : (!fir.box<!fir.array<?xi32>>) -> !fir.box<none>912! CHECK: %{{.*}} = fir.call @_FortranAioOutputDescriptor(%{{.*}}, %[[BOX_NONE]]) fastmath<contract> : (!fir.ref<i8>, !fir.box<none>) -> i1913 914 subroutine opt_int(i)915 integer, optional, intent(in) :: i916 call opt_up(i)917 end subroutine918 919! CHECK-LABEL: func.func @_QMpolymorphic_testPopt_int(920! CHECK-SAME: %[[ARG0:.*]]: !fir.ref<i32> {fir.bindc_name = "i", fir.optional}) {921! CHECK: %[[IS_PRESENT:.*]] = fir.is_present %[[ARG0]] : (!fir.ref<i32>) -> i1922! CHECK: %[[ARG:.*]] = fir.if %[[IS_PRESENT]] -> (!fir.class<none>) {923! CHECK: %[[EMBOXED:.*]] = fir.embox %[[ARG0]] : (!fir.ref<i32>) -> !fir.class<none>924! CHECK: fir.result %[[EMBOXED]] : !fir.class<none>925! CHECK: } else {926! CHECK: %[[ABSENT:.*]] = fir.absent !fir.class<none>927! CHECK: fir.result %[[ABSENT]] : !fir.class<none>928! CHECK: }929! CHECK: fir.call @_QMpolymorphic_testPopt_up(%[[ARG]]) fastmath<contract> : (!fir.class<none>) -> ()930 931 subroutine opt_up(up)932 class(*), optional, intent(in) :: up933 end subroutine934 935 function rhs()936 class(p1), pointer :: rhs937 end function938 939 subroutine test_rhs_assign(a)940 type(p1) :: a941 a = rhs()942 end subroutine943 944! CHECK-LABEL: func.func @_QMpolymorphic_testPtest_rhs_assign(945! CHECK-SAME: %[[ARG0:.*]]: !fir.ref<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>> {fir.bindc_name = "a"}) {946! CHECK: %[[RES:.*]] = fir.alloca !fir.class<!fir.ptr<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>> {bindc_name = ".result"}947! CHECK: %[[A:.*]] = fir.embox %[[ARG0]] : (!fir.ref<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>) -> !fir.box<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>948! CHECK: %[[LOAD_RES:.*]] = fir.load %[[RES]] : !fir.ref<!fir.class<!fir.ptr<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>>>949! CHECK: %[[A_NONE:.*]] = fir.convert %[[A]] : (!fir.box<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>) -> !fir.ref<!fir.box<none>>950! CHECK: %[[RES_NONE:.*]] = fir.convert %[[LOAD_RES]] : (!fir.class<!fir.ptr<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>>) -> !fir.box<none>951! CHECK: fir.call @_FortranAAssign(%[[A_NONE]], %[[RES_NONE]], %{{.*}}, %{{.*}}) {{.*}} : (!fir.ref<!fir.box<none>>, !fir.box<none>, !fir.ref<i8>, i32) -> ()952 953 subroutine type_with_polymorphic_components(a, b)954 type(p4) :: a, b955 a = b956 end subroutine957 958! CHECK-LABEL: func.func @_QMpolymorphic_testPtype_with_polymorphic_components(959! CHECK-SAME: %[[A:.*]]: !fir.ref<!fir.type<_QMpolymorphic_testTp4{a:!fir.class<!fir.heap<!fir.array<?x!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>>>}>> {fir.bindc_name = "a"}, %[[B:.*]]: !fir.ref<!fir.type<_QMpolymorphic_testTp4{a:!fir.class<!fir.heap<!fir.array<?x!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>>>}>> {fir.bindc_name = "b"}) {960! CHECK: %[[ALLOCA:.*]] = fir.alloca !fir.box<!fir.type<_QMpolymorphic_testTp4{a:!fir.class<!fir.heap<!fir.array<?x!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>>>}>>961! CHECK: %[[EMBOX_A:.*]] = fir.embox %[[A]] : (!fir.ref<!fir.type<_QMpolymorphic_testTp4{a:!fir.class<!fir.heap<!fir.array<?x!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>>>}>>) -> !fir.box<!fir.type<_QMpolymorphic_testTp4{a:!fir.class<!fir.heap<!fir.array<?x!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>>>}>>962! CHECK: %[[EMBOX_B:.*]] = fir.embox %[[B]] : (!fir.ref<!fir.type<_QMpolymorphic_testTp4{a:!fir.class<!fir.heap<!fir.array<?x!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>>>}>>) -> !fir.box<!fir.type<_QMpolymorphic_testTp4{a:!fir.class<!fir.heap<!fir.array<?x!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>>>}>>963! CHECK: fir.store %[[EMBOX_A]] to %[[ALLOCA]] : !fir.ref<!fir.box<!fir.type<_QMpolymorphic_testTp4{a:!fir.class<!fir.heap<!fir.array<?x!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>>>}>>>964! CHECK: %[[BOX_NONE1:.*]] = fir.convert %[[ALLOCA]] : (!fir.ref<!fir.box<!fir.type<_QMpolymorphic_testTp4{a:!fir.class<!fir.heap<!fir.array<?x!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>>>}>>>) -> !fir.ref<!fir.box<none>>965! CHECK: %[[BOX_NONE2:.*]] = fir.convert %[[EMBOX_B]] : (!fir.box<!fir.type<_QMpolymorphic_testTp4{a:!fir.class<!fir.heap<!fir.array<?x!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>>>}>>) -> !fir.box<none>966! CHECK: fir.call @_FortranAAssign(%[[BOX_NONE1]], %[[BOX_NONE2]], %{{.*}}, %{{.*}}) {{.*}} : (!fir.ref<!fir.box<none>>, !fir.box<none>, !fir.ref<i8>, i32) -> ()967 968 subroutine up_pointer(p)969 class(*), pointer, intent(in) :: p970 end subroutine971 972 subroutine test_char_to_up_pointer(c)973 character(*), target :: c974 call up_pointer(c)975 end subroutine976 977! CHECK-LABEL: func.func @_QMpolymorphic_testPtest_char_to_up_pointer(978! CHECK-SAME: %[[C:.*]]: !fir.boxchar<1> {fir.bindc_name = "c", fir.target}) {979! CHECK: %[[NEW_BOX:.*]] = fir.alloca !fir.class<!fir.ptr<none>>980! CHECK: %[[UNBOXCHAR:.*]]:2 = fir.unboxchar %arg0 : (!fir.boxchar<1>) -> (!fir.ref<!fir.char<1,?>>, index)981! CHECK: %[[EMBOX:.*]] = fir.embox %[[UNBOXCHAR]]#0 typeparams %[[UNBOXCHAR]]#1 : (!fir.ref<!fir.char<1,?>>, index) -> !fir.class<!fir.ptr<none>>982! CHECK: fir.store %[[EMBOX]] to %[[NEW_BOX]] : !fir.ref<!fir.class<!fir.ptr<none>>>983! CHECK: fir.call @_QMpolymorphic_testPup_pointer(%[[NEW_BOX]]) {{.*}} : (!fir.ref<!fir.class<!fir.ptr<none>>>) -> ()984 985 subroutine move_alloc_poly(a, b)986 class(p1), allocatable :: a, b987 988 call move_alloc(a, b)989 end subroutine990 991! CHECK-LABEL: func.func @_QMpolymorphic_testPmove_alloc_poly(992! CHECK-SAME: %[[A:.*]]: !fir.ref<!fir.class<!fir.heap<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>>> {fir.bindc_name = "a"}, %[[B:.*]]: !fir.ref<!fir.class<!fir.heap<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>>> {fir.bindc_name = "b"}) {993! CHECK: %[[TYPE_DESC:.*]] = fir.type_desc !fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>994! CHECK: %[[B_CONV:.*]] = fir.convert %[[B]] : (!fir.ref<!fir.class<!fir.heap<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>>>) -> !fir.ref<!fir.box<none>>995! CHECK: %[[A_CONV:.*]] = fir.convert %[[A]] : (!fir.ref<!fir.class<!fir.heap<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>>>) -> !fir.ref<!fir.box<none>>996! CHECK: %[[TYPE_DESC_CONV:.*]] = fir.convert %[[TYPE_DESC]] : (!fir.tdesc<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>) -> !fir.ref<none>997! CHECK: %{{.*}} = fir.call @_FortranAMoveAlloc(%[[B_CONV]], %[[A_CONV]], %[[TYPE_DESC_CONV]], %{{.*}}, %{{.*}}, %{{.*}}, %{{.*}}) {{.*}} : (!fir.ref<!fir.box<none>>, !fir.ref<!fir.box<none>>, !fir.ref<none>, i1, !fir.box<none>, !fir.ref<i8>, i32) -> i32998 999 subroutine test_parent_comp_in_select_type(s)1000 class(p1), allocatable :: s1001 class(p1), allocatable :: p1002 1003 allocate(p1::p)1004 1005 select type(s)1006 type is(p2)1007 s%p1 = p1008 end select1009 end subroutine1010 1011! CHECK-LABEL: func.func @_QMpolymorphic_testPtest_parent_comp_in_select_type(1012! CHECK-SAME: %[[S:.*]]: !fir.ref<!fir.class<!fir.heap<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>>> {fir.bindc_name = "s"}) {1013! CHECK: %[[P:.*]] = fir.alloca !fir.class<!fir.heap<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>> {bindc_name = "p", uniq_name = "_QMpolymorphic_testFtest_parent_comp_in_select_typeEp"}1014! CHECK: %[[LOAD_S:.*]] = fir.load %[[S]] : !fir.ref<!fir.class<!fir.heap<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>>>1015! CHECK: fir.select_type %[[LOAD_S]] : !fir.class<!fir.heap<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>> [#fir.type_is<!fir.type<_QMpolymorphic_testTp2{a:i32,b:i32,c:f32}>>, ^bb1, unit, ^bb2]1016! CHECK: ^bb1:1017! CHECK: %[[CONV_S:.*]] = fir.convert %[[LOAD_S]] : (!fir.class<!fir.heap<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>>) -> !fir.box<!fir.heap<!fir.type<_QMpolymorphic_testTp2{a:i32,b:i32,c:f32}>>>1018! CHECK: %[[REBOX_P1:.*]] = fir.rebox %[[CONV_S]] : (!fir.box<!fir.heap<!fir.type<_QMpolymorphic_testTp2{a:i32,b:i32,c:f32}>>>) -> !fir.box<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>1019! CHECK: %[[LOAD_P:.*]] = fir.load %[[P]] : !fir.ref<!fir.class<!fir.heap<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>>>1020! CHECK: %[[LHS_CONV:.*]] = fir.convert %[[REBOX_P1]] : (!fir.box<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>) -> !fir.ref<!fir.box<none>>1021! CHECK: %[[RHS_CONV:.*]] = fir.convert %[[LOAD_P]] : (!fir.class<!fir.heap<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>>) -> !fir.box<none>1022! CHECK: fir.call @_FortranAAssign(%[[LHS_CONV]], %[[RHS_CONV]], %{{.*}}, %{{.*}}) {{.*}} : (!fir.ref<!fir.box<none>>, !fir.box<none>, !fir.ref<i8>, i32) -> ()1023 1024 subroutine move_alloc_unlimited_poly(a, b)1025 class(*), allocatable :: a, b1026 1027 call move_alloc(a, b)1028 end subroutine1029 1030! CHECK-LABEL: func.func @_QMpolymorphic_testPmove_alloc_unlimited_poly(1031! CHECK-SAME: %[[A:.*]]: !fir.ref<!fir.class<!fir.heap<none>>> {fir.bindc_name = "a"}, %[[B:.*]]: !fir.ref<!fir.class<!fir.heap<none>>> {fir.bindc_name = "b"}) {1032! CHECK: %[[NULL:.*]] = fir.zero_bits !fir.ref<none>1033! CHECK: %[[B_CONV:.*]] = fir.convert %[[B]] : (!fir.ref<!fir.class<!fir.heap<none>>>) -> !fir.ref<!fir.box<none>>1034! CHECK: %[[A_CONV:.*]] = fir.convert %[[A]] : (!fir.ref<!fir.class<!fir.heap<none>>>) -> !fir.ref<!fir.box<none>>1035! CHECK: %{{.*}} = fir.call @_FortranAMoveAlloc(%[[B_CONV]], %[[A_CONV]], %[[NULL]], %{{.*}}, %{{.*}}, %{{.*}}, %{{.*}}) {{.*}} : (!fir.ref<!fir.box<none>>, !fir.ref<!fir.box<none>>, !fir.ref<none>, i1, !fir.box<none>, !fir.ref<i8>, i32) -> i321036 1037 subroutine test_parent_comp_intrinsic(a, b)1038 class(p1) :: a1039 type(p2), allocatable :: b1040 logical :: c1041 1042 c = same_type_as(a, b%p1)1043 end subroutine1044 1045! CHECK-LABEL: func.func @_QMpolymorphic_testPtest_parent_comp_intrinsic(1046! CHECK-SAME: %[[ARG0:.*]]: !fir.class<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>> {fir.bindc_name = "a"}, %[[ARG1:.*]]: !fir.ref<!fir.box<!fir.heap<!fir.type<_QMpolymorphic_testTp2{a:i32,b:i32,c:f32}>>>> {fir.bindc_name = "b"}) {1047! CHECK: %[[LOAD_ARG1:.*]] = fir.load %[[ARG1]] : !fir.ref<!fir.box<!fir.heap<!fir.type<_QMpolymorphic_testTp2{a:i32,b:i32,c:f32}>>>>1048! CHECK: %[[REBOX_ARG1:.*]] = fir.rebox %[[LOAD_ARG1]] : (!fir.box<!fir.heap<!fir.type<_QMpolymorphic_testTp2{a:i32,b:i32,c:f32}>>>) -> !fir.box<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>1049! CHECK: %[[BOX_NONE_ARG0:.*]] = fir.convert %[[ARG0]] : (!fir.class<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>) -> !fir.box<none>1050! CHECK: %[[BOX_NONE_ARG1:.*]] = fir.convert %[[REBOX_ARG1]] : (!fir.box<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>) -> !fir.box<none>1051! CHECK: %{{.*}} = fir.call @_FortranASameTypeAs(%[[BOX_NONE_ARG0]], %[[BOX_NONE_ARG1]]) {{.*}} : (!fir.box<none>, !fir.box<none>) -> i11052 1053 subroutine test_parent_comp_normal(a)1054 class(p2) :: a1055 1056 call print(a%p1)1057 end subroutine1058 1059! CHECK-LABEL: func.func @_QMpolymorphic_testPtest_parent_comp_normal(1060! CHECK-SAME: %[[ARG0:.*]]: !fir.class<!fir.type<_QMpolymorphic_testTp2{a:i32,b:i32,c:f32}>> {fir.bindc_name = "a"}) {1061! CHECK: %[[REBOX:.*]] = fir.rebox %[[ARG0]] : (!fir.class<!fir.type<_QMpolymorphic_testTp2{a:i32,b:i32,c:f32}>>) -> !fir.box<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>1062! CHECK: %[[CONV:.*]] = fir.convert %[[REBOX]] : (!fir.box<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>) -> !fir.class<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>1063! CHECK: fir.call @_QMpolymorphic_testPprint(%[[CONV]]) {{.*}} : (!fir.class<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>) -> ()1064 1065 subroutine takes_p1_opt(a)1066 class(p1), optional :: a1067 end subroutine1068 1069 subroutine test_parent_comp_opt(p)1070 type(p2), allocatable :: p1071 allocate(p)1072 call takes_p1_opt(p%p1)1073 end subroutine1074 1075! CHECK-LABEL: func.func @_QMpolymorphic_testPtest_parent_comp_opt(1076! CHECK-SAME: %[[ARG0:.*]]: !fir.ref<!fir.box<!fir.heap<!fir.type<_QMpolymorphic_testTp2{a:i32,b:i32,c:f32}>>>> {fir.bindc_name = "p"}) {1077! CHECK: %[[LOAD_ARG0:.*]] = fir.load %[[ARG0]] : !fir.ref<!fir.box<!fir.heap<!fir.type<_QMpolymorphic_testTp2{a:i32,b:i32,c:f32}>>>>1078! CHECK: %[[RES:.*]] = fir.if %{{.*}} -> (!fir.box<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>) {1079! CHECK: %[[REBOX:.*]] = fir.rebox %[[LOAD_ARG0:.*]] : (!fir.box<!fir.heap<!fir.type<_QMpolymorphic_testTp2{a:i32,b:i32,c:f32}>>>) -> !fir.box<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>1080! CHECK: fir.result %[[REBOX]] : !fir.box<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>1081! CHECK: %[[CONV:.*]] = fir.convert %[[RES]] : (!fir.box<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>) -> !fir.class<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>1082! CHECK: fir.call @_QMpolymorphic_testPtakes_p1_opt(%[[CONV]]) {{.*}} : (!fir.class<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>) -> ()1083 1084 subroutine class_with_entry(a)1085 class(p1) :: a,b1086 select type (a)1087 type is(p2)1088 print*, a%c1089 class default1090 print*, a%a1091 end select1092 return1093 entry d(b)1094 select type(b)1095 type is(p2)1096 print*,b%c1097 class default1098 print*,b%a1099 end select1100 end subroutine1101 1102! CHECK-LABEL: func.func @_QMpolymorphic_testPclass_with_entry(1103! CHECK-SAME: %[[A:.*]]: !fir.class<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>> {fir.bindc_name = "a"}) {1104 1105! CHECK-LABEL: func.func @_QMpolymorphic_testPd(1106! CHECK-SAME: %[[B:.*]]: !fir.class<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>> {fir.bindc_name = "b"}) {1107 1108 subroutine class_array_with_entry(a)1109 class(p1) :: a(:), b(:)1110 select type (a)1111 type is(p2)1112 print*, a%c1113 class default1114 print*, a%a1115 end select1116 return1117 entry g(b)1118 select type(b)1119 type is(p2)1120 print*,b%c1121 class default1122 print*,b%a1123 end select1124 end subroutine1125 1126! CHECK-LABEL: func.func @_QMpolymorphic_testPclass_array_with_entry(1127! CHECK-SAME: %[[A:.*]]: !fir.class<!fir.array<?x!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>> {fir.bindc_name = "a"}) {1128! CHECK: %[[B:.*]] = fir.alloca !fir.class<!fir.heap<!fir.array<?x!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>>>1129 1130! CHECK-LABEL: func.func @_QMpolymorphic_testPg(1131! CHECK-SAME: %[[B:.*]]: !fir.class<!fir.array<?x!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>> {fir.bindc_name = "b"}) {1132! CHECK: %[[A:.*]] = fir.alloca !fir.class<!fir.heap<!fir.array<?x!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>>>1133 1134 subroutine pass_up(up)1135 class(*), intent(in) :: up1136 end subroutine1137 1138! TODO: unlimited polymorphic temporary in lowering1139! subroutine parenthesized_up(a)1140! type(p5) :: a1141! call pass_up((a%up))1142! end subroutine1143 1144end module1145 1146program test1147 use polymorphic_test1148 type(outer), allocatable :: o1149 integer :: i(5)1150 logical :: l(5)1151 allocate(o)1152 1153 l = i < o%inner1154end program1155 1156! CHECK-LABEL: func.func @_QQmain() attributes {fir.bindc_name = "TEST"} {1157! CHECK: %[[ADDR_O:.*]] = fir.address_of(@_QFEo) : !fir.ref<!fir.box<!fir.heap<!fir.type<_QMpolymorphic_testTouter{inner:!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>}>>>>1158! CHECK: %[[BOX_NONE:.*]] = fir.convert %[[ADDR_O]] : (!fir.ref<!fir.box<!fir.heap<!fir.type<_QMpolymorphic_testTouter{inner:!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>}>>>>) -> !fir.ref<!fir.box<none>>1159! CHECK: %{{.*}} = fir.call @_FortranAAllocatableAllocate(%[[BOX_NONE]], %{{.*}}, %{{.*}}, %{{.*}}, %{{.*}}, %{{.*}}) {{.*}} : (!fir.ref<!fir.box<none>>, !fir.ref<i64>, i1, !fir.box<none>, !fir.ref<i8>, i32) -> i321160! CHECK: %[[O:.*]] = fir.load %[[ADDR_O]] : !fir.ref<!fir.box<!fir.heap<!fir.type<_QMpolymorphic_testTouter{inner:!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>}>>>>1161! CHECK: %[[COORD_INNER:.*]] = fir.coordinate_of %[[O]], inner : (!fir.box<!fir.heap<!fir.type<_QMpolymorphic_testTouter{inner:!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>}>>>) -> !fir.ref<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>1162! CHECK: %{{.*}} = fir.do_loop %{{.*}} = %{{.*}} to %{{.*}} step %{{.*}} unordered iter_args(%arg1 = %{{.*}}) -> (!fir.array<5x!fir.logical<4>>) {1163! CHECK: %[[EMBOXED:.*]] = fir.embox %[[COORD_INNER]] : (!fir.ref<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>) -> !fir.class<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>1164! CHECK: %{{.*}} = fir.call @_QMpolymorphic_testPlt(%{{.*}}, %[[EMBOXED]]) {{.*}} : (!fir.ref<i32>, !fir.class<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>) -> !fir.logical<4>1165! CHECK: }1166