884 lines · plain
1! RUN: bbc -emit-fir -hlfir=false %s -o - | FileCheck %s2! RUN: bbc -emit-fir -hlfir=false %s -o - | fir-opt --fir-polymorphic-op | FileCheck --check-prefix=CFG %s3module select_type_lower_test4 type p15 integer :: a6 integer :: b7 end type8 9 type, extends(p1) :: p210 integer :: c11 end type12 13 type, extends(p1) :: p3(k)14 integer, kind :: k15 real(k) :: r16 end type17 18 type, extends(p2) :: p419 integer :: d20 end type21 22 type :: p523 integer :: a24 contains25 procedure :: negate26 generic :: operator(-) => negate27 end type28 29contains30 31 function get_class()32 class(p1), pointer :: get_class33 end function34 35 function negate(this)36 class(p5), intent(in) :: this37 class(p5), allocatable :: negate38 allocate(negate, source=this)39 negate%a = -this%a40 end function41 42 subroutine select_type1(a)43 class(p1), intent(in) :: a44 45 select type (a)46 type is (p1)47 print*, 'type is p1'48 class is (p1)49 print*, 'class is p1'50 class is (p2)51 print*, 'class is p2', a%c52 class default53 print*,'default'54 end select55 end subroutine56 57! CHECK-LABEL: func.func @_QMselect_type_lower_testPselect_type1(58! CHECK-SAME: %[[ARG0:.*]]: !fir.class<!fir.type<_QMselect_type_lower_testTp1{a:i32,b:i32}>> {fir.bindc_name = "a"})59 60! CHECK: fir.select_type %[[ARG0]] : !fir.class<!fir.type<_QMselect_type_lower_testTp1{a:i32,b:i32}>>61! CHECK-SAME: [#fir.type_is<!fir.type<_QMselect_type_lower_testTp1{a:i32,b:i32}>>, ^[[TYPE_IS_BLK:.*]], #fir.class_is<!fir.type<_QMselect_type_lower_testTp1{a:i32,b:i32}>>, ^[[CLASS_IS_P1_BLK:.*]], #fir.class_is<!fir.type<_QMselect_type_lower_testTp2{a:i32,b:i32,c:i32}>>, ^[[CLASS_IS_P2_BLK:.*]], unit, ^[[DEFAULT_BLOCK:.*]]]62! CHECK: ^[[TYPE_IS_BLK]]63! CHECK: ^[[CLASS_IS_P1_BLK]]64! CHECK: ^[[CLASS_IS_P2_BLK]]65! CHECK: %[[P2:.*]] = fir.convert %[[ARG0:.*]] : (!fir.class<!fir.type<_QMselect_type_lower_testTp1{a:i32,b:i32}>>) -> !fir.class<!fir.type<_QMselect_type_lower_testTp2{a:i32,b:i32,c:i32}>>66! CHECK: %{{.*}} = fir.coordinate_of %[[P2]], c : (!fir.class<!fir.type<_QMselect_type_lower_testTp2{a:i32,b:i32,c:i32}>>) -> !fir.ref<i32>67! CHECK: ^[[DEFAULT_BLOCK]]68 69! CFG-LABEL: func.func @_QMselect_type_lower_testPselect_type1(70! CFG-SAME: %[[ARG0:.*]]: !fir.class<!fir.type<_QMselect_type_lower_testTp1{a:i32,b:i32}>> {fir.bindc_name = "a"}) {71! CFG: %[[TDESC_P1_ADDR:.*]] = fir.type_desc !fir.type<_QMselect_type_lower_testTp1{a:i32,b:i32}>72! CFG: %[[BOX_TDESC:.*]] = fir.box_tdesc %[[ARG0]] : (!fir.class<!fir.type<_QMselect_type_lower_testTp1{a:i32,b:i32}>>) -> !fir.tdesc<!fir.type<_QMselect_type_lower_testTp1{a:i32,b:i32}>>73! CFG: %[[TDESC_P1_CONV:.*]] = fir.convert %[[TDESC_P1_ADDR]] : (!fir.tdesc<!fir.type<_QMselect_type_lower_testTp1{a:i32,b:i32}>>) -> index74! CFG: %[[BOX_TDESC_CONV:.*]] = fir.convert %[[BOX_TDESC]] : (!fir.tdesc<!fir.type<_QMselect_type_lower_testTp1{a:i32,b:i32}>>) -> index75! CFG: %[[TDESC_CMP:.*]] = arith.cmpi eq, %[[TDESC_P1_CONV]], %[[BOX_TDESC_CONV]] : index76! CFG: cf.cond_br %[[TDESC_CMP]], ^[[TYPE_IS_P1_BLK:.*]], ^[[NOT_TYPE_IS_P1_BLK:.*]]77! CFG: ^[[NOT_TYPE_IS_P1_BLK]]:78! CFG: %[[TDESC_P2_ADDR:.*]] = fir.type_desc !fir.type<_QMselect_type_lower_testTp2{{.*}}79! CFG: %[[TDESC_P2_CONV:.*]] = fir.convert %[[TDESC_P2_ADDR]] : (!fir.tdesc<{{.*}}>) -> !fir.ref<none>80! CFG: %[[BOX_NONE:.*]] = fir.convert %[[ARG0]] : (!fir.class<!fir.type<_QMselect_type_lower_testTp1{a:i32,b:i32}>>) -> !fir.box<none>81! CFG: %[[CLASS_IS:.*]] = fir.call @_FortranAClassIs(%[[BOX_NONE]], %[[TDESC_P2_CONV]]) : (!fir.box<none>, !fir.ref<none>) -> i182! CFG: cf.cond_br %[[CLASS_IS]], ^bb[[CLASS_IS_P2_BLK:.*]], ^[[NOT_CLASS_IS_P2_BLK:.*]]83! CFG: ^[[TYPE_IS_P1_BLK]]:84! CFG: cf.br ^bb[[EXIT_SELECT_BLK:[0-9]]]85! CFG: ^bb[[NOT_CLASS_IS_P1_BLK:[0-9]]]:86! CFG: cf.br ^bb[[DEFAULT_BLK:[0-9]]]87! CFG: ^bb[[CLASS_IS_P1_BLK:[0-9]]]:88! CFG: cf.br ^[[END_SELECT_BLK:.*]]89! CFG: ^[[NOT_CLASS_IS_P2_BLK]]:90! CFG: %[[TDESC_P1_ADDR:.*]] = fir.type_desc !fir.type<_QMselect_type_lower_testTp1{a:i32,b:i32}>91! CFG: %[[TDESC_P1_CONV:.*]] = fir.convert %[[TDESC_P1_ADDR]] : (!fir.tdesc<{{.*}}>) -> !fir.ref<none>92! CFG: %[[BOX_NONE:.*]] = fir.convert %[[ARG0]] : (!fir.class<!fir.type<_QMselect_type_lower_testTp1{a:i32,b:i32}>>) -> !fir.box<none>93! CFG: %[[CLASS_IS:.*]] = fir.call @_FortranAClassIs(%[[BOX_NONE]], %[[TDESC_P1_CONV]]) : (!fir.box<none>, !fir.ref<none>) -> i194! CFG: cf.cond_br %[[CLASS_IS]], ^bb[[CLASS_IS_P1_BLK]], ^bb[[NOT_CLASS_IS_P1_BLK]]95! CFG: ^bb[[CLASS_IS_P2_BLK]]:96! CFG: cf.br ^[[END_SELECT_BLK]]97! CFG: ^bb[[DEFAULT_BLK]]:98! CFG: cf.br ^[[END_SELECT_BLK]]99! CFG: ^[[END_SELECT_BLK]]:100! CFG: return101 102 subroutine select_type2()103 select type (a => get_class())104 type is (p1)105 print*, 'type is p1'106 class is (p1)107 print*, 'class is p1'108 class default109 print*,'default'110 end select111 end subroutine112 113! CHECK-LABEL: func.func @_QMselect_type_lower_testPselect_type2()114! CHECK: %[[RESULT:.*]] = fir.alloca !fir.class<!fir.ptr<!fir.type<_QMselect_type_lower_testTp1{a:i32,b:i32}>>> {bindc_name = ".result"}115! CHECK: %[[FCTCALL:.*]] = fir.call @_QMselect_type_lower_testPget_class() {{.*}}: () -> !fir.class<!fir.ptr<!fir.type<_QMselect_type_lower_testTp1{a:i32,b:i32}>>>116! CHECK: fir.save_result %[[FCTCALL]] to %[[RESULT]] : !fir.class<!fir.ptr<!fir.type<_QMselect_type_lower_testTp1{a:i32,b:i32}>>>, !fir.ref<!fir.class<!fir.ptr<!fir.type<_QMselect_type_lower_testTp1{a:i32,b:i32}>>>>117! CHECK: %[[SELECTOR:.*]] = fir.load %[[RESULT]] : !fir.ref<!fir.class<!fir.ptr<!fir.type<_QMselect_type_lower_testTp1{a:i32,b:i32}>>>>118! CHECK: fir.select_type %[[SELECTOR]] : !fir.class<!fir.ptr<!fir.type<_QMselect_type_lower_testTp1{a:i32,b:i32}>>>119! CHECK-SAME: [#fir.type_is<!fir.type<_QMselect_type_lower_testTp1{a:i32,b:i32}>>, ^[[TYPE_IS_BLK:.*]], #fir.class_is<!fir.type<_QMselect_type_lower_testTp1{a:i32,b:i32}>>, ^[[CLASS_IS_BLK:.*]], unit, ^[[DEFAULT_BLK:.*]]]120! CHECK: ^[[TYPE_IS_BLK]]121! CHECK: ^[[CLASS_IS_BLK]]122! CHECK: ^[[DEFAULT_BLK]]123 124! CFG-LABEL: func.func @_QMselect_type_lower_testPselect_type2() {125! CFG: %[[CLASS_ALLOCA:.*]] = fir.alloca !fir.class<!fir.ptr<!fir.type<_QMselect_type_lower_testTp1{a:i32,b:i32}>>> {bindc_name = ".result"}126! CFG: %[[GET_CLASS:.*]] = fir.call @_QMselect_type_lower_testPget_class() {{.*}} : () -> !fir.class<!fir.ptr<!fir.type<_QMselect_type_lower_testTp1{a:i32,b:i32}>>>127! CFG: fir.save_result %[[GET_CLASS]] to %[[CLASS_ALLOCA]] : !fir.class<!fir.ptr<!fir.type<_QMselect_type_lower_testTp1{a:i32,b:i32}>>>, !fir.ref<!fir.class<!fir.ptr<!fir.type<_QMselect_type_lower_testTp1{a:i32,b:i32}>>>>128! CFG: %[[LOAD_CLASS:.*]] = fir.load %[[CLASS_ALLOCA]] : !fir.ref<!fir.class<!fir.ptr<!fir.type<_QMselect_type_lower_testTp1{a:i32,b:i32}>>>>129! CFG: %[[TDESC_P1_ADDR:.*]] = fir.type_desc !fir.type<_QMselect_type_lower_testTp1{a:i32,b:i32}>130! CFG: %[[CLASS_TDESC:.*]] = fir.box_tdesc %[[LOAD_CLASS]] : (!fir.class<!fir.ptr<!fir.type<_QMselect_type_lower_testTp1{a:i32,b:i32}>>>) -> !fir.tdesc<{{.*}}>131! CFG: %[[TDESC_P1_CONV:.*]] = fir.convert %[[TDESC_P1_ADDR]] : (!fir.tdesc{{.*}}>) -> index132! CFG: %[[BOX_TDESC_CONV:.*]] = fir.convert %[[CLASS_TDESC]] : (!fir.tdesc<{{.*}}>) -> index133! CFG: %[[TDESC_CMP:.*]] = arith.cmpi eq, %[[TDESC_P1_CONV]], %[[BOX_TDESC_CONV]] : index134! CFG: cf.cond_br %[[TDESC_CMP]], ^[[TYPE_IS_P1_BLK:.*]], ^[[NOT_TYPE_IS_P1_BLK:.*]]135! CFG: ^[[NOT_TYPE_IS_P1_BLK]]:136! CFG: %[[TDESC_P1_ADDR:.*]] = fir.type_desc !fir.type<_QMselect_type_lower_testTp1{a:i32,b:i32}>137! CFG: %[[TDESC_P1_CONV:.*]] = fir.convert %[[TDESC_P1_ADDR]] : (!fir.tdesc{{.*}}>) -> !fir.ref<none>138! CFG: %[[BOX_NONE:.*]] = fir.convert %[[LOAD_CLASS]] : (!fir.class<!fir.ptr<!fir.type<_QMselect_type_lower_testTp1{a:i32,b:i32}>>>) -> !fir.box<none>139! CFG: %[[CLASS_IS:.*]] = fir.call @_FortranAClassIs(%[[BOX_NONE]], %[[TDESC_P1_CONV]]) : (!fir.box<none>, !fir.ref<none>) -> i1140! CFG: cf.cond_br %[[CLASS_IS]], ^[[CLASS_IS_BLK:.*]], ^[[NOT_CLASS_IS_BLK:.*]]141! CFG: ^[[TYPE_IS_P1_BLK]]:142! CFG: cf.br ^bb[[EXIT_SELECT_BLK:[0-9]]]143! CFG: ^[[NOT_CLASS_IS_BLK]]:144! CFG: cf.br ^bb[[DEFAULT_BLK:[0-9]]]145! CFG: ^[[CLASS_IS_BLK]]:146! CFG: cf.br ^bb[[END_SELECT_BLK:[0-9]]]147! CFG: ^bb[[DEFAULT_BLK]]:148! CFG: cf.br ^bb[[END_SELECT_BLK:[0-9]]]149! CFG: ^bb[[END_SELECT_BLK:[0-9]]]:150! CFG: return151 152 subroutine select_type3(a)153 class(p1), pointer, intent(in) :: a(:)154 155 select type (x => a(1))156 type is (p1)157 print*, 'type is p1'158 class is (p1)159 print*, 'class is p1'160 class default161 print*,'default'162 end select163 end subroutine164 165! CHECK-LABEL: func.func @_QMselect_type_lower_testPselect_type3(166! CHECK-SAME: %[[ARG0:.*]]: !fir.ref<!fir.class<!fir.ptr<!fir.array<?x!fir.type<_QMselect_type_lower_testTp1{a:i32,b:i32}>>>>> {fir.bindc_name = "a"})167! CHECK: %[[ARG0_LOAD:.*]] = fir.load %[[ARG0]] : !fir.ref<!fir.class<!fir.ptr<!fir.array<?x!fir.type<_QMselect_type_lower_testTp1{a:i32,b:i32}>>>>>168! CHECK: %[[COORD:.*]] = fir.coordinate_of %[[ARG0_LOAD]], %{{.*}} : (!fir.class<!fir.ptr<!fir.array<?x!fir.type<_QMselect_type_lower_testTp1{a:i32,b:i32}>>>>, i64) -> !fir.ref<!fir.type<_QMselect_type_lower_testTp1{a:i32,b:i32}>>169! CHECK: %[[SELECTOR:.*]] = fir.embox %[[COORD]] source_box %[[ARG0_LOAD]] : (!fir.ref<!fir.type<_QMselect_type_lower_testTp1{a:i32,b:i32}>>, !fir.class<!fir.ptr<!fir.array<?x!fir.type<_QMselect_type_lower_testTp1{a:i32,b:i32}>>>>) -> !fir.class<!fir.type<_QMselect_type_lower_testTp1{a:i32,b:i32}>>170! CHECK: fir.select_type %[[SELECTOR]] : !fir.class<!fir.type<_QMselect_type_lower_testTp1{a:i32,b:i32}>>171! CHECK-SAME: [#fir.type_is<!fir.type<_QMselect_type_lower_testTp1{a:i32,b:i32}>>, ^[[TYPE_IS_BLK:.*]], #fir.class_is<!fir.type<_QMselect_type_lower_testTp1{a:i32,b:i32}>>, ^[[CLASS_IS_BLK:.*]], unit, ^[[DEFAULT_BLK:.*]]]172! CHECK: ^[[TYPE_IS_BLK]]173! CHECK: ^[[CLASS_IS_BLK]]174! CHECK: ^[[DEFAULT_BLK]]175 176! CFG-LABEL: func.func @_QMselect_type_lower_testPselect_type3(177! CFG-SAME: %[[ARG0:.*]]: !fir.ref<!fir.class<!fir.ptr<!fir.array<?x!fir.type<_QMselect_type_lower_testTp1{a:i32,b:i32}>>>>> {fir.bindc_name = "a"}) {178! CFG: %[[SELECTOR:.*]] = fir.embox %{{.*}} source_box %{{.*}} : (!fir.ref<!fir.type<_QMselect_type_lower_testTp1{a:i32,b:i32}>>, !fir.class<{{.*}}>) -> !fir.class<!fir.type<_QMselect_type_lower_testTp1{a:i32,b:i32}>>179! CFG: %[[TDESC_P1_ADDR:.*]] = fir.type_desc !fir.type<_QMselect_type_lower_testTp1{a:i32,b:i32}>180! CFG: %[[SELECTOR_TDESC:.*]] = fir.box_tdesc %[[SELECTOR]] : (!fir.class<!fir.type<_QMselect_type_lower_testTp1{a:i32,b:i32}>>) -> !fir.tdesc<{{.*}}>181! CFG: %[[TDESC_P1_CONV:.*]] = fir.convert %[[TDESC_P1_ADDR]] : (!fir.tdesc{{.*}}>) -> index182! CFG: %[[TDESC_CONV:.*]] = fir.convert %[[SELECTOR_TDESC]] : (!fir.tdesc<{{.*}}>) -> index183! CFG: %[[TDESC_CMP:.*]] = arith.cmpi eq, %[[TDESC_P1_CONV]], %[[TDESC_CONV]] : index184! CFG: cf.cond_br %[[TDESC_CMP]], ^[[TYPE_IS_P1_BLK:.*]], ^[[NOT_TYPE_IS_P1_BLK:.*]]185! CFG: ^[[NOT_TYPE_IS_P1_BLK]]:186! CFG: %[[TDESC_P1_ADDR:.*]] = fir.type_desc !fir.type<_QMselect_type_lower_testTp1{a:i32,b:i32}>187! CFG: %[[TDESC_P1_CONV:.*]] = fir.convert %[[TDESC_P1_ADDR]] : (!fir.tdesc{{.*}}>) -> !fir.ref<none>188! CFG: %[[BOX_NONE:.*]] = fir.convert %[[SELECTOR]] : (!fir.class<!fir.type<_QMselect_type_lower_testTp1{a:i32,b:i32}>>) -> !fir.box<none>189! CFG: %[[CLASS_IS:.*]] = fir.call @_FortranAClassIs(%[[BOX_NONE]], %[[TDESC_P1_CONV]]) : (!fir.box<none>, !fir.ref<none>) -> i1190! CFG: cf.cond_br %[[CLASS_IS]], ^[[CLASS_IS_BLK:.*]], ^[[NOT_CLASS_IS:.*]]191! CFG: ^[[TYPE_IS_P1_BLK]]:192! CFG: cf.br ^bb[[END_SELECT_BLK:[0-9]]]193! CFG: ^[[NOT_CLASS_IS]]:194! CFG: cf.br ^bb[[DEFAULT_BLK:[0-9]]]195! CFG: ^[[CLASS_IS_BLK]]:196! CFG: cf.br ^bb[[END_SELECT_BLK]]197! CFG: ^bb[[DEFAULT_BLK]]:198! CFG: cf.br ^bb[[END_SELECT_BLK]]199! CFG: ^bb[[END_SELECT_BLK]]:200! CFG: return201 202 subroutine select_type4(a)203 class(p1), intent(in) :: a204 select type(a)205 type is(p3(8))206 print*, 'type is p3(8)'207 type is(p3(4))208 print*, 'type is p3(4)'209 class is (p1)210 print*, 'class is p1'211 end select212 end subroutine213 214! CHECK-LABEL: func.func @_QMselect_type_lower_testPselect_type4(215! CHECK-SAME: %[[ARG0:.*]]: !fir.class<!fir.type<_QMselect_type_lower_testTp1{a:i32,b:i32}>> {fir.bindc_name = "a"})216! CHECK: fir.select_type %[[ARG0]] : !fir.class<!fir.type<_QMselect_type_lower_testTp1{a:i32,b:i32}>>217! CHECK-SAME: [#fir.type_is<!fir.type<_QMselect_type_lower_testTp3K8{a:i32,b:i32,r:f64}>>, ^[[P3_8:.*]], #fir.type_is<!fir.type<_QMselect_type_lower_testTp3K4{a:i32,b:i32,r:f32}>>, ^[[P3_4:.*]], #fir.class_is<!fir.type<_QMselect_type_lower_testTp1{a:i32,b:i32}>>, ^[[P1:.*]], unit, ^[[EXIT:.*]]]218! CHECK: ^[[P3_8]]219! CHECK: ^[[P3_4]]220! CHECK: ^[[P1]]221! CHECK: ^[[EXIT]]222 223! CFG-LABEL: func.func @_QMselect_type_lower_testPselect_type4(224! CFG-SAME: %[[ARG0:.*]]: !fir.class<!fir.type<_QMselect_type_lower_testTp1{a:i32,b:i32}>> {fir.bindc_name = "a"}) {225! CFG: %[[TDESC_P3_8_ADDR:.*]] = fir.type_desc !fir.type<_QMselect_type_lower_testTp3K8226! CFG: %[[BOX_TDESC:.*]] = fir.box_tdesc %[[ARG0]] : (!fir.class<!fir.type<_QMselect_type_lower_testTp1{a:i32,b:i32}>>) -> !fir.tdesc<{{.*}}>227! CFG: %[[TDESC_P3_8_CONV:.*]] = fir.convert %[[TDESC_P3_8_ADDR]] : (!fir.tdesc{{.*}}>) -> index228! CFG: %[[BOX_TDESC_CONV:.*]] = fir.convert %[[BOX_TDESC]] : (!fir.tdesc<{{.*}}>) -> index229! CFG: %[[TDESC_CMP:.*]] = arith.cmpi eq, %[[TDESC_P3_8_CONV]], %[[BOX_TDESC_CONV]] : index230! CFG: cf.cond_br %[[TDESC_CMP]], ^[[P3_8_BLK:.*]], ^[[NOT_P3_8_BLK:.*]]231! CFG: ^[[NOT_P3_8_BLK]]:232! CFG: %[[TDESC_P3_4_ADDR:.*]] = fir.type_desc !fir.type<_QMselect_type_lower_testTp3K4233! CFG: %[[BOX_TDESC:.*]] = fir.box_tdesc %[[ARG0]] : (!fir.class<!fir.type<_QMselect_type_lower_testTp1{a:i32,b:i32}>>) -> !fir.tdesc<{{.*}}>234! CFG: %[[TDESC_P3_4_CONV:.*]] = fir.convert %[[TDESC_P3_4_ADDR]] : (!fir.tdesc{{.*}}>) -> index235! CFG: %[[BOX_TDESC_CONV:.*]] = fir.convert %[[BOX_TDESC]] : (!fir.tdesc<{{.*}}>) -> index236! CFG: %[[TDESC_CMP:.*]] = arith.cmpi eq, %[[TDESC_P3_4_CONV]], %[[BOX_TDESC_CONV]] : index237! CFG: cf.cond_br %[[TDESC_CMP]], ^[[P3_4_BLK:.*]], ^[[NOT_P3_4_BLK:.*]]238! CFG: ^[[P3_8_BLK]]:239! CFG: _FortranAioOutputAscii240! CFG: cf.br ^bb[[EXIT_SELECT_BLK:[0-9]]]241! CFG: ^[[NOT_P3_4_BLK]]:242! CFG: %[[TDESC_P1_ADDR:.*]] = fir.type_desc !fir.type<_QMselect_type_lower_testTp1{a:i32,b:i32}>243! CFG: %[[TDESC_P1_CONV:.*]] = fir.convert %[[TDESC_P1_ADDR]] : (!fir.tdesc{{.*}}>) -> !fir.ref<none>244! CFG: %[[BOX_NONE:.*]] = fir.convert %[[ARG0]] : (!fir.class<!fir.type<_QMselect_type_lower_testTp1{a:i32,b:i32}>>) -> !fir.box<none>245! CFG: %[[CLASS_IS:.*]] = fir.call @_FortranAClassIs(%[[BOX_NONE]], %[[TDESC_P1_CONV]]) : (!fir.box<none>, !fir.ref<none>) -> i1246! CFG: cf.cond_br %[[CLASS_IS]], ^[[P1_BLK:.*]], ^[[NOT_P1_BLK:.*]]247! CFG: ^[[P3_4_BLK]]:248! CFG: cf.br ^bb[[EXIT_SELECT_BLK]]249! CFG: ^[[NOT_P1_BLK]]:250! CFG: cf.br ^bb[[EXIT_SELECT_BLK]]251! CFG: ^[[P1_BLK]]:252! CFG: cf.br ^bb[[EXIT_SELECT_BLK]]253! CFG: ^bb[[EXIT_SELECT_BLK]]:254! CFG: return255 256 subroutine select_type5(a)257 class(*), intent(in) :: a258 259 select type (x => a)260 type is (integer(1))261 print*, 'type is integer(1)'262 type is (integer(4))263 print*, 'type is integer(4)'264 type is (real(4))265 print*, 'type is real'266 type is (logical)267 print*, 'type is logical'268 type is (character(*))269 print*, 'type is character'270 class default271 print*,'default'272 end select273 end subroutine274 275! CHECK-LABEL: func.func @_QMselect_type_lower_testPselect_type5(276! CHECK-SAME: %[[ARG0:.*]]: !fir.class<none> {fir.bindc_name = "a"})277! CHECK: fir.select_type %[[ARG0]] : !fir.class<none>278! CHECK-SAME: [#fir.type_is<i8>, ^[[I8_BLK:.*]], #fir.type_is<i32>, ^[[I32_BLK:.*]], #fir.type_is<f32>, ^[[F32_BLK:.*]], #fir.type_is<!fir.logical<4>>, ^[[LOG_BLK:.*]], #fir.type_is<!fir.char<1,?>>, ^[[CHAR_BLK:.*]], unit, ^[[DEFAULT:.*]]]279! CHECK: ^[[I8_BLK]]280! CHECK: ^[[I32_BLK]]281! CHECK: ^[[F32_BLK]]282! CHECK: ^[[LOG_BLK]]283! CHECK: ^[[CHAR_BLK]]284! CHECK: ^[[DEFAULT_BLOCK]]285 286! CFG-LABEL: func.func @_QMselect_type_lower_testPselect_type5(287! CFG-SAME: %[[SELECTOR:.*]]: !fir.class<none> {fir.bindc_name = "a"}) {288 289! CFG: %[[INT8_TC:.*]] = arith.constant 7 : i8290! CFG: %[[TYPE_CODE:.*]] = fir.box_typecode %[[SELECTOR]] : (!fir.class<none>) -> i8291! CFG: %[[IS_INT8:.*]] = arith.cmpi eq, %[[TYPE_CODE]], %[[INT8_TC]] : i8292! CFG: cf.cond_br %[[IS_INT8]], ^[[INT8_BLK:.*]], ^[[NOT_INT8:.*]]293! CFG: ^[[NOT_INT8]]:294! CFG: %[[INT32_TC:.*]] = arith.constant 9 : i8295! CFG: %[[TYPE_CODE:.*]] = fir.box_typecode %[[SELECTOR]] : (!fir.class<none>) -> i8296! CFG: %[[IS_INT32:.*]] = arith.cmpi eq, %[[TYPE_CODE]], %[[INT32_TC]] : i8297! CFG: cf.cond_br %[[IS_INT32]], ^[[INT32_BLK:.*]], ^[[NOT_INT32_BLK:.*]]298! CFG: ^[[INT8_BLK]]:299! CFG: cf.br ^[[EXIT_BLK:.*]]300! CFG: ^[[NOT_INT32_BLK]]:301! CFG: %[[FLOAT_TC:.*]] = arith.constant 27 : i8302! CFG: %[[TYPE_CODE:.*]] = fir.box_typecode %[[SELECTOR]] : (!fir.class<none>) -> i8303! CFG: %[[IS_FLOAT:.*]] = arith.cmpi eq, %[[TYPE_CODE]], %[[FLOAT_TC]] : i8304! CFG: cf.cond_br %[[IS_FLOAT]], ^[[FLOAT_BLK:.*]], ^[[NOT_FLOAT_BLK:.*]]305! CFG: ^[[INT32_BLK]]:306! CFG: cf.br ^[[EXIT_BLK]]307! CFG: ^[[NOT_FLOAT_BLK]]:308! CFG: %[[LOGICAL_TC:.*]] = arith.constant 14 : i8309! CFG: %[[TYPE_CODE:.*]] = fir.box_typecode %[[SELECTOR]] : (!fir.class<none>) -> i8310! CFG: %[[IS_LOGICAL:.*]] = arith.cmpi eq, %[[TYPE_CODE]], %[[LOGICAL_TC]] : i8311! CFG: cf.cond_br %[[IS_LOGICAL]], ^[[LOGICAL_BLK:.*]], ^[[NOT_LOGICAL_BLK:.*]]312! CFG: ^[[FLOAT_BLK]]:313! CFG: cf.br ^[[EXIT_BLK]]314! CFG: ^[[NOT_LOGICAL_BLK]]:315! CFG: %[[CHAR_TC:.*]] = arith.constant 40 : i8316! CFG: %[[TYPE_CODE:.*]] = fir.box_typecode %[[SELECTOR]] : (!fir.class<none>) -> i8317! CFG: %[[IS_CHAR:.*]] = arith.cmpi eq, %[[TYPE_CODE]], %[[CHAR_TC]] : i8318! CFG: cf.cond_br %[[IS_CHAR]], ^[[CHAR_BLK:.*]], ^[[NOT_CHAR_BLK:.*]]319! CFG: ^[[LOGICAL_BLK]]:320! CFG: cf.br ^[[EXIT_BLK]]321! CFG: ^[[NOT_CHAR_BLK]]:322! CFG: cf.br ^[[DEFAULT_BLK:.*]]323! CFG: ^[[CHAR_BLK]]:324! CFG: cf.br ^[[EXIT_BLK]]325! CFG: ^[[DEFAULT_BLK]]:326! CFG: cf.br ^[[EXIT_BLK]]327! CFG: ^bb12:328! CFG: return329 330 subroutine select_type6(a)331 class(*) :: a332 333 select type(a)334 type is (integer)335 a = 100336 type is (real)337 a = 2.0338 class default339 stop 'error'340 end select341 end subroutine342 343! CHECK-LABEL: func.func @_QMselect_type_lower_testPselect_type6(344! CHECK-SAME: %[[ARG0:.*]]: !fir.class<none> {fir.bindc_name = "a"})345 346! CHECK: fir.select_type %[[ARG0]] : !fir.class<none> [#fir.type_is<i32>, ^[[INT_BLK:.*]], #fir.type_is<f32>, ^[[REAL_BLK:.*]], unit, ^[[DEFAULT_BLK:.*]]]347! CHECK: ^[[INT_BLK]]348! CHECK: %[[BOX_ADDR:.*]] = fir.box_addr %[[ARG0]] : (!fir.class<none>) -> !fir.ref<i32>349! CHECK: %[[C100:.*]] = arith.constant 100 : i32350! CHECK: fir.store %[[C100]] to %[[BOX_ADDR]] : !fir.ref<i32>351 352! CHECK: ^[[REAL_BLK]]: // pred: ^bb0353! CHECK: %[[BOX_ADDR:.*]] = fir.box_addr %[[ARG0]] : (!fir.class<none>) -> !fir.ref<f32>354! CHECK: %[[C2:.*]] = arith.constant 2.000000e+00 : f32355! CHECK: fir.store %[[C2]] to %[[BOX_ADDR]] : !fir.ref<f32>356 357 358! CFG-LABEL: func.func @_QMselect_type_lower_testPselect_type6(359! CFG-SAME: %[[ARG0:.*]]: !fir.class<none> {fir.bindc_name = "a"})360! CFG: %[[INT32_TYPECODE:.*]] = arith.constant 9 : i8361! CFG: %[[ARG0_TYPECODE:.*]] = fir.box_typecode %[[ARG0]] : (!fir.class<none>) -> i8362! CFG: %[[IS_TYPECODE:.*]] = arith.cmpi eq, %[[ARG0_TYPECODE]], %[[INT32_TYPECODE]] : i8363! CFG: cf.cond_br %[[IS_TYPECODE]], ^[[TYPE_IS_INT_BLK:.*]], ^[[TYPE_NOT_INT_BLK:.*]]364! CFG: ^[[TYPE_NOT_INT_BLK]]:365! CFG: %[[FLOAT_TYPECODE:.*]] = arith.constant 27 : i8366! CFG: %[[ARG0_TYPECODE:.*]] = fir.box_typecode %[[ARG0]] : (!fir.class<none>) -> i8367! CFG: %[[IS_TYPECODE:.*]] = arith.cmpi eq, %[[ARG0_TYPECODE]], %[[FLOAT_TYPECODE]] : i8368! CFG: cf.cond_br %[[IS_TYPECODE]], ^[[TYPE_IS_REAL_BLK:.*]], ^[[TYPE_NOT_REAL_BLK:.*]]369! CFG: ^[[TYPE_IS_INT_BLK]]:370! CFG: %[[BOX_ADDR:.*]] = fir.box_addr %[[ARG0]] : (!fir.class<none>) -> !fir.ref<i32>371! CFG: %[[C100:.*]] = arith.constant 100 : i32372! CFG: fir.store %[[C100]] to %[[BOX_ADDR]] : !fir.ref<i32>373! CFG: cf.br ^[[EXIT_SELECT_BLK:.*]]374! CFG: ^[[TYPE_NOT_REAL_BLK]]:375! CFG: cf.br ^[[DEFAULT_BLK:.*]]376! CFG: ^[[TYPE_IS_REAL_BLK]]:377! CFG: %[[BOX_ADDR:.*]] = fir.box_addr %[[ARG0]] : (!fir.class<none>) -> !fir.ref<f32>378! CFG: %[[CST:.*]] = arith.constant 2.000000e+00 : f32379! CFG: fir.store %[[CST]] to %[[BOX_ADDR]] : !fir.ref<f32>380! CFG: cf.br ^[[EXIT_SELECT_BLK]]381! CFG: ^[[DEFAULT_BLK]]:382! CFG: fir.call @_FortranAStopStatementText383! CFG: fir.unreachable384! CFG: ^[[EXIT_SELECT_BLK]]:385! CFG return386 387 subroutine select_type7(a)388 class(*), intent(out) :: a389 390 select type(a)391 class is (p1)392 print*, 'CLASS IS P1'393 class is (p2)394 print*, 'CLASS IS P2'395 class is (p4)396 print*, 'CLASS IS P4'397 class default398 print*, 'CLASS DEFAULT'399 end select400 end subroutine401 402! CHECK-LABEL: func.func @_QMselect_type_lower_testPselect_type7(403! CHECK-SAME: %[[ARG0:.*]]: !fir.class<none> {fir.bindc_name = "a"})404! CHECK: fir.select_type %[[ARG0]] :405! CHECK-SAME: !fir.class<none> [#fir.class_is<!fir.type<_QMselect_type_lower_testTp1{a:i32,b:i32}>>, ^bb1, #fir.class_is<!fir.type<_QMselect_type_lower_testTp2{a:i32,b:i32,c:i32}>>, ^bb2, #fir.class_is<!fir.type<_QMselect_type_lower_testTp4{a:i32,b:i32,c:i32,d:i32}>>, ^bb3, unit, ^bb4]406 407! Check correct ordering of class is type guard. The expected flow should be:408! class is (p4) -> class is (p2) -> class is (p1) -> class default409 410! CFG-LABEL: func.func @_QMselect_type_lower_testPselect_type7(411! CFG-SAME: %[[ARG0:.*]]: !fir.class<none> {fir.bindc_name = "a"}) {412! CFG: %[[TDESC_P4_ADDR:.*]] = fir.type_desc !fir.type<_QMselect_type_lower_testTp4413! CFG: %[[TDESC_P4_CONV:.*]] = fir.convert %[[TDESC_P4_ADDR]] : (!fir.tdesc{{.*}}>) -> !fir.ref<none>414! CFG: %[[BOX_NONE:.*]] = fir.convert %[[ARG0]] : (!fir.class<none>) -> !fir.box<none>415! CFG: %[[CLASS_IS_P4:.*]] = fir.call @_FortranAClassIs(%[[BOX_NONE]], %[[TDESC_P4_CONV]]) : (!fir.box<none>, !fir.ref<none>) -> i1416! CFG: cf.cond_br %[[CLASS_IS_P4]], ^[[CLASS_IS_P4_BLK:.*]], ^[[CLASS_NOT_P4_BLK:.*]]417! CFG: ^bb[[CLASS_NOT_P1_BLK:[0-9]]]:418! CFG: cf.br ^[[CLASS_DEFAULT_BLK:.*]]419! CFG: ^bb[[CLASS_IS_P1_BLK:[0-9]]]:420! CFG: cf.br ^[[EXIT_SELECT_BLK:.*]]421! CFG: ^bb[[CLASS_NOT_P2_BLK:[0-9]]]:422! CFG: %[[TDESC_P1_ADDR:.*]] = fir.type_desc !fir.type<_QMselect_type_lower_testTp1{a:i32,b:i32}>423! CFG: %[[TDESC_P1_CONV:.*]] = fir.convert %[[TDESC_P1_ADDR]] : (!fir.tdesc{{.*}}>) -> !fir.ref<none>424! CFG: %[[BOX_NONE:.*]] = fir.convert %[[ARG0]] : (!fir.class<none>) -> !fir.box<none>425! CFG: %[[CLASS_IS_P1:.*]] = fir.call @_FortranAClassIs(%[[BOX_NONE]], %[[TDESC_P1_CONV]]) : (!fir.box<none>, !fir.ref<none>) -> i1426! CFG: cf.cond_br %[[CLASS_IS_P1]], ^bb[[CLASS_IS_P1_BLK]], ^bb[[CLASS_NOT_P1_BLK]]427! CFG: ^bb[[CLASS_IS_P2_BLK:[0-9]]]:428! CFG: cf.br ^[[EXIT_SELECT_BLK]]429! CFG: ^[[CLASS_NOT_P4_BLK]]:430! CFG: %[[TDESC_P2_ADDR:.*]] = fir.type_desc !fir.type<_QMselect_type_lower_testTp2431! CFG: %[[TDESC_P2_CONV:.*]] = fir.convert %[[TDESC_P2_ADDR]] : (!fir.tdesc{{.*}}>) -> !fir.ref<none>432! CFG: %[[BOX_NONE:.*]] = fir.convert %[[ARG0]] : (!fir.class<none>) -> !fir.box<none>433! CFG: %[[CLASS_IS_P2:.*]] = fir.call @_FortranAClassIs(%[[BOX_NONE]], %[[TDESC_P2_CONV]]) : (!fir.box<none>, !fir.ref<none>) -> i1434! CFG: cf.cond_br %[[CLASS_IS_P2]], ^bb[[CLASS_IS_P2_BLK]], ^bb[[CLASS_NOT_P2_BLK]]435! CFG: ^[[CLASS_IS_P4_BLK]]:436! CFG: cf.br ^[[EXIT_SELECT_BLK]]437! CFG: ^[[CLASS_DEFAULT_BLK]]:438! CFG: cf.br ^[[EXIT_SELECT_BLK]]439! CFG: ^[[EXIT_SELECT_BLK]]:440! CFG: return441 442 subroutine select_type8(a)443 class(*) :: a(:)444 445 select type(a)446 type is (integer)447 a = 100448 type is (real)449 a = 2.0450 type is (character(*))451 a(1) = 'c'452 a(2) = 'h'453 type is (p1)454 a%a = 1455 a%b = 2456 class is(p2)457 a%a = 1458 a%b = 2459 a%c = 3460 class default461 stop 'error'462 end select463 end subroutine464 465! CHECK-LABEL: func.func @_QMselect_type_lower_testPselect_type8(466! CHECK-SAME: %[[ARG0:.*]]: !fir.class<!fir.array<?xnone>> {fir.bindc_name = "a"}) {467! CHECK: %[[SELECTOR:.*]] = fir.rebox %[[ARG0]] : (!fir.class<!fir.array<?xnone>>) -> !fir.class<!fir.array<?xnone>>468! CHECK: fir.select_type %[[SELECTOR]] : !fir.class<!fir.array<?xnone>> [#fir.type_is<i32>, ^{{.*}}, #fir.type_is<f32>, ^{{.*}}, #fir.type_is<!fir.char<1,?>>, ^bb{{.*}}, unit, ^{{.*}}]469! CHECK: ^bb{{.*}}:470! CHECK: %[[BOX:.*]] = fir.convert %[[SELECTOR]] : (!fir.class<!fir.array<?xnone>>) -> !fir.box<!fir.array<?xi32>>471! CHECK: %[[C0:.*]] = arith.constant 0 : index472! CHECK: %[[SELECTOR_DIMS:.*]]:3 = fir.box_dims %[[BOX]], %[[C0]] : (!fir.box<!fir.array<?xi32>>, index) -> (index, index, index)473! CHECK: %[[ARRAY_LOAD:.*]] = fir.array_load %[[BOX]] : (!fir.box<!fir.array<?xi32>>) -> !fir.array<?xi32>474! CHECK: %[[C100:.*]] = arith.constant 100 : i32475! CHECK: %[[C1:.*]] = arith.constant 1 : index476! CHECK: %[[C0:.*]] = arith.constant 0 : index477! CHECK: %[[UB:.*]] = arith.subi %[[SELECTOR_DIMS:.*]]#1, %[[C1]] : index478! CHECK: %[[LOOP_RES:.*]] = fir.do_loop %[[IND:.*]] = %[[C0:.*]] to %[[UB]] step %[[C1]] unordered iter_args(%[[ARG:.*]] = %[[ARRAY_LOAD]]) -> (!fir.array<?xi32>) {479! CHECK: %[[ARR_UP:.*]] = fir.array_update %[[ARG]], %[[C100]], %[[IND]] : (!fir.array<?xi32>, i32, index) -> !fir.array<?xi32>480! CHECK: fir.result %[[ARR_UP]] : !fir.array<?xi32>481! CHECK: }482! CHECK: fir.array_merge_store %[[ARRAY_LOAD]], %[[LOOP_RES]] to %[[BOX]] : !fir.array<?xi32>, !fir.array<?xi32>, !fir.box<!fir.array<?xi32>>483! CHECK: cf.br ^{{.*}}484! CHECK: ^bb{{.*}}:485! CHECK: %[[BOX:.*]] = fir.convert %[[SELECTOR]] : (!fir.class<!fir.array<?xnone>>) -> !fir.box<!fir.array<?xf32>>486! CHECK: %[[C0:.*]] = arith.constant 0 : index487! CHECK: %[[SELECTOR_DIMS:.*]]:3 = fir.box_dims %[[BOX]], %[[C0]] : (!fir.box<!fir.array<?xf32>>, index) -> (index, index, index)488! CHECK: %[[ARRAY_LOAD:.*]] = fir.array_load %[[BOX]] : (!fir.box<!fir.array<?xf32>>) -> !fir.array<?xf32>489! CHECK: %[[VALUE:.*]] = arith.constant 2.000000e+00 : f32490! CHECK: %[[C1:.*]] = arith.constant 1 : index491! CHECK: %[[C0:.*]] = arith.constant 0 : index492! CHECK: %[[UB:.*]] = arith.subi %[[SELECTOR_DIMS]]#1, %[[C1]] : index493! CHECK: %[[LOOP_RES:.*]] = fir.do_loop %[[IND:.*]] = %[[C0]] to %[[UB]] step %[[C1]] unordered iter_args(%[[ARG:.*]] = %[[ARRAY_LOAD]]) -> (!fir.array<?xf32>) {494! CHECK: %[[ARR_UP:.*]] = fir.array_update %[[ARG]], %[[VALUE]], %[[IND]] : (!fir.array<?xf32>, f32, index) -> !fir.array<?xf32>495! CHECK: fir.result %[[ARR_UP]] : !fir.array<?xf32>496! CHECK: }497! CHECK: fir.array_merge_store %[[ARRAY_LOAD]], %[[LOOP_RES]] to %[[BOX]] : !fir.array<?xf32>, !fir.array<?xf32>, !fir.box<!fir.array<?xf32>>498! CHECK: cf.br ^{{.*}}499! CHECK: ^bb{{.*}}:500! CHECK: %[[BOX:.*]] = fir.convert %{{[0-9]+}} : (!fir.class<!fir.array<?xnone>>) -> !fir.box<!fir.array<?x!fir.char<1,?>>>501! CHECK: cf.br ^bb{{.*}}502! CHECK: ^bb{{.*}}:503! CHECK: %[[EXACT_BOX:.*]] = fir.convert %[[SELECTOR]] : (!fir.class<!fir.array<?xnone>>) -> !fir.box<!fir.array<?x!fir.type<_QMselect_type_lower_testTp1{a:i32,b:i32}>>>504! CHECK: %[[FIELD_A:.*]] = fir.field_index a, !fir.type<_QMselect_type_lower_testTp1{a:i32,b:i32}>505! CHECK: %[[C0:.*]] = arith.constant 0 : index506! CHECK: %[[BOX_DIMS:.*]]:3 = fir.box_dims %[[EXACT_BOX]], %[[C0]] : (!fir.box<!fir.array<?x!fir.type<_QMselect_type_lower_testTp1{a:i32,b:i32}>>>, index) -> (index, index, index)507! CHECK: %[[C1:.*]] = arith.constant 1 : index508! CHECK: %[[SLICE:.*]] = fir.slice %[[C1]], %[[BOX_DIMS]]#1, %[[C1]] path %[[FIELD_A]] : (index, index, index, !fir.field) -> !fir.slice<1>509! CHECK: %[[ARRAY_LOAD:.*]] = fir.array_load %[[EXACT_BOX]] [%[[SLICE]]] : (!fir.box<!fir.array<?x!fir.type<_QMselect_type_lower_testTp1{a:i32,b:i32}>>>, !fir.slice<1>) -> !fir.array<?xi32>510! CHECK: %[[DO_RES:.*]] = fir.do_loop %[[IND:.*]] = %{{.*}} to %{{.*}} step %{{.*}} unordered iter_args(%[[ARG:.*]] = %[[ARRAY_LOAD]]) -> (!fir.array<?xi32>) {511! CHECK: %[[ARR_UP:.*]] = fir.array_update %[[ARG]], %{{.*}}, %[[IND]] : (!fir.array<?xi32>, i32, index) -> !fir.array<?xi32>512! CHECK: fir.result %[[ARR_UP]] : !fir.array<?xi32>513! CHECK: }514! CHECK: fir.array_merge_store %[[ARRAY_LOAD]], %[[DO_RES]] to %[[EXACT_BOX]][%[[SLICE]]] : !fir.array<?xi32>, !fir.array<?xi32>, !fir.box<!fir.array<?x!fir.type<_QMselect_type_lower_testTp1{a:i32,b:i32}>>>, !fir.slice<1>515! CHECK: %[[FIELD_B:.*]] = fir.field_index b, !fir.type<_QMselect_type_lower_testTp1{a:i32,b:i32}>516! CHECK: %[[C0:.*]] = arith.constant 0 : index517! CHECK: %[[BOX_DIMS:.*]]:3 = fir.box_dims %[[EXACT_BOX]], %[[C0]] : (!fir.box<!fir.array<?x!fir.type<_QMselect_type_lower_testTp1{a:i32,b:i32}>>>, index) -> (index, index, index)518! CHECK: %[[C1:.*]] = arith.constant 1 : index519! CHECK: %[[SLICE:.*]] = fir.slice %[[C1]], %[[BOX_DIMS]]#1, %[[C1]] path %[[FIELD_B]] : (index, index, index, !fir.field) -> !fir.slice<1>520! CHECK: %[[ARRAY_LOAD:.*]] = fir.array_load %[[EXACT_BOX]] [%[[SLICE]]] : (!fir.box<!fir.array<?x!fir.type<_QMselect_type_lower_testTp1{a:i32,b:i32}>>>, !fir.slice<1>) -> !fir.array<?xi32>521! CHECK: %[[DO_RES:.*]] = fir.do_loop %[[IND:.*]] = %{{.*}} to %{{.*}} step %c{{.*}} unordered iter_args(%[[ARG:.*]] = %[[ARRAY_LOAD]]) -> (!fir.array<?xi32>) {522! CHECK: %[[ARR_UP:.*]] = fir.array_update %[[ARG]], %{{.*}}, %[[IND]] : (!fir.array<?xi32>, i32, index) -> !fir.array<?xi32>523! CHECK: fir.result %[[ARR_UP]] : !fir.array<?xi32>524! CHECK: }525! CHECK: fir.array_merge_store %[[ARRAY_LOAD]], %[[DO_RES]] to %[[EXACT_BOX]][%[[SLICE]]] : !fir.array<?xi32>, !fir.array<?xi32>, !fir.box<!fir.array<?x!fir.type<_QMselect_type_lower_testTp1{a:i32,b:i32}>>>, !fir.slice<1>526! CHECK: cf.br ^{{.*}}527! CHECK: ^bb{{.*}}:528! CHECK: %[[CLASS_BOX:.*]] = fir.convert %[[SELECTOR]] : (!fir.class<!fir.array<?xnone>>) -> !fir.class<!fir.array<?x!fir.type<_QMselect_type_lower_testTp2{a:i32,b:i32,c:i32}>>>529! CHECK: %[[FIELD_A:.*]] = fir.field_index a, !fir.type<_QMselect_type_lower_testTp2{a:i32,b:i32,c:i32}>530! CHECK: %[[C0:.*]] = arith.constant 0 : index531! CHECK: %[[BOX_DIMS:.*]]:3 = fir.box_dims %[[CLASS_BOX]], %[[C0]] : (!fir.class<!fir.array<?x!fir.type<_QMselect_type_lower_testTp2{a:i32,b:i32,c:i32}>>>, index) -> (index, index, index)532! CHECK: %[[C1:.*]] = arith.constant 1 : index533! CHECK: %[[SLICE:.*]] = fir.slice %[[C1]], %[[BOX_DIMS]]#1, %[[C1]] path %[[FIELD_A]] : (index, index, index, !fir.field) -> !fir.slice<1>534! CHECK: %[[ARRAY_LOAD:.*]] = fir.array_load %[[CLASS_BOX]] [%[[SLICE]]] : (!fir.class<!fir.array<?x!fir.type<_QMselect_type_lower_testTp2{a:i32,b:i32,c:i32}>>>, !fir.slice<1>) -> !fir.array<?xi32>535! CHECK: %[[DO_RES:.*]] = fir.do_loop %[[IND:.*]] = %{{.*}} to %{{.*}} step %{{.*}} unordered iter_args(%[[ARG:.*]] = %[[ARRAY_LOAD]]) -> (!fir.array<?xi32>) {536! CHECK: %[[ARR_UP:.*]] = fir.array_update %[[ARG]], %{{.*}}, %[[IND]] : (!fir.array<?xi32>, i32, index) -> !fir.array<?xi32>537! CHECK: fir.result %[[ARR_UP]] : !fir.array<?xi32>538! CHECK: }539! CHECK: fir.array_merge_store %[[ARRAY_LOAD]], %[[DO_RES]] to %[[CLASS_BOX]][%[[SLICE]]] : !fir.array<?xi32>, !fir.array<?xi32>, !fir.class<!fir.array<?x!fir.type<_QMselect_type_lower_testTp2{a:i32,b:i32,c:i32}>>>, !fir.slice<1>540! CHECK: %[[FIELD_B:.*]] = fir.field_index b, !fir.type<_QMselect_type_lower_testTp2{a:i32,b:i32,c:i32}>541! CHECK: %[[C0:.*]] = arith.constant 0 : index542! CHECK: %[[BOX_DIMS:.*]]:3 = fir.box_dims %[[CLASS_BOX]], %[[C0]] : (!fir.class<!fir.array<?x!fir.type<_QMselect_type_lower_testTp2{a:i32,b:i32,c:i32}>>>, index) -> (index, index, index)543! CHECK: %[[C1:.*]] = arith.constant 1 : index544! CHECK: %[[SLICE:.*]] = fir.slice %[[C1]], %[[BOX_DIMS]]#1, %[[C1]] path %[[FIELD_B]] : (index, index, index, !fir.field) -> !fir.slice<1>545! CHECK: %[[ARRAY_LOAD:.*]] = fir.array_load %[[CLASS_BOX]] [%[[SLICE]]] : (!fir.class<!fir.array<?x!fir.type<_QMselect_type_lower_testTp2{a:i32,b:i32,c:i32}>>>, !fir.slice<1>) -> !fir.array<?xi32>546! CHECK: %[[DO_RES:.*]] = fir.do_loop %[[IND:.*]] = %{{.*}} to %{{.*}} step %{{.*}} unordered iter_args(%[[ARG:.*]] = %[[ARRAY_LOAD]]) -> (!fir.array<?xi32>) {547! CHECK: %[[ARR_UP:.*]] = fir.array_update %[[ARG]], %{{.*}}, %[[IND]] : (!fir.array<?xi32>, i32, index) -> !fir.array<?xi32>548! CHECK: fir.result %[[ARR_UP]] : !fir.array<?xi32>549! CHECK: }550! CHECK: fir.array_merge_store %[[ARRAY_LOAD]], %[[DO_RES]] to %[[CLASS_BOX]][%[[SLICE]]] : !fir.array<?xi32>, !fir.array<?xi32>, !fir.class<!fir.array<?x!fir.type<_QMselect_type_lower_testTp2{a:i32,b:i32,c:i32}>>>, !fir.slice<1>551! CHECK: %[[FIELD_C:.*]] = fir.field_index c, !fir.type<_QMselect_type_lower_testTp2{a:i32,b:i32,c:i32}>552! CHECK: %[[C0:.*]] = arith.constant 0 : index553! CHECK: %[[BOX_DIMS:.*]]:3 = fir.box_dims %[[CLASS_BOX]], %[[C0]] : (!fir.class<!fir.array<?x!fir.type<_QMselect_type_lower_testTp2{a:i32,b:i32,c:i32}>>>, index) -> (index, index, index)554! CHECK: %[[C1:.*]] = arith.constant 1 : index555! CHECK: %[[SLICE:.*]] = fir.slice %[[C1]], %[[BOX_DIMS]]#1, %[[C1]] path %[[FIELD_C]] : (index, index, index, !fir.field) -> !fir.slice<1>556! CHECK: %[[ARRAY_LOAD:.*]] = fir.array_load %[[CLASS_BOX]] [%[[SLICE]]] : (!fir.class<!fir.array<?x!fir.type<_QMselect_type_lower_testTp2{a:i32,b:i32,c:i32}>>>, !fir.slice<1>) -> !fir.array<?xi32>557! CHECK: %[[DO_RES:.*]] = fir.do_loop %[[IND:.*]] = %{{.*}} to %{{.*}} step %{{.*}} unordered iter_args(%[[ARG:.*]] = %[[ARRAY_LOAD]]) -> (!fir.array<?xi32>) {558! CHECK: %[[ARR_UP:.*]] = fir.array_update %[[ARG]], %{{.*}}, %[[IND]] : (!fir.array<?xi32>, i32, index) -> !fir.array<?xi32>559! CHECK: fir.result %[[ARR_UP]] : !fir.array<?xi32>560! CHECK: }561! CHECK: fir.array_merge_store %[[ARRAY_LOAD]], %[[DO_RES]] to %[[CLASS_BOX]][%[[SLICE]]] : !fir.array<?xi32>, !fir.array<?xi32>, !fir.class<!fir.array<?x!fir.type<_QMselect_type_lower_testTp2{a:i32,b:i32,c:i32}>>>, !fir.slice<1>562! CHECK: cf.br ^bb{{.*}}563 564 subroutine select_type9(a)565 class(p1) :: a(:)566 567 select type(a)568 type is (p1)569 a%a = 1570 a%b = 2571 type is(p2)572 a%a = 1573 a%b = 2574 a%c = 3575 class default576 stop 'error'577 end select578 end subroutine579 580! CHECK-LABEL: func.func @_QMselect_type_lower_testPselect_type9(581! CHECK-SAME: %[[ARG0:.*]]: !fir.class<!fir.array<?x!fir.type<_QMselect_type_lower_testTp1{a:i32,b:i32}>>> {fir.bindc_name = "a"}) {582! CHECK: %[[SELECTOR:.*]] = fir.rebox %[[ARG0]] : (!fir.class<!fir.array<?x!fir.type<_QMselect_type_lower_testTp1{a:i32,b:i32}>>>) -> !fir.class<!fir.array<?x!fir.type<_QMselect_type_lower_testTp1{a:i32,b:i32}>>>583! CHECK: fir.select_type %[[SELECTOR]] : !fir.class<!fir.array<?x!fir.type<_QMselect_type_lower_testTp1{a:i32,b:i32}>>> [#fir.type_is<!fir.type<_QMselect_type_lower_testTp1{a:i32,b:i32}>>, ^bb{{.*}}, #fir.type_is<!fir.type<_QMselect_type_lower_testTp2{a:i32,b:i32,c:i32}>>, ^bb{{.*}}, unit, ^bb{{.*}}]584! CHECK: ^bb{{.*}}:585! CHECK: %[[EXACT_BOX:.*]] = fir.convert %[[SELECTOR]] : (!fir.class<!fir.array<?x!fir.type<_QMselect_type_lower_testTp1{a:i32,b:i32}>>>) -> !fir.box<!fir.array<?x!fir.type<_QMselect_type_lower_testTp1{a:i32,b:i32}>>>586! CHECK: %[[FIELD_A:.*]] = fir.field_index a, !fir.type<_QMselect_type_lower_testTp1{a:i32,b:i32}>587! CHECK: %[[C0:.*]] = arith.constant 0 : index588! CHECK: %[[BOX_DIMS:.*]]:3 = fir.box_dims %[[EXACT_BOX]], %[[C0]] : (!fir.box<!fir.array<?x!fir.type<_QMselect_type_lower_testTp1{a:i32,b:i32}>>>, index) -> (index, index, index)589! CHECK: %[[C1:.*]] = arith.constant 1 : index590! CHECK: %[[SLICE:.*]] = fir.slice %[[C1]], %[[BOX_DIMS]]#1, %[[C1]] path %[[FIELD_A]] : (index, index, index, !fir.field) -> !fir.slice<1>591! CHECK: %[[ARRAY_LOAD:.*]] = fir.array_load %[[EXACT_BOX]] [%[[SLICE]]] : (!fir.box<!fir.array<?x!fir.type<_QMselect_type_lower_testTp1{a:i32,b:i32}>>>, !fir.slice<1>) -> !fir.array<?xi32>592! CHECK: %[[DO_RES:.*]] = fir.do_loop %[[IND:.*]] = %{{.*}} to %{{.*}} step %{{.*}} unordered iter_args(%[[ARG:.*]] = %[[ARRAY_LOAD]]) -> (!fir.array<?xi32>) {593! CHECK: %[[ARR_UP:.*]] = fir.array_update %[[ARG]], %{{.*}}, %[[IND]] : (!fir.array<?xi32>, i32, index) -> !fir.array<?xi32>594! CHECK: fir.result %[[ARR_UP]] : !fir.array<?xi32>595! CHECK: }596! CHECK: fir.array_merge_store %[[ARRAY_LOAD]], %[[DO_RES]] to %[[EXACT_BOX]][%[[SLICE]]] : !fir.array<?xi32>, !fir.array<?xi32>, !fir.box<!fir.array<?x!fir.type<_QMselect_type_lower_testTp1{a:i32,b:i32}>>>, !fir.slice<1>597! CHECK: %[[FIELD_B:.*]] = fir.field_index b, !fir.type<_QMselect_type_lower_testTp1{a:i32,b:i32}>598! CHECK: %[[C0:.*]] = arith.constant 0 : index599! CHECK: %[[BOX_DIMS:.*]]:3 = fir.box_dims %[[EXACT_BOX]], %[[C0]] : (!fir.box<!fir.array<?x!fir.type<_QMselect_type_lower_testTp1{a:i32,b:i32}>>>, index) -> (index, index, index)600! CHECK: %[[C1:.*]] = arith.constant 1 : index601! CHECK: %[[SLICE:.*]] = fir.slice %[[C1]], %[[BOX_DIMS]]#1, %[[C1]] path %[[FIELD_B]] : (index, index, index, !fir.field) -> !fir.slice<1>602! CHECK: %[[ARRAY_LOAD:.*]] = fir.array_load %[[EXACT_BOX]] [%[[SLICE]]] : (!fir.box<!fir.array<?x!fir.type<_QMselect_type_lower_testTp1{a:i32,b:i32}>>>, !fir.slice<1>) -> !fir.array<?xi32>603! CHECK: %[[DO_RES:.*]] = fir.do_loop %[[IND:.*]] = %{{.*}} to %{{.*}} step %c{{.*}} unordered iter_args(%[[ARG:.*]] = %[[ARRAY_LOAD]]) -> (!fir.array<?xi32>) {604! CHECK: %[[ARR_UP:.*]] = fir.array_update %[[ARG]], %{{.*}}, %[[IND]] : (!fir.array<?xi32>, i32, index) -> !fir.array<?xi32>605! CHECK: fir.result %[[ARR_UP]] : !fir.array<?xi32>606! CHECK: }607! CHECK: fir.array_merge_store %[[ARRAY_LOAD]], %[[DO_RES]] to %[[EXACT_BOX]][%[[SLICE]]] : !fir.array<?xi32>, !fir.array<?xi32>, !fir.box<!fir.array<?x!fir.type<_QMselect_type_lower_testTp1{a:i32,b:i32}>>>, !fir.slice<1>608! CHECK: cf.br ^bb{{.*}}609! CHECK: ^bb{{.*}}:610! CHECK: %[[EXACT_BOX:.*]] = fir.convert %[[SELECTOR]] : (!fir.class<!fir.array<?x!fir.type<_QMselect_type_lower_testTp1{a:i32,b:i32}>>>) -> !fir.box<!fir.array<?x!fir.type<_QMselect_type_lower_testTp2{a:i32,b:i32,c:i32}>>>611! CHECK: %[[FIELD_A:.*]] = fir.field_index a, !fir.type<_QMselect_type_lower_testTp2{a:i32,b:i32,c:i32}>612! CHECK: %[[C0:.*]] = arith.constant 0 : index613! CHECK: %[[BOX_DIMS:.*]]:3 = fir.box_dims %[[EXACT_BOX]], %[[C0]] : (!fir.box<!fir.array<?x!fir.type<_QMselect_type_lower_testTp2{a:i32,b:i32,c:i32}>>>, index) -> (index, index, index)614! CHECK: %[[C1:.*]] = arith.constant 1 : index615! CHECK: %[[SLICE:.*]] = fir.slice %[[C1]], %[[BOX_DIMS]]#1, %[[C1]] path %[[FIELD_A]] : (index, index, index, !fir.field) -> !fir.slice<1>616! CHECK: %[[ARRAY_LOAD:.*]] = fir.array_load %[[EXACT_BOX]] [%[[SLICE]]] : (!fir.box<!fir.array<?x!fir.type<_QMselect_type_lower_testTp2{a:i32,b:i32,c:i32}>>>, !fir.slice<1>) -> !fir.array<?xi32>617! CHECK: %[[DO_RES:.*]] = fir.do_loop %[[IND:.*]] = %{{.*}} to %{{.*}} step %{{.*}} unordered iter_args(%[[ARG:.*]] = %[[ARRAY_LOAD]]) -> (!fir.array<?xi32>) {618! CHECK: %[[ARR_UP:.*]] = fir.array_update %[[ARG]], %{{.*}}, %[[IND]] : (!fir.array<?xi32>, i32, index) -> !fir.array<?xi32>619! CHECK: fir.result %[[ARR_UP]] : !fir.array<?xi32>620! CHECK: }621! CHECK: fir.array_merge_store %[[ARRAY_LOAD]], %[[DO_RES]] to %[[EXACT_BOX]][%[[SLICE]]] : !fir.array<?xi32>, !fir.array<?xi32>, !fir.box<!fir.array<?x!fir.type<_QMselect_type_lower_testTp2{a:i32,b:i32,c:i32}>>>, !fir.slice<1>622! CHECK: %[[FIELD_B:.*]] = fir.field_index b, !fir.type<_QMselect_type_lower_testTp2{a:i32,b:i32,c:i32}>623! CHECK: %[[C0:.*]] = arith.constant 0 : index624! CHECK: %[[BOX_DIMS:.*]]:3 = fir.box_dims %[[EXACT_BOX]], %[[C0]] : (!fir.box<!fir.array<?x!fir.type<_QMselect_type_lower_testTp2{a:i32,b:i32,c:i32}>>>, index) -> (index, index, index)625! CHECK: %[[C1:.*]] = arith.constant 1 : index626! CHECK: %[[SLICE:.*]] = fir.slice %[[C1]], %[[BOX_DIMS]]#1, %[[C1]] path %[[FIELD_B]] : (index, index, index, !fir.field) -> !fir.slice<1>627! CHECK: %[[ARRAY_LOAD:.*]] = fir.array_load %[[EXACT_BOX]] [%[[SLICE]]] : (!fir.box<!fir.array<?x!fir.type<_QMselect_type_lower_testTp2{a:i32,b:i32,c:i32}>>>, !fir.slice<1>) -> !fir.array<?xi32>628! CHECK: %[[DO_RES:.*]] = fir.do_loop %[[IND:.*]] = %{{.*}} to %{{.*}} step %{{.*}} unordered iter_args(%[[ARG:.*]] = %[[ARRAY_LOAD]]) -> (!fir.array<?xi32>) {629! CHECK: %[[ARR_UP:.*]] = fir.array_update %[[ARG]], %{{.*}}, %[[IND]] : (!fir.array<?xi32>, i32, index) -> !fir.array<?xi32>630! CHECK: fir.result %[[ARR_UP]] : !fir.array<?xi32>631! CHECK: }632! CHECK: fir.array_merge_store %[[ARRAY_LOAD]], %[[DO_RES]] to %[[EXACT_BOX]][%[[SLICE]]] : !fir.array<?xi32>, !fir.array<?xi32>, !fir.box<!fir.array<?x!fir.type<_QMselect_type_lower_testTp2{a:i32,b:i32,c:i32}>>>, !fir.slice<1>633! CHECK: %[[FIELD_C:.*]] = fir.field_index c, !fir.type<_QMselect_type_lower_testTp2{a:i32,b:i32,c:i32}>634! CHECK: %[[C0:.*]] = arith.constant 0 : index635! CHECK: %[[BOX_DIMS:.*]]:3 = fir.box_dims %[[EXACT_BOX]], %[[C0]] : (!fir.box<!fir.array<?x!fir.type<_QMselect_type_lower_testTp2{a:i32,b:i32,c:i32}>>>, index) -> (index, index, index)636! CHECK: %[[C1:.*]] = arith.constant 1 : index637! CHECK: %[[SLICE:.*]] = fir.slice %[[C1]], %[[BOX_DIMS]]#1, %[[C1]] path %[[FIELD_C]] : (index, index, index, !fir.field) -> !fir.slice<1>638! CHECK: %[[ARRAY_LOAD:.*]] = fir.array_load %[[EXACT_BOX]] [%[[SLICE]]] : (!fir.box<!fir.array<?x!fir.type<_QMselect_type_lower_testTp2{a:i32,b:i32,c:i32}>>>, !fir.slice<1>) -> !fir.array<?xi32>639! CHECK: %[[DO_RES:.*]] = fir.do_loop %[[IND:.*]] = %{{.*}} to %{{.*}} step %{{.*}} unordered iter_args(%[[ARG:.*]] = %[[ARRAY_LOAD]]) -> (!fir.array<?xi32>) {640! CHECK: %[[ARR_UP:.*]] = fir.array_update %[[ARG]], %{{.*}}, %[[IND]] : (!fir.array<?xi32>, i32, index) -> !fir.array<?xi32>641! CHECK: fir.result %[[ARR_UP]] : !fir.array<?xi32>642! CHECK: }643! CHECK: fir.array_merge_store %[[ARRAY_LOAD]], %[[DO_RES]] to %[[EXACT_BOX]][%[[SLICE]]] : !fir.array<?xi32>, !fir.array<?xi32>, !fir.box<!fir.array<?x!fir.type<_QMselect_type_lower_testTp2{a:i32,b:i32,c:i32}>>>, !fir.slice<1>644! CHECK: cf.br ^bb{{.*}}645 646 subroutine select_type10(a)647 class(p1), pointer :: a648 select type(a)649 type is (p1)650 a%a = 1651 type is (p2)652 a%c = 3653 class is (p1)654 a%a = 5655 end select656 end subroutine657 658! CHECK-LABEL: func.func @_QMselect_type_lower_testPselect_type10(659! CHECK-SAME: %[[ARG0:.*]]: !fir.ref<!fir.class<!fir.ptr<!fir.type<_QMselect_type_lower_testTp1{a:i32,b:i32}>>>> {fir.bindc_name = "a"}) {660! CHECK: %[[SELECTOR:.*]] = fir.load %[[ARG0]] : !fir.ref<!fir.class<!fir.ptr<!fir.type<_QMselect_type_lower_testTp1{a:i32,b:i32}>>>>661! CHECK: fir.select_type %[[SELECTOR]] : !fir.class<!fir.ptr<!fir.type<_QMselect_type_lower_testTp1{a:i32,b:i32}>>> [#fir.type_is<!fir.type<_QMselect_type_lower_testTp1{a:i32,b:i32}>>, ^bb{{.*}}, #fir.type_is<!fir.type<_QMselect_type_lower_testTp2{a:i32,b:i32,c:i32}>>, ^bb{{.*}}, #fir.class_is<!fir.type<_QMselect_type_lower_testTp1{a:i32,b:i32}>>, ^bb{{.*}}, unit, ^bb{{.*}}]662! CHECK: ^bb{{.*}}:663! CHECK: %[[EXACT_BOX:.*]] = fir.convert %[[SELECTOR]] : (!fir.class<!fir.ptr<!fir.type<_QMselect_type_lower_testTp1{a:i32,b:i32}>>>) -> !fir.box<!fir.ptr<!fir.type<_QMselect_type_lower_testTp1{a:i32,b:i32}>>>664! CHECK: %[[C1:.*]] = arith.constant 1 : i32665! CHECK: %[[COORD_A:.*]] = fir.coordinate_of %[[EXACT_BOX]], a : (!fir.box<!fir.ptr<!fir.type<_QMselect_type_lower_testTp1{a:i32,b:i32}>>>) -> !fir.ref<i32>666! CHECK: fir.store %[[C1]] to %[[COORD_A]] : !fir.ref<i32>667! CHECK: cf.br ^bb{{.*}}668! CHECK: ^bb{{.*}}:669! CHECK: %[[EXACT_BOX:.*]] = fir.convert %[[SELECTOR]] : (!fir.class<!fir.ptr<!fir.type<_QMselect_type_lower_testTp1{a:i32,b:i32}>>>) -> !fir.box<!fir.ptr<!fir.type<_QMselect_type_lower_testTp2{a:i32,b:i32,c:i32}>>>670! CHECK: %[[C3:.*]] = arith.constant 3 : i32671! CHECK: %[[COORD_C:.*]] = fir.coordinate_of %[[EXACT_BOX]], c : (!fir.box<!fir.ptr<!fir.type<_QMselect_type_lower_testTp2{a:i32,b:i32,c:i32}>>>) -> !fir.ref<i32>672! CHECK: fir.store %[[C3]] to %[[COORD_C]] : !fir.ref<i32>673! CHECK: cf.br ^bb{{.*}}674! CHECK: ^bb{{.*}}675! CHECK: %[[C5:.*]] = arith.constant 5 : i32676! CHECK: %[[COORD_A:.*]] = fir.coordinate_of %[[SELECTOR]], a : (!fir.class<!fir.ptr<!fir.type<_QMselect_type_lower_testTp1{a:i32,b:i32}>>>) -> !fir.ref<i32>677! CHECK: fir.store %[[C5]] to %[[COORD_A]] : !fir.ref<i32>678! CHECK: cf.br ^bb{{.*}}679 680 subroutine select_type11(a)681 class(p1), allocatable :: a682 select type(a)683 type is (p1)684 a%a = 1685 type is (p2)686 a%a = 2687 a%c = 3688 end select689 end subroutine690 691! CHECK-LABEL: func.func @_QMselect_type_lower_testPselect_type11(692! CHECK-SAME: %[[ARG0:.*]]: !fir.ref<!fir.class<!fir.heap<!fir.type<_QMselect_type_lower_testTp1{a:i32,b:i32}>>>> {fir.bindc_name = "a"}) {693! CHECK: %[[SELECTOR:.*]] = fir.load %[[ARG0]] : !fir.ref<!fir.class<!fir.heap<!fir.type<_QMselect_type_lower_testTp1{a:i32,b:i32}>>>>694! CHECK: fir.select_type %[[SELECTOR]] : !fir.class<!fir.heap<!fir.type<_QMselect_type_lower_testTp1{a:i32,b:i32}>>> [#fir.type_is<!fir.type<_QMselect_type_lower_testTp1{a:i32,b:i32}>>, ^bb1, #fir.type_is<!fir.type<_QMselect_type_lower_testTp2{a:i32,b:i32,c:i32}>>, ^bb2, unit, ^bb3]695! CHECK: ^bb{{.*}}:696! CHECK: %[[EXACT_BOX:.*]] = fir.convert %[[SELECTOR]] : (!fir.class<!fir.heap<!fir.type<_QMselect_type_lower_testTp1{a:i32,b:i32}>>>) -> !fir.box<!fir.heap<!fir.type<_QMselect_type_lower_testTp1{a:i32,b:i32}>>>697! CHECK: %[[C1:.*]] = arith.constant 1 : i32698! CHECK: %[[COORD_A:.*]] = fir.coordinate_of %[[EXACT_BOX]], a : (!fir.box<!fir.heap<!fir.type<_QMselect_type_lower_testTp1{a:i32,b:i32}>>>) -> !fir.ref<i32>699! CHECK: fir.store %[[C1]] to %[[COORD_A]] : !fir.ref<i32>700! CHECK: cf.br ^bb{{.*}}701! CHECK: ^bb{{.*}}:702! CHECK: %[[EXACT_BOX:.*]] = fir.convert %[[SELECTOR]] : (!fir.class<!fir.heap<!fir.type<_QMselect_type_lower_testTp1{a:i32,b:i32}>>>) -> !fir.box<!fir.heap<!fir.type<_QMselect_type_lower_testTp2{a:i32,b:i32,c:i32}>>>703! CHECK: %[[C3:.*]] = arith.constant 3 : i32704! CHECK: %[[COORD_C:.*]] = fir.coordinate_of %[[EXACT_BOX]], c : (!fir.box<!fir.heap<!fir.type<_QMselect_type_lower_testTp2{a:i32,b:i32,c:i32}>>>) -> !fir.ref<i32>705! CHECK: fir.store %[[C3]] to %[[COORD_C]] : !fir.ref<i32>706! CHECK: cf.br ^bb{{.*}}707 708 subroutine select_type12(a)709 class(p1), pointer :: a(:)710 select type(a)711 type is (p1)712 a%a = 120713 type is (p2)714 a%c = 121715 class is (p1)716 a%a = 122717 end select718 end subroutine719 720! CHECK-LABEL: func.func @_QMselect_type_lower_testPselect_type12(721! CHECK-SAME: %[[ARG0:.*]]: !fir.ref<!fir.class<!fir.ptr<!fir.array<?x!fir.type<_QMselect_type_lower_testTp1{a:i32,b:i32}>>>>> {fir.bindc_name = "a"}) {722! CHECK: %[[LOAD:.*]] = fir.load %[[ARG0]] : !fir.ref<!fir.class<!fir.ptr<!fir.array<?x!fir.type<_QMselect_type_lower_testTp1{a:i32,b:i32}>>>>>723! CHECK: %[[C0:.*]] = arith.constant 0 : index724! CHECK: %[[BOX_DIMS:.*]]:3 = fir.box_dims %[[LOAD]], %[[C0]] : (!fir.class<!fir.ptr<!fir.array<?x!fir.type<_QMselect_type_lower_testTp1{a:i32,b:i32}>>>>, index) -> (index, index, index)725! CHECK: %[[SHIFT:.*]] = fir.shift %[[BOX_DIMS]]#0 : (index) -> !fir.shift<1>726! CHECK: %[[SELECTOR:.*]] = fir.rebox %[[LOAD]](%[[SHIFT]]) : (!fir.class<!fir.ptr<!fir.array<?x!fir.type<_QMselect_type_lower_testTp1{a:i32,b:i32}>>>>, !fir.shift<1>) -> !fir.class<!fir.array<?x!fir.type<_QMselect_type_lower_testTp1{a:i32,b:i32}>>>727! CHECK: fir.select_type %[[SELECTOR]] : !fir.class<!fir.array<?x!fir.type<_QMselect_type_lower_testTp1{a:i32,b:i32}>>> [#fir.type_is<!fir.type<_QMselect_type_lower_testTp1{a:i32,b:i32}>>, ^bb1, #fir.type_is<!fir.type<_QMselect_type_lower_testTp2{a:i32,b:i32,c:i32}>>, ^bb2, #fir.class_is<!fir.type<_QMselect_type_lower_testTp1{a:i32,b:i32}>>, ^bb3, unit, ^bb4]728! CHECK: ^bb{{.*}}:729! CHECK: %[[EXACT_BOX:.*]] = fir.convert %[[SELECTOR]] : (!fir.class<!fir.array<?x!fir.type<_QMselect_type_lower_testTp1{a:i32,b:i32}>>>) -> !fir.box<!fir.array<?x!fir.type<_QMselect_type_lower_testTp1{a:i32,b:i32}>>>730! CHECK: ^bb{{.*}}: // pred: ^bb0731! CHECK: %[[EXACT_BOX:.*]] = fir.convert %[[SELECTOR]] : (!fir.class<!fir.array<?x!fir.type<_QMselect_type_lower_testTp1{a:i32,b:i32}>>>) -> !fir.box<!fir.array<?x!fir.type<_QMselect_type_lower_testTp2{a:i32,b:i32,c:i32}>>>732 733 734 ! Test correct lowering when CLASS DEFAULT is not at the last position in the735 ! SELECT TYPE construct.736 subroutine select_type13(a)737 class(p1), pointer :: a(:)738 select type (a)739 class default740 print*, 'default'741 class is (p1)742 print*, 'class'743 end select744 745 select type (a)746 type is (p1)747 print*, 'type'748 class default749 print*, 'default'750 class is (p1)751 print*, 'class'752 end select753 754 end subroutine755 756! CHECK-LABEL: func.func @_QMselect_type_lower_testPselect_type13757! CHECK: fir.select_type %{{.*}} : !fir.class<!fir.array<?x!fir.type<_QMselect_type_lower_testTp1{a:i32,b:i32}>>> [#fir.class_is<!fir.type<_QMselect_type_lower_testTp1{a:i32,b:i32}>>, ^bb2, unit, ^bb1]758! CHECK: ^bb1:759! CHECK: ^bb2:760! CHECK: ^bb3:761! CHECK: fir.select_type %{{.*}} : !fir.class<!fir.array<?x!fir.type<_QMselect_type_lower_testTp1{a:i32,b:i32}>>> [#fir.type_is<!fir.type<_QMselect_type_lower_testTp1{a:i32,b:i32}>>, ^bb4, #fir.class_is<!fir.type<_QMselect_type_lower_testTp1{a:i32,b:i32}>>, ^bb6, unit, ^bb5]762! CHECK: ^bb4:763! CHECK: ^bb5:764! CHECK: ^bb6:765! CHECK: ^bb7:766 767 subroutine select_type14(a, b)768 class(p1) :: a, b769 770 select type(a)771 type is (p2)772 select type (b)773 type is (p2)774 print*,a%c,b%C775 end select776 class default777 print*,a%a778 end select779 end subroutine780 781 ! Just makes sure the example can be lowered.782 ! CHECK-LABEL: func.func @_QMselect_type_lower_testPselect_type14783 784 subroutine select_type15(a)785 class(p5) :: a786 787 select type(x => -a)788 type is (p5)789 print*, x%a790 end select791 end subroutine792 793! CHECK-LABEL: func.func @_QMselect_type_lower_testPselect_type15(794! CHECK-SAME: %[[ARG0:.*]]: !fir.class<!fir.type<_QMselect_type_lower_testTp5{a:i32}>> {fir.bindc_name = "a"}) {795! CHECK: %[[RES:.*]] = fir.alloca !fir.class<!fir.heap<!fir.type<_QMselect_type_lower_testTp5{a:i32}>>> {bindc_name = ".result"}796! CHECK: %[[TMP_RES:.*]] = fir.dispatch "negate"(%[[ARG0]] : !fir.class<!fir.type<_QMselect_type_lower_testTp5{a:i32}>>) (%[[ARG0]] : !fir.class<!fir.type<_QMselect_type_lower_testTp5{a:i32}>>) -> !fir.class<!fir.heap<!fir.type<_QMselect_type_lower_testTp5{a:i32}>>> {pass_arg_pos = 0 : i32}797! CHECK: fir.save_result %[[TMP_RES]] to %[[RES]] : !fir.class<!fir.heap<!fir.type<_QMselect_type_lower_testTp5{a:i32}>>>, !fir.ref<!fir.class<!fir.heap<!fir.type<_QMselect_type_lower_testTp5{a:i32}>>>>798! CHECK: %[[LOAD_RES:.*]] = fir.load %[[RES]] : !fir.ref<!fir.class<!fir.heap<!fir.type<_QMselect_type_lower_testTp5{a:i32}>>>>799! CHECK: fir.select_type %[[LOAD_RES]] : !fir.class<!fir.heap<!fir.type<_QMselect_type_lower_testTp5{a:i32}>>> [#fir.type_is<!fir.type<_QMselect_type_lower_testTp5{a:i32}>>, ^bb1, unit, ^bb2]800 801end module802 803program test_select_type804 use select_type_lower_test805 806 integer :: a807 integer :: arr(2)808 real :: b809 real :: barr(2)810 character(1) :: carr(2)811 type(p4) :: t4812 type(p1), target :: t1813 type(p2), target :: t2814 type(p1), target :: t1arr(2)815 type(p2) :: t2arr(2)816 class(p1), pointer :: p817 class(p1), allocatable :: p1alloc818 class(p1), allocatable :: p2alloc819 class(p1), pointer :: parr(:)820 821 call select_type7(t4)822 call select_type7(t2)823 call select_type7(t1)824 825 call select_type1(t1)826 call select_type1(t2)827 call select_type1(t4)828 829 call select_type6(a)830 print*, a831 832 call select_type6(b)833 print*, b834 835 print*, '> select_type8 with type(p1), dimension(2)'836 call select_type8(t1arr)837 print*, t1arr(1)838 print*, t1arr(2)839 840 print*, '> select_type8 with type(p2), dimension(2)'841 call select_type8(t2arr)842 print*, t2arr(1)843 print*, t2arr(2)844 845 print*, '> select_type8 with integer, dimension(2)'846 call select_type8(arr)847 print*, arr(:)848 849 print*, '> select_type8 with real, dimension(2)'850 call select_type8(barr)851 print*, barr(:)852 853 print*, '> select_type8 with character(1), dimension(2)'854 call select_type8(carr)855 print*, carr(:)856 857 t1%a = 0858 p => t1859 print*, '> select_type10'860 call select_type10(p)861 print*, t1862 863 t2%c = 0864 p => t2865 print*, '> select_type10'866 call select_type10(p)867 print*, t2868 869 allocate(p1::p1alloc)870 print*, '> select_type11'871 call select_type11(p1alloc)872 print*, p1alloc%a873 874 allocate(p2::p2alloc)875 print*, '> select_type11'876 call select_type11(p2alloc)877 print*, p2alloc%a878 879 parr => t1arr880 call select_type12(parr)881 print*, t1arr(1)882 print*, t1arr(2)883end884