1! RUN: bbc -emit-fir -hlfir=false %s -o - | fir-opt --fir-polymorphic-op | FileCheck %s 2module select_type_2 3 type p1 4 integer :: a 5 integer :: b 6 end type 7 8 type, extends(p1) :: p2 9 integer :: c 10 end type 11 12 type, extends(p2) :: p3 13 integer :: d 14 end type 15 16contains 17 18 subroutine select_type1(a) 19 class(p1), intent(in) :: a 20 21 select type (a) 22 class is (p1) 23 print*, 'class is p1' 24 class is (p3) 25 print*, 'class is p3' 26 class default 27 print*,'default' 28 end select 29 end subroutine 30 31! CHECK-LABEL: func.func @_QMselect_type_2Pselect_type1( 32! CHECK-SAME: %[[ARG0:.*]]: !fir.class<!fir.type<_QMselect_type_2Tp1{a:i32,b:i32}>> {fir.bindc_name = "a"}) { 33! CHECK: %[[TDESC_P3_ADDR:.*]] = fir.address_of(@_QMselect_type_2E.dt.p3) : !fir.ref<!fir.type<{{.*}}>> 34! CHECK: %[[TDESC_P3_CONV:.*]] = fir.convert %[[TDESC_P3_ADDR]] : (!fir.ref<!fir.type<{{.*}}>>) -> !fir.ref<none> 35! CHECK: %[[BOX_NONE:.*]] = fir.convert %[[ARG0]] : (!fir.class<!fir.type<_QMselect_type_2Tp1{a:i32,b:i32}>>) -> !fir.box<none> 36! CHECK: %[[CLASS_IS_CMP:.*]] = fir.call @_FortranAClassIs(%[[BOX_NONE]], %[[TDESC_P3_CONV]]) : (!fir.box<none>, !fir.ref<none>) -> i1 37! CHECK: cf.cond_br %[[CLASS_IS_CMP]], ^[[CLASS_IS_P3_BLK:.*]], ^[[NOT_CLASS_IS_P3_BLK:.*]] 38! CHECK: ^bb[[NOT_CLASS_IS_P1:[0-9]]]: 39! CHECK: cf.br ^bb[[DEFAULT_BLK:[0-9]]] 40! CHECK: ^bb[[CLASS_IS_P1:[0-9]]]: 41! CHECK: cf.br ^bb[[END_SELECT_BLK:[0-9]]] 42! CHECK: ^[[NOT_CLASS_IS_P3_BLK]]: 43! CHECK: %[[TDESC_P1_ADDR:.*]] = fir.address_of(@_QMselect_type_2E.dt.p1) : !fir.ref<!fir.type<{{.*}}>> 44! CHECK: %[[TDESC_P1_CONV:.*]] = fir.convert %[[TDESC_P1_ADDR]] : (!fir.ref<!fir.type<{{.*}}>>) -> !fir.ref<none> 45! CHECK: %[[BOX_NONE:.*]] = fir.convert %[[ARG0]] : (!fir.class<!fir.type<_QMselect_type_2Tp1{a:i32,b:i32}>>) -> !fir.box<none> 46! CHECK: %[[CLASS_IS_CMP:.*]] = fir.call @_FortranAClassIs(%[[BOX_NONE]], %[[TDESC_P1_CONV]]) : (!fir.box<none>, !fir.ref<none>) -> i1 47! CHECK: cf.cond_br %[[CLASS_IS_CMP]], ^bb[[CLASS_IS_P1]], ^bb[[NOT_CLASS_IS_P1]] 48! CHECK: ^[[CLASS_IS_P3_BLK]]: 49! CHECK: cf.br ^bb[[END_SELECT_BLK]] 50! CHECK: ^bb[[DEFAULT_BLK]]: 51! CHECK: cf.br ^bb[[END_SELECT_BLK]] 52! CHECK: ^bb[[END_SELECT_BLK]]: 53! CHECK: return 54 55 end module 56