flang/test/Lower/select-type.f90

   1 ! RUN: bbc -polymorphic-type -emit-fir %s -o - | FileCheck %s
   2 ! RUN: bbc -polymorphic-type -emit-fir %s -o - | fir-opt --cfg-conversion | FileCheck --check-prefix=CFG %s
   3 module select_type_lower_test
   4   type p1
   5     integer :: a
   6     integer :: b
   7   end type
   8
   9   type, extends(p1) :: p2
  10     integer :: c
  11   end type
  12
  13   type, extends(p1) :: p3(k)
  14     integer, kind :: k
  15     real(k) :: r
  16   end type
  17
  18   type, extends(p2) :: p4
  19     integer :: d
  20   end type
  21
  22   type :: p5
  23     integer :: a
  24   contains
  25     procedure :: negate
  26     generic :: operator(-) => negate
  27   end type
  28
  29 contains
  30
  31   function get_class()
  32     class(p1), pointer :: get_class
  33   end function
  34
  35   function negate(this)
  36     class(p5), intent(in) :: this
  37     class(p5), allocatable :: negate
  38     allocate(negate, source=this)
  39     negate%a = -this%a
  40   end function
  41
  42   subroutine select_type1(a)
  43     class(p1), intent(in) :: a
  44
  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%c
  52     class default
  53       print*,'default'
  54     end select
  55   end subroutine
  56
  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: %[[FIELD:.*]] = fir.field_index c, !fir.type<_QMselect_type_lower_testTp2{a:i32,b:i32,c:i32}>
  67 ! CHECK: %{{.*}} = fir.coordinate_of %[[P2]], %[[FIELD]] : (!fir.class<!fir.type<_QMselect_type_lower_testTp2{a:i32,b:i32,c:i32}>>, !fir.field) -> !fir.ref<i32>
  68 ! CHECK: ^[[DEFAULT_BLOCK]]
  69
  70 ! CFG-LABEL: func.func @_QMselect_type_lower_testPselect_type1(
  71 ! CFG-SAME: %[[ARG0:.*]]: !fir.class<!fir.type<_QMselect_type_lower_testTp1{a:i32,b:i32}>> {fir.bindc_name = "a"}) {
  72 ! CFG:      %[[TDESC_P1_ADDR:.*]] = fir.address_of(@_QMselect_type_lower_testE.dt.p1) : !fir.ref<!fir.type<{{.*}}>>
  73 ! CFG:      %[[BOX_TDESC:.*]] = fir.box_tdesc %[[ARG0]] : (!fir.class<!fir.type<_QMselect_type_lower_testTp1{a:i32,b:i32}>>) -> !fir.tdesc<none>
  74 ! CFG:      %[[TDESC_P1_CONV:.*]] = fir.convert %[[TDESC_P1_ADDR]] : (!fir.ref<!fir.type<{{.*}}>>) -> index
  75 ! CFG:      %[[BOX_TDESC_CONV:.*]] = fir.convert %[[BOX_TDESC]] : (!fir.tdesc<none>) -> index
  76 ! CFG:      %[[TDESC_CMP:.*]] = arith.cmpi eq, %[[TDESC_P1_CONV]], %[[BOX_TDESC_CONV]] : index
  77 ! CFG:      cf.cond_br %[[TDESC_CMP]], ^[[TYPE_IS_P1_BLK:.*]], ^[[NOT_TYPE_IS_P1_BLK:.*]]
  78 ! CFG:    ^[[NOT_TYPE_IS_P1_BLK]]:
  79 ! CFG:      %[[TDESC_P2_ADDR:.*]] = fir.address_of(@_QMselect_type_lower_testE.dt.p2) : !fir.ref<!fir.type<{{.*}}>>
  80 ! CFG:      %[[TDESC_P2_CONV:.*]] = fir.convert %[[TDESC_P2_ADDR]] : (!fir.ref<!fir.type<{{.*}}>>) -> !fir.ref<none>
  81 ! CFG:      %[[BOX_NONE:.*]] = fir.convert %[[ARG0]] : (!fir.class<!fir.type<_QMselect_type_lower_testTp1{a:i32,b:i32}>>) -> !fir.box<none>
  82 ! CFG:      %[[CLASS_IS:.*]] = fir.call @_FortranAClassIs(%[[BOX_NONE]], %[[TDESC_P2_CONV]]) : (!fir.box<none>, !fir.ref<none>) -> i1
  83 ! CFG:      cf.cond_br %[[CLASS_IS]], ^bb[[CLASS_IS_P2_BLK:.*]], ^[[NOT_CLASS_IS_P2_BLK:.*]]
  84 ! CFG:    ^[[TYPE_IS_P1_BLK]]:
  85 ! CFG:      cf.br ^bb[[EXIT_SELECT_BLK:[0-9]]]
  86 ! CFG:    ^bb[[NOT_CLASS_IS_P1_BLK:[0-9]]]:
  87 ! CFG:      cf.br ^bb[[DEFAULT_BLK:[0-9]]]
  88 ! CFG:    ^bb[[CLASS_IS_P1_BLK:[0-9]]]:
  89 ! CFG:      cf.br ^[[END_SELECT_BLK:.*]]
  90 ! CFG:    ^[[NOT_CLASS_IS_P2_BLK]]:
  91 ! CFG:      %[[TDESC_P1_ADDR:.*]] = fir.address_of(@_QMselect_type_lower_testE.dt.p1) : !fir.ref<!fir.type<{{.*}}>>
  92 ! CFG:      %[[TDESC_P1_CONV:.*]] = fir.convert %[[TDESC_P1_ADDR]] : (!fir.ref<!fir.type<{{.*}}>>) -> !fir.ref<none>
  93 ! CFG:      %[[BOX_NONE:.*]] = fir.convert %[[ARG0]] : (!fir.class<!fir.type<_QMselect_type_lower_testTp1{a:i32,b:i32}>>) -> !fir.box<none>
  94 ! CFG:      %[[CLASS_IS:.*]] = fir.call @_FortranAClassIs(%[[BOX_NONE]], %[[TDESC_P1_CONV]]) : (!fir.box<none>, !fir.ref<none>) -> i1
  95 ! CFG:      cf.cond_br %[[CLASS_IS]], ^bb[[CLASS_IS_P1_BLK]], ^bb[[NOT_CLASS_IS_P1_BLK]]
  96 ! CFG:    ^bb[[CLASS_IS_P2_BLK]]:
  97 ! CFG:      cf.br ^[[END_SELECT_BLK]]
  98 ! CFG:    ^bb[[DEFAULT_BLK]]:
  99 ! CFG:      cf.br ^[[END_SELECT_BLK]]
 100 ! CFG:    ^[[END_SELECT_BLK]]:
 101 ! CFG:      return
 102
 103   subroutine select_type2()
 104     select type (a => get_class())
 105     type is (p1)
 106       print*, 'type is p1'
 107     class is (p1)
 108       print*, 'class is p1'
 109     class default
 110       print*,'default'
 111     end select
 112   end subroutine
 113
 114 ! CHECK-LABEL: func.func @_QMselect_type_lower_testPselect_type2()
 115 ! CHECK: %[[RESULT:.*]] = fir.alloca !fir.class<!fir.ptr<!fir.type<_QMselect_type_lower_testTp1{a:i32,b:i32}>>> {bindc_name = ".result"}
 116 ! CHECK: %[[FCTCALL:.*]] = fir.call @_QMselect_type_lower_testPget_class() {{.*}}: () -> !fir.class<!fir.ptr<!fir.type<_QMselect_type_lower_testTp1{a:i32,b:i32}>>>
 117 ! 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}>>>>
 118 ! CHECK: %[[SELECTOR:.*]] = fir.load %[[RESULT]] : !fir.ref<!fir.class<!fir.ptr<!fir.type<_QMselect_type_lower_testTp1{a:i32,b:i32}>>>>
 119 ! CHECK: fir.select_type %[[SELECTOR]] : !fir.class<!fir.ptr<!fir.type<_QMselect_type_lower_testTp1{a:i32,b:i32}>>>
 120 ! 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:.*]]]
 121 ! CHECK: ^[[TYPE_IS_BLK]]
 122 ! CHECK: ^[[CLASS_IS_BLK]]
 123 ! CHECK: ^[[DEFAULT_BLK]]
 124
 125 ! CFG-LABEL: func.func @_QMselect_type_lower_testPselect_type2() {
 126 ! CFG:     %[[CLASS_ALLOCA:.*]] = fir.alloca !fir.class<!fir.ptr<!fir.type<_QMselect_type_lower_testTp1{a:i32,b:i32}>>> {bindc_name = ".result"}
 127 ! CFG:     %[[GET_CLASS:.*]] = fir.call @_QMselect_type_lower_testPget_class() {{.*}} : () -> !fir.class<!fir.ptr<!fir.type<_QMselect_type_lower_testTp1{a:i32,b:i32}>>>
 128 ! 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}>>>>
 129 ! CFG:     %[[LOAD_CLASS:.*]] = fir.load %[[CLASS_ALLOCA]] : !fir.ref<!fir.class<!fir.ptr<!fir.type<_QMselect_type_lower_testTp1{a:i32,b:i32}>>>>
 130 ! CFG:     %[[TDESC_P1_ADDR:.*]] = fir.address_of(@_QMselect_type_lower_testE.dt.p1) : !fir.ref<!fir.type<{{.*}}>>
 131 ! CFG:     %[[CLASS_TDESC:.*]] = fir.box_tdesc %[[LOAD_CLASS]] : (!fir.class<!fir.ptr<!fir.type<_QMselect_type_lower_testTp1{a:i32,b:i32}>>>) -> !fir.tdesc<none>
 132 ! CFG:     %[[TDESC_P1_CONV:.*]] = fir.convert %[[TDESC_P1_ADDR]] : (!fir.ref<!fir.type<{{.*}}>>) -> index
 133 ! CFG:     %[[BOX_TDESC_CONV:.*]] = fir.convert %[[CLASS_TDESC]] : (!fir.tdesc<none>) -> index
 134 ! CFG:     %[[TDESC_CMP:.*]] = arith.cmpi eq, %[[TDESC_P1_CONV]], %[[BOX_TDESC_CONV]] : index
 135 ! CFG:     cf.cond_br %[[TDESC_CMP]], ^[[TYPE_IS_P1_BLK:.*]], ^[[NOT_TYPE_IS_P1_BLK:.*]]
 136 ! CFG:   ^[[NOT_TYPE_IS_P1_BLK]]:
 137 ! CFG:     %[[TDESC_P1_ADDR:.*]] = fir.address_of(@_QMselect_type_lower_testE.dt.p1) : !fir.ref<!fir.type<{{.*}}>>
 138 ! CFG:     %[[TDESC_P1_CONV:.*]] = fir.convert %[[TDESC_P1_ADDR]] : (!fir.ref<!fir.type<{{.*}}>>) -> !fir.ref<none>
 139 ! CFG:     %[[BOX_NONE:.*]] = fir.convert %[[LOAD_CLASS]] : (!fir.class<!fir.ptr<!fir.type<_QMselect_type_lower_testTp1{a:i32,b:i32}>>>) -> !fir.box<none>
 140 ! CFG:     %[[CLASS_IS:.*]] = fir.call @_FortranAClassIs(%[[BOX_NONE]], %[[TDESC_P1_CONV]]) : (!fir.box<none>, !fir.ref<none>) -> i1
 141 ! CFG:     cf.cond_br %[[CLASS_IS]], ^[[CLASS_IS_BLK:.*]], ^[[NOT_CLASS_IS_BLK:.*]]
 142 ! CFG:   ^[[TYPE_IS_P1_BLK]]:
 143 ! CFG:     cf.br ^bb[[EXIT_SELECT_BLK:[0-9]]]
 144 ! CFG:   ^[[NOT_CLASS_IS_BLK]]:
 145 ! CFG:     cf.br ^bb[[DEFAULT_BLK:[0-9]]]
 146 ! CFG:   ^[[CLASS_IS_BLK]]:
 147 ! CFG:     cf.br ^bb[[END_SELECT_BLK:[0-9]]]
 148 ! CFG:   ^bb[[DEFAULT_BLK]]:
 149 ! CFG:     cf.br ^bb[[END_SELECT_BLK:[0-9]]]
 150 ! CFG:   ^bb[[END_SELECT_BLK:[0-9]]]:
 151 ! CFG:     return
 152
 153   subroutine select_type3(a)
 154     class(p1), pointer, intent(in) :: a(:)
 155
 156     select type (x => a(1))
 157     type is (p1)
 158       print*, 'type is p1'
 159     class is (p1)
 160       print*, 'class is p1'
 161     class default
 162       print*,'default'
 163     end select
 164   end subroutine
 165
 166 ! CHECK-LABEL: func.func @_QMselect_type_lower_testPselect_type3(
 167 ! 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"})
 168 ! 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}>>>>>
 169 ! 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}>>
 170 ! 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}>>
 171 ! CHECK: fir.select_type %[[SELECTOR]] : !fir.class<!fir.type<_QMselect_type_lower_testTp1{a:i32,b:i32}>>
 172 ! 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:.*]]]
 173 ! CHECK: ^[[TYPE_IS_BLK]]
 174 ! CHECK: ^[[CLASS_IS_BLK]]
 175 ! CHECK: ^[[DEFAULT_BLK]]
 176
 177 ! CFG-LABEL: func.func @_QMselect_type_lower_testPselect_type3(
 178 ! 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"}) {
 179 ! 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}>>
 180 ! CFG:      %[[TDESC_P1_ADDR:.*]] = fir.address_of(@_QMselect_type_lower_testE.dt.p1) : !fir.ref<!fir.type<{{.*}}>>
 181 ! CFG:      %[[SELECTOR_TDESC:.*]] = fir.box_tdesc %[[SELECTOR]] : (!fir.class<!fir.type<_QMselect_type_lower_testTp1{a:i32,b:i32}>>) -> !fir.tdesc<none>
 182 ! CFG:      %[[TDESC_P1_CONV:.*]] = fir.convert %[[TDESC_P1_ADDR]] : (!fir.ref<!fir.type<{{.*}}>>) -> index
 183 ! CFG:      %[[TDESC_CONV:.*]] = fir.convert %[[SELECTOR_TDESC]] : (!fir.tdesc<none>) -> index
 184 ! CFG:      %[[TDESC_CMP:.*]] = arith.cmpi eq, %[[TDESC_P1_CONV]], %[[TDESC_CONV]] : index
 185 ! CFG:      cf.cond_br %[[TDESC_CMP]], ^[[TYPE_IS_P1_BLK:.*]], ^[[NOT_TYPE_IS_P1_BLK:.*]]
 186 ! CFG:    ^[[NOT_TYPE_IS_P1_BLK]]:
 187 ! CFG:      %[[TDESC_P1_ADDR:.*]] = fir.address_of(@_QMselect_type_lower_testE.dt.p1) : !fir.ref<!fir.type<{{.*}}>>
 188 ! CFG:      %[[TDESC_P1_CONV:.*]] = fir.convert %[[TDESC_P1_ADDR]] : (!fir.ref<!fir.type<{{.*}}>>) -> !fir.ref<none>
 189 ! CFG:      %[[BOX_NONE:.*]] = fir.convert %[[SELECTOR]] : (!fir.class<!fir.type<_QMselect_type_lower_testTp1{a:i32,b:i32}>>) -> !fir.box<none>
 190 ! CFG:      %[[CLASS_IS:.*]] = fir.call @_FortranAClassIs(%[[BOX_NONE]], %[[TDESC_P1_CONV]]) : (!fir.box<none>, !fir.ref<none>) -> i1
 191 ! CFG:      cf.cond_br %[[CLASS_IS]], ^[[CLASS_IS_BLK:.*]], ^[[NOT_CLASS_IS:.*]]
 192 ! CFG:    ^[[TYPE_IS_P1_BLK]]:
 193 ! CFG:        cf.br ^bb[[END_SELECT_BLK:[0-9]]]
 194 ! CFG:    ^[[NOT_CLASS_IS]]:
 195 ! CFG:        cf.br ^bb[[DEFAULT_BLK:[0-9]]]
 196 ! CFG:    ^[[CLASS_IS_BLK]]:
 197 ! CFG:        cf.br ^bb[[END_SELECT_BLK]]
 198 ! CFG:    ^bb[[DEFAULT_BLK]]:
 199 ! CFG:        cf.br ^bb[[END_SELECT_BLK]]
 200 ! CFG:    ^bb[[END_SELECT_BLK]]:
 201 ! CFG:        return
 202
 203   subroutine select_type4(a)
 204     class(p1), intent(in) :: a
 205     select type(a)
 206     type is(p3(8))
 207       print*, 'type is p3(8)'
 208     type is(p3(4))
 209       print*, 'type is p3(4)'
 210     class is (p1)
 211       print*, 'class is p1'
 212     end select
 213   end subroutine
 214
 215 ! CHECK-LABEL: func.func @_QMselect_type_lower_testPselect_type4(
 216 ! CHECK-SAME: %[[ARG0:.*]]: !fir.class<!fir.type<_QMselect_type_lower_testTp1{a:i32,b:i32}>> {fir.bindc_name = "a"})
 217 ! CHECK: fir.select_type %[[ARG0]] : !fir.class<!fir.type<_QMselect_type_lower_testTp1{a:i32,b:i32}>>
 218 ! 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:.*]]]
 219 ! CHECK: ^[[P3_8]]
 220 ! CHECK: ^[[P3_4]]
 221 ! CHECK: ^[[P1]]
 222 ! CHECK: ^[[EXIT]]
 223
 224 ! CFG-LABEL: func.func @_QMselect_type_lower_testPselect_type4(
 225 ! CFG-SAME: %[[ARG0:.*]]: !fir.class<!fir.type<_QMselect_type_lower_testTp1{a:i32,b:i32}>> {fir.bindc_name = "a"}) {
 226 ! CFG:      %[[TDESC_P3_8_ADDR:.*]] = fir.address_of(@_QMselect_type_lower_testE.dt.p3.8) : !fir.ref<!fir.type<{{.*}}>>
 227 ! CFG:      %[[BOX_TDESC:.*]] = fir.box_tdesc %[[ARG0]] : (!fir.class<!fir.type<_QMselect_type_lower_testTp1{a:i32,b:i32}>>) -> !fir.tdesc<none>
 228 ! CFG:      %[[TDESC_P3_8_CONV:.*]] = fir.convert %[[TDESC_P3_8_ADDR]] : (!fir.ref<!fir.type<{{.*}}>>) -> index
 229 ! CFG:      %[[BOX_TDESC_CONV:.*]] = fir.convert %[[BOX_TDESC]] : (!fir.tdesc<none>) -> index
 230 ! CFG:      %[[TDESC_CMP:.*]] = arith.cmpi eq, %[[TDESC_P3_8_CONV]], %[[BOX_TDESC_CONV]] : index
 231 ! CFG:      cf.cond_br %[[TDESC_CMP]], ^[[P3_8_BLK:.*]], ^[[NOT_P3_8_BLK:.*]]
 232 ! CFG:    ^[[NOT_P3_8_BLK]]:
 233 ! CFG:      %[[TDESC_P3_4_ADDR:.*]] = fir.address_of(@_QMselect_type_lower_testE.dt.p3.4) : !fir.ref<!fir.type<{{.*}}>>
 234 ! CFG:      %[[BOX_TDESC:.*]] = fir.box_tdesc %[[ARG0]] : (!fir.class<!fir.type<_QMselect_type_lower_testTp1{a:i32,b:i32}>>) -> !fir.tdesc<none>
 235 ! CFG:      %[[TDESC_P3_4_CONV:.*]] = fir.convert %[[TDESC_P3_4_ADDR]] : (!fir.ref<!fir.type<{{.*}}>>) -> index
 236 ! CFG:      %[[BOX_TDESC_CONV:.*]] = fir.convert %[[BOX_TDESC]] : (!fir.tdesc<none>) -> index
 237 ! CFG:      %[[TDESC_CMP:.*]] = arith.cmpi eq, %[[TDESC_P3_4_CONV]], %[[BOX_TDESC_CONV]] : index
 238 ! CFG:      cf.cond_br %[[TDESC_CMP]], ^[[P3_4_BLK:.*]], ^[[NOT_P3_4_BLK:.*]]
 239 ! CFG:    ^[[P3_8_BLK]]:
 240 ! CFG:      _FortranAioOutputAscii
 241 ! CFG:      cf.br ^bb[[EXIT_SELECT_BLK:[0-9]]]
 242 ! CFG:    ^[[NOT_P3_4_BLK]]:
 243 ! CFG:      %[[TDESC_P1_ADDR:.*]] = fir.address_of(@_QMselect_type_lower_testE.dt.p1) : !fir.ref<!fir.type<{{.*}}>>
 244 ! CFG:      %[[TDESC_P1_CONV:.*]] = fir.convert %[[TDESC_P1_ADDR]] : (!fir.ref<!fir.type<{{.*}}>>) -> !fir.ref<none>
 245 ! CFG:      %[[BOX_NONE:.*]] = fir.convert %[[ARG0]] : (!fir.class<!fir.type<_QMselect_type_lower_testTp1{a:i32,b:i32}>>) -> !fir.box<none>
 246 ! CFG:      %[[CLASS_IS:.*]] = fir.call @_FortranAClassIs(%[[BOX_NONE]], %[[TDESC_P1_CONV]]) : (!fir.box<none>, !fir.ref<none>) -> i1
 247 ! CFG:      cf.cond_br %[[CLASS_IS]], ^[[P1_BLK:.*]], ^[[NOT_P1_BLK:.*]]
 248 ! CFG:    ^[[P3_4_BLK]]:
 249 ! CFG:      cf.br ^bb[[EXIT_SELECT_BLK]]
 250 ! CFG:    ^[[NOT_P1_BLK]]:
 251 ! CFG:      cf.br ^bb[[EXIT_SELECT_BLK]]
 252 ! CFG:    ^[[P1_BLK]]:
 253 ! CFG:      cf.br ^bb[[EXIT_SELECT_BLK]]
 254 ! CFG:    ^bb[[EXIT_SELECT_BLK]]:
 255 ! CFG:      return
 256
 257   subroutine select_type5(a)
 258     class(*), intent(in) :: a
 259
 260     select type (x => a)
 261     type is (integer(1))
 262       print*, 'type is integer(1)'
 263     type is (integer(4))
 264       print*, 'type is integer(4)'
 265     type is (real(4))
 266       print*, 'type is real'
 267     type is (logical)
 268       print*, 'type is logical'
 269     type is (character(*))
 270       print*, 'type is character'
 271     class default
 272       print*,'default'
 273     end select
 274   end subroutine
 275
 276 ! CHECK-LABEL: func.func @_QMselect_type_lower_testPselect_type5(
 277 ! CHECK-SAME: %[[ARG0:.*]]: !fir.class<none> {fir.bindc_name = "a"})
 278 ! CHECK: fir.select_type %[[ARG0]] : !fir.class<none>
 279 ! 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:.*]]]
 280 ! CHECK: ^[[I8_BLK]]
 281 ! CHECK: ^[[I32_BLK]]
 282 ! CHECK: ^[[F32_BLK]]
 283 ! CHECK: ^[[LOG_BLK]]
 284 ! CHECK: ^[[CHAR_BLK]]
 285 ! CHECK: ^[[DEFAULT_BLOCK]]
 286
 287 ! CFG-LABEL: func.func @_QMselect_type_lower_testPselect_type5(
 288 ! CFG-SAME: %[[SELECTOR:.*]]: !fir.class<none> {fir.bindc_name = "a"}) {
 289
 290 ! CFG:  %[[INT8_TC:.*]] = arith.constant 7 : i8
 291 ! CFG:  %[[TYPE_CODE:.*]] = fir.box_typecode %[[SELECTOR]] : (!fir.class<none>) -> i8
 292 ! CFG:  %[[IS_INT8:.*]] = arith.cmpi eq, %[[TYPE_CODE]], %[[INT8_TC]] : i8
 293 ! CFG:  cf.cond_br %[[IS_INT8]], ^[[INT8_BLK:.*]], ^[[NOT_INT8:.*]]
 294 ! CFG: ^[[NOT_INT8]]:
 295 ! CFG:  %[[INT32_TC:.*]] = arith.constant 9 : i8
 296 ! CFG:  %[[TYPE_CODE:.*]] = fir.box_typecode %[[SELECTOR]] : (!fir.class<none>) -> i8
 297 ! CFG:  %[[IS_INT32:.*]] = arith.cmpi eq, %[[TYPE_CODE]], %[[INT32_TC]] : i8
 298 ! CFG:  cf.cond_br %[[IS_INT32]], ^[[INT32_BLK:.*]], ^[[NOT_INT32_BLK:.*]]
 299 ! CFG: ^[[INT8_BLK]]:
 300 ! CFG:  cf.br ^[[EXIT_BLK:.*]]
 301 ! CFG: ^[[NOT_INT32_BLK]]:
 302 ! CFG:  %[[FLOAT_TC:.*]] = arith.constant 27 : i8
 303 ! CFG:  %[[TYPE_CODE:.*]] = fir.box_typecode %[[SELECTOR]] : (!fir.class<none>) -> i8
 304 ! CFG:  %[[IS_FLOAT:.*]] = arith.cmpi eq, %[[TYPE_CODE]], %[[FLOAT_TC]] : i8
 305 ! CFG:  cf.cond_br %[[IS_FLOAT]], ^[[FLOAT_BLK:.*]], ^[[NOT_FLOAT_BLK:.*]]
 306 ! CFG: ^[[INT32_BLK]]:
 307 ! CFG:  cf.br ^[[EXIT_BLK]]
 308 ! CFG: ^[[NOT_FLOAT_BLK]]:
 309 ! CFG:  %[[LOGICAL_TC:.*]] = arith.constant 14 : i8
 310 ! CFG:  %[[TYPE_CODE:.*]] = fir.box_typecode %[[SELECTOR]] : (!fir.class<none>) -> i8
 311 ! CFG:  %[[IS_LOGICAL:.*]] = arith.cmpi eq, %[[TYPE_CODE]], %[[LOGICAL_TC]] : i8
 312 ! CFG:  cf.cond_br %[[IS_LOGICAL]], ^[[LOGICAL_BLK:.*]], ^[[NOT_LOGICAL_BLK:.*]]
 313 ! CFG: ^[[FLOAT_BLK]]:
 314 ! CFG:  cf.br ^[[EXIT_BLK]]
 315 ! CFG: ^[[NOT_LOGICAL_BLK]]:
 316 ! CFG:  %[[CHAR_TC:.*]] = arith.constant 40 : i8
 317 ! CFG:  %[[TYPE_CODE:.*]] = fir.box_typecode %[[SELECTOR]] : (!fir.class<none>) -> i8
 318 ! CFG:  %[[IS_CHAR:.*]] = arith.cmpi eq, %[[TYPE_CODE]], %[[CHAR_TC]] : i8
 319 ! CFG:  cf.cond_br %[[IS_CHAR]], ^[[CHAR_BLK:.*]], ^[[NOT_CHAR_BLK:.*]]
 320 ! CFG: ^[[LOGICAL_BLK]]:
 321 ! CFG:  cf.br ^[[EXIT_BLK]]
 322 ! CFG: ^[[NOT_CHAR_BLK]]:
 323 ! CFG:  cf.br ^[[DEFAULT_BLK:.*]]
 324 ! CFG: ^[[CHAR_BLK]]:
 325 ! CFG:  cf.br ^[[EXIT_BLK]]
 326 ! CFG: ^[[DEFAULT_BLK]]:
 327 ! CFG:  cf.br ^[[EXIT_BLK]]
 328 ! CFG: ^bb12:
 329 ! CFG:  return
 330
 331   subroutine select_type6(a)
 332     class(*) :: a
 333
 334     select type(a)
 335     type is (integer)
 336       a = 100
 337     type is (real)
 338       a = 2.0
 339     class default
 340       stop 'error'
 341     end select
 342   end subroutine
 343
 344 ! CHECK-LABEL: func.func @_QMselect_type_lower_testPselect_type6(
 345 ! CHECK-SAME: %[[ARG0:.*]]: !fir.class<none> {fir.bindc_name = "a"})
 346
 347 ! CHECK: fir.select_type %[[ARG0]] : !fir.class<none> [#fir.type_is<i32>, ^[[INT_BLK:.*]], #fir.type_is<f32>, ^[[REAL_BLK:.*]], unit, ^[[DEFAULT_BLK:.*]]]
 348 ! CHECK: ^[[INT_BLK]]
 349 ! CHECK:  %[[BOX_ADDR:.*]] = fir.box_addr %[[ARG0]] : (!fir.class<none>) -> !fir.ref<i32>
 350 ! CHECK:  %[[C100:.*]] = arith.constant 100 : i32
 351 ! CHECK:  fir.store %[[C100]] to %[[BOX_ADDR]] : !fir.ref<i32>
 352
 353 ! CHECK: ^[[REAL_BLK]]:  // pred: ^bb0
 354 ! CHECK:  %[[BOX_ADDR:.*]] = fir.box_addr %[[ARG0]] : (!fir.class<none>) -> !fir.ref<f32>
 355 ! CHECK:  %[[C2:.*]] = arith.constant 2.000000e+00 : f32
 356 ! CHECK:  fir.store %[[C2]] to %[[BOX_ADDR]] : !fir.ref<f32>
 357
 358
 359 ! CFG-LABEL: func.func @_QMselect_type_lower_testPselect_type6(
 360 ! CFG-SAME: %[[ARG0:.*]]: !fir.class<none> {fir.bindc_name = "a"})
 361 ! CFG:   %[[INT32_TYPECODE:.*]] = arith.constant 9 : i8
 362 ! CFG:   %[[ARG0_TYPECODE:.*]] = fir.box_typecode %[[ARG0]] : (!fir.class<none>) -> i8
 363 ! CFG:   %[[IS_TYPECODE:.*]] = arith.cmpi eq, %[[ARG0_TYPECODE]], %[[INT32_TYPECODE]] : i8
 364 ! CFG:   cf.cond_br %[[IS_TYPECODE]], ^[[TYPE_IS_INT_BLK:.*]], ^[[TYPE_NOT_INT_BLK:.*]]
 365 ! CFG: ^[[TYPE_NOT_INT_BLK]]:
 366 ! CFG:   %[[FLOAT_TYPECODE:.*]] = arith.constant 27 : i8
 367 ! CFG:   %[[ARG0_TYPECODE:.*]] = fir.box_typecode %[[ARG0]] : (!fir.class<none>) -> i8
 368 ! CFG:   %[[IS_TYPECODE:.*]] = arith.cmpi eq, %[[ARG0_TYPECODE]], %[[FLOAT_TYPECODE]] : i8
 369 ! CFG:   cf.cond_br %[[IS_TYPECODE]], ^[[TYPE_IS_REAL_BLK:.*]], ^[[TYPE_NOT_REAL_BLK:.*]]
 370 ! CFG: ^[[TYPE_IS_INT_BLK]]:
 371 ! CFG:   %[[BOX_ADDR:.*]] = fir.box_addr %[[ARG0]] : (!fir.class<none>) -> !fir.ref<i32>
 372 ! CFG:   %[[C100:.*]] = arith.constant 100 : i32
 373 ! CFG:   fir.store %[[C100]] to %[[BOX_ADDR]] : !fir.ref<i32>
 374 ! CFG:   cf.br ^[[EXIT_SELECT_BLK:.*]]
 375 ! CFG: ^[[TYPE_NOT_REAL_BLK]]:
 376 ! CFG:   cf.br ^[[DEFAULT_BLK:.*]]
 377 ! CFG: ^[[TYPE_IS_REAL_BLK]]:
 378 ! CFG: %[[BOX_ADDR:.*]] = fir.box_addr %[[ARG0]] : (!fir.class<none>) -> !fir.ref<f32>
 379 ! CFG: %[[CST:.*]] = arith.constant 2.000000e+00 : f32
 380 ! CFG: fir.store %[[CST]] to %[[BOX_ADDR]] : !fir.ref<f32>
 381 ! CFG: cf.br ^[[EXIT_SELECT_BLK]]
 382 ! CFG: ^[[DEFAULT_BLK]]:
 383 ! CFG:   fir.call @_FortranAStopStatementText
 384 ! CFG:   fir.unreachable
 385 ! CFG: ^[[EXIT_SELECT_BLK]]:
 386 ! CFG   return
 387
 388   subroutine select_type7(a)
 389     class(*), intent(out) :: a
 390
 391     select type(a)
 392     class is (p1)
 393       print*, 'CLASS IS P1'
 394     class is (p2)
 395       print*, 'CLASS IS P2'
 396     class is (p4)
 397       print*, 'CLASS IS P4'
 398     class default
 399       print*, 'CLASS DEFAULT'
 400     end select
 401   end subroutine
 402
 403 ! CHECK-LABEL: func.func @_QMselect_type_lower_testPselect_type7(
 404 ! CHECK-SAME: %[[ARG0:.*]]: !fir.class<none> {fir.bindc_name = "a"})
 405 ! CHECK: fir.select_type %[[ARG0]] :
 406 ! 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]
 407
 408 ! Check correct ordering of class is type guard. The expected flow should be:
 409 !   class is (p4) -> class is (p2) -> class is (p1) -> class default
 410
 411 ! CFG-LABEL: func.func @_QMselect_type_lower_testPselect_type7(
 412 ! CFG-SAME: %[[ARG0:.*]]: !fir.class<none> {fir.bindc_name = "a"}) {
 413 ! CFG:      %[[TDESC_P4_ADDR:.*]] = fir.address_of(@_QMselect_type_lower_testE.dt.p4) : !fir.ref<!fir.type<{{.*}}>>
 414 ! CFG:      %[[TDESC_P4_CONV:.*]] = fir.convert %[[TDESC_P4_ADDR]] : (!fir.ref<!fir.type<{{.*}}>>) -> !fir.ref<none>
 415 ! CFG:      %[[BOX_NONE:.*]] = fir.convert %[[ARG0]] : (!fir.class<none>) -> !fir.box<none>
 416 ! CFG:      %[[CLASS_IS_P4:.*]] = fir.call @_FortranAClassIs(%[[BOX_NONE]], %[[TDESC_P4_CONV]]) : (!fir.box<none>, !fir.ref<none>) -> i1
 417 ! CFG:      cf.cond_br %[[CLASS_IS_P4]], ^[[CLASS_IS_P4_BLK:.*]], ^[[CLASS_NOT_P4_BLK:.*]]
 418 ! CFG:    ^bb[[CLASS_NOT_P1_BLK:[0-9]]]:
 419 ! CFG:      cf.br ^[[CLASS_DEFAULT_BLK:.*]]
 420 ! CFG:    ^bb[[CLASS_IS_P1_BLK:[0-9]]]:
 421 ! CFG:      cf.br ^[[EXIT_SELECT_BLK:.*]]
 422 ! CFG:    ^bb[[CLASS_NOT_P2_BLK:[0-9]]]:
 423 ! CFG:      %[[TDESC_P1_ADDR:.*]] = fir.address_of(@_QMselect_type_lower_testE.dt.p1) : !fir.ref<!fir.type<{{.*}}>>
 424 ! CFG:      %[[TDESC_P1_CONV:.*]] = fir.convert %[[TDESC_P1_ADDR]] : (!fir.ref<!fir.type<{{.*}}>>) -> !fir.ref<none>
 425 ! CFG:      %[[BOX_NONE:.*]] = fir.convert %[[ARG0]] : (!fir.class<none>) -> !fir.box<none>
 426 ! CFG:      %[[CLASS_IS_P1:.*]] = fir.call @_FortranAClassIs(%[[BOX_NONE]], %[[TDESC_P1_CONV]]) : (!fir.box<none>, !fir.ref<none>) -> i1
 427 ! CFG:      cf.cond_br %[[CLASS_IS_P1]], ^bb[[CLASS_IS_P1_BLK]], ^bb[[CLASS_NOT_P1_BLK]]
 428 ! CFG:    ^bb[[CLASS_IS_P2_BLK:[0-9]]]:
 429 ! CFG:      cf.br ^[[EXIT_SELECT_BLK]]
 430 ! CFG:    ^[[CLASS_NOT_P4_BLK]]:
 431 ! CFG:      %[[TDESC_P2_ADDR:.*]] = fir.address_of(@_QMselect_type_lower_testE.dt.p2) : !fir.ref<!fir.type<{{.*}}>>
 432 ! CFG:      %[[TDESC_P2_CONV:.*]] = fir.convert %[[TDESC_P2_ADDR]] : (!fir.ref<!fir.type<{{.*}}>>) -> !fir.ref<none>
 433 ! CFG:      %[[BOX_NONE:.*]] = fir.convert %[[ARG0]] : (!fir.class<none>) -> !fir.box<none>
 434 ! CFG:      %[[CLASS_IS_P2:.*]] = fir.call @_FortranAClassIs(%[[BOX_NONE]], %[[TDESC_P2_CONV]]) : (!fir.box<none>, !fir.ref<none>) -> i1
 435 ! CFG:      cf.cond_br %[[CLASS_IS_P2]], ^bb[[CLASS_IS_P2_BLK]], ^bb[[CLASS_NOT_P2_BLK]]
 436 ! CFG:   ^[[CLASS_IS_P4_BLK]]:
 437 ! CFG:      cf.br ^[[EXIT_SELECT_BLK]]
 438 ! CFG:   ^[[CLASS_DEFAULT_BLK]]:
 439 ! CFG:      cf.br ^[[EXIT_SELECT_BLK]]
 440 ! CFG:   ^[[EXIT_SELECT_BLK]]:
 441 ! CFG:      return
 442
 443   subroutine select_type8(a)
 444     class(*) :: a(:)
 445
 446     select type(a)
 447     type is (integer)
 448       a = 100
 449     type is (real)
 450       a = 2.0
 451     type is (character(*))
 452       a(1) = 'c'
 453       a(2) = 'h'
 454     type is (p1)
 455       a%a = 1
 456       a%b = 2
 457     class is(p2)
 458       a%a = 1
 459       a%b = 2
 460       a%c = 3
 461     class default
 462       stop 'error'
 463     end select
 464   end subroutine
 465
 466 ! CHECK-LABEL: func.func @_QMselect_type_lower_testPselect_type8(
 467 ! CHECK-SAME: %[[ARG0:.*]]: !fir.class<!fir.array<?xnone>> {fir.bindc_name = "a"}) {
 468 ! CHECK: %[[SELECTOR:.*]] = fir.rebox %[[ARG0]] : (!fir.class<!fir.array<?xnone>>) -> !fir.class<!fir.array<?xnone>>
 469 ! 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, ^{{.*}}]
 470 ! CHECK: ^bb{{.*}}:
 471 ! CHECK:  %[[BOX:.*]] = fir.convert %[[SELECTOR]] : (!fir.class<!fir.array<?xnone>>) -> !fir.box<!fir.array<?xi32>>
 472 ! CHECK:  %[[C0:.*]] = arith.constant 0 : index
 473 ! CHECK:  %[[SELECTOR_DIMS:.*]]:3 = fir.box_dims %[[BOX]], %[[C0]] : (!fir.box<!fir.array<?xi32>>, index) -> (index, index, index)
 474 ! CHECK:  %[[ARRAY_LOAD:.*]] = fir.array_load %[[BOX]] : (!fir.box<!fir.array<?xi32>>) -> !fir.array<?xi32>
 475 ! CHECK:  %[[C100:.*]] = arith.constant 100 : i32
 476 ! CHECK:  %[[C1:.*]] = arith.constant 1 : index
 477 ! CHECK:  %[[C0:.*]] = arith.constant 0 : index
 478 ! CHECK:  %[[UB:.*]] = arith.subi %[[SELECTOR_DIMS:.*]]#1, %[[C1]] : index
 479 ! CHECK:  %[[LOOP_RES:.*]] = fir.do_loop %[[IND:.*]] = %[[C0:.*]] to %[[UB]] step %[[C1]] unordered iter_args(%[[ARG:.*]] = %[[ARRAY_LOAD]]) -> (!fir.array<?xi32>) {
 480 ! CHECK:    %[[ARR_UP:.*]] = fir.array_update %[[ARG]], %[[C100]], %[[IND]] : (!fir.array<?xi32>, i32, index) -> !fir.array<?xi32>
 481 ! CHECK:    fir.result %[[ARR_UP]] : !fir.array<?xi32>
 482 ! CHECK:  }
 483 ! CHECK:  fir.array_merge_store %[[ARRAY_LOAD]], %[[LOOP_RES]] to %[[BOX]] : !fir.array<?xi32>, !fir.array<?xi32>, !fir.box<!fir.array<?xi32>>
 484 ! CHECK:  cf.br ^{{.*}}
 485 ! CHECK: ^bb{{.*}}:
 486 ! CHECK:  %[[BOX:.*]] = fir.convert %[[SELECTOR]] : (!fir.class<!fir.array<?xnone>>) -> !fir.box<!fir.array<?xf32>>
 487 ! CHECK:  %[[C0:.*]] = arith.constant 0 : index
 488 ! CHECK:  %[[SELECTOR_DIMS:.*]]:3 = fir.box_dims %[[BOX]], %[[C0]] : (!fir.box<!fir.array<?xf32>>, index) -> (index, index, index)
 489 ! CHECK:  %[[ARRAY_LOAD:.*]] = fir.array_load %[[BOX]] : (!fir.box<!fir.array<?xf32>>) -> !fir.array<?xf32>
 490 ! CHECK:  %[[VALUE:.*]] = arith.constant 2.000000e+00 : f32
 491 ! CHECK:  %[[C1:.*]] = arith.constant 1 : index
 492 ! CHECK:  %[[C0:.*]] = arith.constant 0 : index
 493 ! CHECK:  %[[UB:.*]] = arith.subi %[[SELECTOR_DIMS]]#1, %[[C1]] : index
 494 ! CHECK:  %[[LOOP_RES:.*]] = fir.do_loop %[[IND:.*]] = %[[C0]] to %[[UB]] step %[[C1]] unordered iter_args(%[[ARG:.*]] = %[[ARRAY_LOAD]]) -> (!fir.array<?xf32>) {
 495 ! CHECK:    %[[ARR_UP:.*]] = fir.array_update %[[ARG]], %[[VALUE]], %[[IND]] : (!fir.array<?xf32>, f32, index) -> !fir.array<?xf32>
 496 ! CHECK:    fir.result %[[ARR_UP]] : !fir.array<?xf32>
 497 ! CHECK:  }
 498 ! CHECK:  fir.array_merge_store %[[ARRAY_LOAD]], %[[LOOP_RES]] to %[[BOX]] : !fir.array<?xf32>, !fir.array<?xf32>, !fir.box<!fir.array<?xf32>>
 499 ! CHECK:  cf.br ^{{.*}}
 500 ! CHECK: ^bb{{.*}}:
 501 ! CHECK:  %[[BOX:.*]] = fir.convert %0 : (!fir.class<!fir.array<?xnone>>) -> !fir.box<!fir.array<?x!fir.char<1,?>>>
 502 ! CHECK:  cf.br ^bb{{.*}}
 503 ! CHECK: ^bb{{.*}}:
 504 ! 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}>>>
 505 ! CHECK:  %[[FIELD_A:.*]] = fir.field_index a, !fir.type<_QMselect_type_lower_testTp1{a:i32,b:i32}>
 506 ! CHECK:  %[[C0:.*]] = arith.constant 0 : index
 507 ! 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)
 508 ! CHECK:  %[[C1:.*]] = arith.constant 1 : index
 509 ! CHECK:  %[[SLICE:.*]] = fir.slice %[[C1]], %[[BOX_DIMS]]#1, %[[C1]] path %[[FIELD_A]] : (index, index, index, !fir.field) -> !fir.slice<1>
 510 ! 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>
 511 ! CHECK:  %[[DO_RES:.*]] = fir.do_loop %[[IND:.*]] = %{{.*}} to %{{.*}} step %{{.*}} unordered iter_args(%[[ARG:.*]] = %[[ARRAY_LOAD]]) -> (!fir.array<?xi32>) {
 512 ! CHECK:    %[[ARR_UP:.*]] = fir.array_update %[[ARG]], %{{.*}}, %[[IND]] : (!fir.array<?xi32>, i32, index) -> !fir.array<?xi32>
 513 ! CHECK:    fir.result %[[ARR_UP]] : !fir.array<?xi32>
 514 ! CHECK:  }
 515 ! 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>
 516 ! CHECK:  %[[FIELD_B:.*]] = fir.field_index b, !fir.type<_QMselect_type_lower_testTp1{a:i32,b:i32}>
 517 ! CHECK:  %[[C0:.*]] = arith.constant 0 : index
 518 ! 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)
 519 ! CHECK:  %[[C1:.*]] = arith.constant 1 : index
 520 ! CHECK:  %[[SLICE:.*]] = fir.slice %[[C1]], %[[BOX_DIMS]]#1, %[[C1]] path %[[FIELD_B]] : (index, index, index, !fir.field) -> !fir.slice<1>
 521 ! 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>
 522 ! CHECK:  %[[DO_RES:.*]] = fir.do_loop %[[IND:.*]] = %{{.*}} to %{{.*}} step %c{{.*}} unordered iter_args(%[[ARG:.*]] = %[[ARRAY_LOAD]]) -> (!fir.array<?xi32>) {
 523 ! CHECK:    %[[ARR_UP:.*]] = fir.array_update %[[ARG]], %{{.*}}, %[[IND]] : (!fir.array<?xi32>, i32, index) -> !fir.array<?xi32>
 524 ! CHECK:    fir.result %[[ARR_UP]] : !fir.array<?xi32>
 525 ! CHECK:  }
 526 ! 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>
 527 ! CHECK:  cf.br ^{{.*}}
 528 ! CHECK: ^bb{{.*}}:
 529 ! 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}>>>
 530 ! CHECK:  %[[FIELD_A:.*]] = fir.field_index a, !fir.type<_QMselect_type_lower_testTp2{a:i32,b:i32,c:i32}>
 531 ! CHECK:  %[[C0:.*]] = arith.constant 0 : index
 532 ! 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)
 533 ! CHECK:  %[[C1:.*]] = arith.constant 1 : index
 534 ! CHECK:  %[[SLICE:.*]] = fir.slice %[[C1]], %[[BOX_DIMS]]#1, %[[C1]] path %[[FIELD_A]] : (index, index, index, !fir.field) -> !fir.slice<1>
 535 ! 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>
 536 ! CHECK:  %[[DO_RES:.*]] = fir.do_loop %[[IND:.*]] = %{{.*}} to %{{.*}} step %{{.*}} unordered iter_args(%[[ARG:.*]] = %[[ARRAY_LOAD]]) -> (!fir.array<?xi32>) {
 537 ! CHECK:    %[[ARR_UP:.*]] = fir.array_update %[[ARG]], %{{.*}}, %[[IND]] : (!fir.array<?xi32>, i32, index) -> !fir.array<?xi32>
 538 ! CHECK:    fir.result %[[ARR_UP]] : !fir.array<?xi32>
 539 ! CHECK:  }
 540 ! 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>
 541 ! CHECK:  %[[FIELD_B:.*]] = fir.field_index b, !fir.type<_QMselect_type_lower_testTp2{a:i32,b:i32,c:i32}>
 542 ! CHECK:  %[[C0:.*]] = arith.constant 0 : index
 543 ! 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)
 544 ! CHECK:  %[[C1:.*]] = arith.constant 1 : index
 545 ! CHECK:  %[[SLICE:.*]] = fir.slice %[[C1]], %[[BOX_DIMS]]#1, %[[C1]] path %[[FIELD_B]] : (index, index, index, !fir.field) -> !fir.slice<1>
 546 ! 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>
 547 ! CHECK:  %[[DO_RES:.*]] = fir.do_loop %[[IND:.*]] = %{{.*}} to %{{.*}} step %{{.*}} unordered iter_args(%[[ARG:.*]] = %[[ARRAY_LOAD]]) -> (!fir.array<?xi32>) {
 548 ! CHECK:    %[[ARR_UP:.*]] = fir.array_update %[[ARG]], %{{.*}}, %[[IND]] : (!fir.array<?xi32>, i32, index) -> !fir.array<?xi32>
 549 ! CHECK:    fir.result %[[ARR_UP]] : !fir.array<?xi32>
 550 ! CHECK:  }
 551 ! 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>
 552 ! CHECK:  %[[FIELD_C:.*]] = fir.field_index c, !fir.type<_QMselect_type_lower_testTp2{a:i32,b:i32,c:i32}>
 553 ! CHECK:  %[[C0:.*]] = arith.constant 0 : index
 554 ! 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)
 555 ! CHECK:  %[[C1:.*]] = arith.constant 1 : index
 556 ! CHECK:  %[[SLICE:.*]] = fir.slice %[[C1]], %[[BOX_DIMS]]#1, %[[C1]] path %[[FIELD_C]] : (index, index, index, !fir.field) -> !fir.slice<1>
 557 ! 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>
 558 ! CHECK:  %[[DO_RES:.*]] = fir.do_loop %[[IND:.*]] = %{{.*}} to %{{.*}} step %{{.*}} unordered iter_args(%[[ARG:.*]] = %[[ARRAY_LOAD]]) -> (!fir.array<?xi32>) {
 559 ! CHECK:    %[[ARR_UP:.*]] = fir.array_update %[[ARG]], %{{.*}}, %[[IND]] : (!fir.array<?xi32>, i32, index) -> !fir.array<?xi32>
 560 ! CHECK:    fir.result %[[ARR_UP]] : !fir.array<?xi32>
 561 ! CHECK:  }
 562 ! 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>
 563 ! CHECK:  cf.br ^bb{{.*}}
 564
 565   subroutine select_type9(a)
 566     class(p1) :: a(:)
 567
 568     select type(a)
 569     type is (p1)
 570       a%a = 1
 571       a%b = 2
 572     type is(p2)
 573       a%a = 1
 574       a%b = 2
 575       a%c = 3
 576     class default
 577       stop 'error'
 578     end select
 579   end subroutine
 580
 581 ! CHECK-LABEL: func.func @_QMselect_type_lower_testPselect_type9(
 582 ! CHECK-SAME: %[[ARG0:.*]]: !fir.class<!fir.array<?x!fir.type<_QMselect_type_lower_testTp1{a:i32,b:i32}>>> {fir.bindc_name = "a"}) {
 583 ! 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}>>>
 584 ! 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{{.*}}]
 585 ! CHECK: ^bb{{.*}}:
 586 ! 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}>>>
 587 ! CHECK: %[[FIELD_A:.*]] = fir.field_index a, !fir.type<_QMselect_type_lower_testTp1{a:i32,b:i32}>
 588 ! CHECK: %[[C0:.*]] = arith.constant 0 : index
 589 ! 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)
 590 ! CHECK: %[[C1:.*]] = arith.constant 1 : index
 591 ! CHECK: %[[SLICE:.*]] = fir.slice %[[C1]], %[[BOX_DIMS]]#1, %[[C1]] path %[[FIELD_A]] : (index, index, index, !fir.field) -> !fir.slice<1>
 592 ! 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>
 593 ! CHECK: %[[DO_RES:.*]] = fir.do_loop %[[IND:.*]] = %{{.*}} to %{{.*}} step %{{.*}} unordered iter_args(%[[ARG:.*]] = %[[ARRAY_LOAD]]) -> (!fir.array<?xi32>) {
 594 ! CHECK:   %[[ARR_UP:.*]] = fir.array_update %[[ARG]], %{{.*}}, %[[IND]] : (!fir.array<?xi32>, i32, index) -> !fir.array<?xi32>
 595 ! CHECK:   fir.result %[[ARR_UP]] : !fir.array<?xi32>
 596 ! CHECK: }
 597 ! 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>
 598 ! CHECK: %[[FIELD_B:.*]] = fir.field_index b, !fir.type<_QMselect_type_lower_testTp1{a:i32,b:i32}>
 599 ! CHECK: %[[C0:.*]] = arith.constant 0 : index
 600 ! 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)
 601 ! CHECK: %[[C1:.*]] = arith.constant 1 : index
 602 ! CHECK: %[[SLICE:.*]] = fir.slice %[[C1]], %[[BOX_DIMS]]#1, %[[C1]] path %[[FIELD_B]] : (index, index, index, !fir.field) -> !fir.slice<1>
 603 ! 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>
 604 ! CHECK: %[[DO_RES:.*]] = fir.do_loop %[[IND:.*]] = %{{.*}} to %{{.*}} step %c{{.*}} unordered iter_args(%[[ARG:.*]] = %[[ARRAY_LOAD]]) -> (!fir.array<?xi32>) {
 605 ! CHECK:   %[[ARR_UP:.*]] = fir.array_update %[[ARG]], %{{.*}}, %[[IND]] : (!fir.array<?xi32>, i32, index) -> !fir.array<?xi32>
 606 ! CHECK:   fir.result %[[ARR_UP]] : !fir.array<?xi32>
 607 ! CHECK: }
 608 ! 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>
 609 ! CHECK: cf.br ^bb{{.*}}
 610 ! CHECK: ^bb{{.*}}:
 611 ! 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}>>>
 612 ! CHECK: %[[FIELD_A:.*]] = fir.field_index a, !fir.type<_QMselect_type_lower_testTp2{a:i32,b:i32,c:i32}>
 613 ! CHECK: %[[C0:.*]] = arith.constant 0 : index
 614 ! 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)
 615 ! CHECK: %[[C1:.*]] = arith.constant 1 : index
 616 ! CHECK: %[[SLICE:.*]] = fir.slice %[[C1]], %[[BOX_DIMS]]#1, %[[C1]] path %[[FIELD_A]] : (index, index, index, !fir.field) -> !fir.slice<1>
 617 ! 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>
 618 ! CHECK: %[[DO_RES:.*]] = fir.do_loop %[[IND:.*]] = %{{.*}} to %{{.*}} step %{{.*}} unordered iter_args(%[[ARG:.*]] = %[[ARRAY_LOAD]]) -> (!fir.array<?xi32>) {
 619 ! CHECK:   %[[ARR_UP:.*]] = fir.array_update %[[ARG]], %{{.*}}, %[[IND]] : (!fir.array<?xi32>, i32, index) -> !fir.array<?xi32>
 620 ! CHECK:   fir.result %[[ARR_UP]] : !fir.array<?xi32>
 621 ! CHECK: }
 622 ! 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>
 623 ! CHECK: %[[FIELD_B:.*]] = fir.field_index b, !fir.type<_QMselect_type_lower_testTp2{a:i32,b:i32,c:i32}>
 624 ! CHECK: %[[C0:.*]] = arith.constant 0 : index
 625 ! 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)
 626 ! CHECK: %[[C1:.*]] = arith.constant 1 : index
 627 ! CHECK: %[[SLICE:.*]] = fir.slice %[[C1]], %[[BOX_DIMS]]#1, %[[C1]] path %[[FIELD_B]] : (index, index, index, !fir.field) -> !fir.slice<1>
 628 ! 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>
 629 ! CHECK: %[[DO_RES:.*]] = fir.do_loop %[[IND:.*]] = %{{.*}} to %{{.*}} step %{{.*}} unordered iter_args(%[[ARG:.*]] = %[[ARRAY_LOAD]]) -> (!fir.array<?xi32>) {
 630 ! CHECK:   %[[ARR_UP:.*]] = fir.array_update %[[ARG]], %{{.*}}, %[[IND]] : (!fir.array<?xi32>, i32, index) -> !fir.array<?xi32>
 631 ! CHECK:   fir.result %[[ARR_UP]] : !fir.array<?xi32>
 632 ! CHECK: }
 633 ! 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>
 634 ! CHECK: %[[FIELD_C:.*]] = fir.field_index c, !fir.type<_QMselect_type_lower_testTp2{a:i32,b:i32,c:i32}>
 635 ! CHECK: %[[C0:.*]] = arith.constant 0 : index
 636 ! 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)
 637 ! CHECK: %[[C1:.*]] = arith.constant 1 : index
 638 ! CHECK: %[[SLICE:.*]] = fir.slice %[[C1]], %[[BOX_DIMS]]#1, %[[C1]] path %[[FIELD_C]] : (index, index, index, !fir.field) -> !fir.slice<1>
 639 ! 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>
 640 ! CHECK: %[[DO_RES:.*]] = fir.do_loop %[[IND:.*]] = %{{.*}} to %{{.*}} step %{{.*}} unordered iter_args(%[[ARG:.*]] = %[[ARRAY_LOAD]]) -> (!fir.array<?xi32>) {
 641 ! CHECK:   %[[ARR_UP:.*]] = fir.array_update %[[ARG]], %{{.*}}, %[[IND]] : (!fir.array<?xi32>, i32, index) -> !fir.array<?xi32>
 642 ! CHECK:   fir.result %[[ARR_UP]] : !fir.array<?xi32>
 643 ! CHECK: }
 644 ! 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>
 645 ! CHECK: cf.br ^bb{{.*}}
 646
 647   subroutine select_type10(a)
 648     class(p1), pointer :: a
 649     select type(a)
 650       type is (p1)
 651         a%a = 1
 652       type is (p2)
 653         a%c = 3
 654       class is (p1)
 655         a%a = 5
 656     end select
 657   end subroutine
 658
 659 ! CHECK-LABEL: func.func @_QMselect_type_lower_testPselect_type10(
 660 ! CHECK-SAME: %[[ARG0:.*]]: !fir.ref<!fir.class<!fir.ptr<!fir.type<_QMselect_type_lower_testTp1{a:i32,b:i32}>>>> {fir.bindc_name = "a"}) {
 661 ! CHECK:  %[[SELECTOR:.*]] = fir.load %[[ARG0]] : !fir.ref<!fir.class<!fir.ptr<!fir.type<_QMselect_type_lower_testTp1{a:i32,b:i32}>>>>
 662 ! 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{{.*}}]
 663 ! CHECK: ^bb{{.*}}:
 664 ! 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}>>>
 665 ! CHECK:  %[[C1:.*]] = arith.constant 1 : i32
 666 ! CHECK:  %[[FIELD_A:.*]] = fir.field_index a, !fir.type<_QMselect_type_lower_testTp1{a:i32,b:i32}>
 667 ! CHECK:  %[[COORD_A:.*]] = fir.coordinate_of %[[EXACT_BOX]], %[[FIELD_A]] : (!fir.box<!fir.ptr<!fir.type<_QMselect_type_lower_testTp1{a:i32,b:i32}>>>, !fir.field) -> !fir.ref<i32>
 668 ! CHECK:  fir.store %[[C1]] to %[[COORD_A]] : !fir.ref<i32>
 669 ! CHECK:  cf.br ^bb{{.*}}
 670 ! CHECK: ^bb{{.*}}:
 671 ! 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}>>>
 672 ! CHECK:  %[[C3:.*]] = arith.constant 3 : i32
 673 ! CHECK:  %[[FIELD_C:.*]] = fir.field_index c, !fir.type<_QMselect_type_lower_testTp2{a:i32,b:i32,c:i32}>
 674 ! CHECK:  %[[COORD_C:.*]] = fir.coordinate_of %[[EXACT_BOX]], %[[FIELD_C]] : (!fir.box<!fir.ptr<!fir.type<_QMselect_type_lower_testTp2{a:i32,b:i32,c:i32}>>>, !fir.field) -> !fir.ref<i32>
 675 ! CHECK:  fir.store %[[C3]] to %[[COORD_C]] : !fir.ref<i32>
 676 ! CHECK:  cf.br ^bb{{.*}}
 677 ! CHECK: ^bb{{.*}}
 678 ! CHECK:  %[[C5:.*]] = arith.constant 5 : i32
 679 ! CHECK:  %[[FIELD_A:.*]] = fir.field_index a, !fir.type<_QMselect_type_lower_testTp1{a:i32,b:i32}>
 680 ! CHECK:  %[[COORD_A:.*]] = fir.coordinate_of %[[SELECTOR]], %[[FIELD_A]] : (!fir.class<!fir.ptr<!fir.type<_QMselect_type_lower_testTp1{a:i32,b:i32}>>>, !fir.field) -> !fir.ref<i32>
 681 ! CHECK:  fir.store %[[C5]] to %[[COORD_A]] : !fir.ref<i32>
 682 ! CHECK:  cf.br ^bb{{.*}}
 683
 684   subroutine select_type11(a)
 685     class(p1), allocatable :: a
 686     select type(a)
 687       type is (p1)
 688         a%a = 1
 689       type is (p2)
 690         a%a = 2
 691         a%c = 3
 692     end select
 693   end subroutine
 694
 695 ! CHECK-LABEL: func.func @_QMselect_type_lower_testPselect_type11(
 696 ! CHECK-SAME: %[[ARG0:.*]]: !fir.ref<!fir.class<!fir.heap<!fir.type<_QMselect_type_lower_testTp1{a:i32,b:i32}>>>> {fir.bindc_name = "a"}) {
 697 ! CHECK: %[[SELECTOR:.*]] = fir.load %[[ARG0]] : !fir.ref<!fir.class<!fir.heap<!fir.type<_QMselect_type_lower_testTp1{a:i32,b:i32}>>>>
 698 ! 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]
 699 ! CHECK: ^bb{{.*}}:
 700 ! 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}>>>
 701 ! CHECK:  %[[C1:.*]] = arith.constant 1 : i32
 702 ! CHECK:  %[[FIELD_A:.*]] = fir.field_index a, !fir.type<_QMselect_type_lower_testTp1{a:i32,b:i32}>
 703 ! CHECK:  %[[COORD_A:.*]] = fir.coordinate_of %[[EXACT_BOX]], %[[FIELD_A]] : (!fir.box<!fir.heap<!fir.type<_QMselect_type_lower_testTp1{a:i32,b:i32}>>>, !fir.field) -> !fir.ref<i32>
 704 ! CHECK:  fir.store %[[C1]] to %[[COORD_A]] : !fir.ref<i32>
 705 ! CHECK:  cf.br ^bb{{.*}}
 706 ! CHECK: ^bb{{.*}}:
 707 ! 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}>>>
 708 ! CHECK:  %[[C3:.*]] = arith.constant 3 : i32
 709 ! CHECK:  %[[FIELD_C:.*]] = fir.field_index c, !fir.type<_QMselect_type_lower_testTp2{a:i32,b:i32,c:i32}>
 710 ! CHECK:  %[[COORD_C:.*]] = fir.coordinate_of %[[EXACT_BOX]], %[[FIELD_C]] : (!fir.box<!fir.heap<!fir.type<_QMselect_type_lower_testTp2{a:i32,b:i32,c:i32}>>>, !fir.field) -> !fir.ref<i32>
 711 ! CHECK:  fir.store %[[C3]] to %[[COORD_C]] : !fir.ref<i32>
 712 ! CHECK:  cf.br ^bb{{.*}}
 713
 714   subroutine select_type12(a)
 715     class(p1), pointer :: a(:)
 716     select type(a)
 717       type is (p1)
 718         a%a = 120
 719       type is (p2)
 720         a%c = 121
 721       class is (p1)
 722         a%a = 122
 723     end select
 724   end subroutine
 725
 726 ! CHECK-LABEL: func.func @_QMselect_type_lower_testPselect_type12(
 727 ! 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"}) {
 728 ! CHECK:  %[[LOAD:.*]] = fir.load %[[ARG0]] : !fir.ref<!fir.class<!fir.ptr<!fir.array<?x!fir.type<_QMselect_type_lower_testTp1{a:i32,b:i32}>>>>>
 729 ! CHECK:  %[[C0:.*]] = arith.constant 0 : index
 730 ! 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)
 731 ! CHECK:  %[[SHIFT:.*]] = fir.shift %[[BOX_DIMS]]#0 : (index) -> !fir.shift<1>
 732 ! 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}>>>
 733 ! 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]
 734 ! CHECK: ^bb{{.*}}:
 735 ! 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}>>>
 736 ! CHECK: ^bb{{.*}}:  // pred: ^bb0
 737 ! 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}>>>
 738
 739
 740   ! Test correct lowering when CLASS DEFAULT is not at the last position in the
 741   ! SELECT TYPE construct.
 742   subroutine select_type13(a)
 743     class(p1), pointer :: a(:)
 744     select type (a)
 745       class default
 746         print*, 'default'
 747       class is (p1)
 748         print*, 'class'
 749     end select
 750
 751     select type (a)
 752       type is (p1)
 753         print*, 'type'
 754       class default
 755         print*, 'default'
 756       class is (p1)
 757         print*, 'class'
 758     end select
 759
 760   end subroutine
 761
 762 ! CHECK-LABEL: func.func @_QMselect_type_lower_testPselect_type13
 763 ! 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]
 764 ! CHECK: ^bb1:
 765 ! CHECK: ^bb2:
 766 ! CHECK: ^bb3:
 767 ! 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]
 768 ! CHECK: ^bb4:
 769 ! CHECK: ^bb5:
 770 ! CHECK: ^bb6:
 771 ! CHECK: ^bb7:
 772
 773   subroutine select_type14(a, b)
 774     class(p1) :: a, b
 775
 776     select type(a)
 777       type is (p2)
 778         select type (b)
 779           type is (p2)
 780             print*,a%c,b%C
 781         end select
 782       class default
 783         print*,a%a
 784     end select
 785   end subroutine
 786
 787   ! Just makes sure the example can be lowered.
 788   ! CHECK-LABEL: func.func @_QMselect_type_lower_testPselect_type14
 789
 790   subroutine select_type15(a)
 791     class(p5) :: a
 792
 793     select type(x => -a)
 794       type is (p5)
 795         print*, x%a
 796     end select
 797   end subroutine
 798
 799 ! CHECK-LABEL: func.func @_QMselect_type_lower_testPselect_type15(
 800 ! CHECK-SAME: %[[ARG0:.*]]: !fir.class<!fir.type<_QMselect_type_lower_testTp5{a:i32}>> {fir.bindc_name = "a"}) {
 801 ! CHECK: %[[RES:.*]] = fir.alloca !fir.class<!fir.heap<!fir.type<_QMselect_type_lower_testTp5{a:i32}>>> {bindc_name = ".result"}
 802 ! 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}
 803 ! 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}>>>>
 804 ! CHECK: %[[LOAD_RES:.*]] = fir.load %[[RES]] : !fir.ref<!fir.class<!fir.heap<!fir.type<_QMselect_type_lower_testTp5{a:i32}>>>>
 805 ! 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]
 806
 807 end module
 808
 809 program test_select_type
 810   use select_type_lower_test
 811
 812   integer :: a
 813   integer :: arr(2)
 814   real :: b
 815   real :: barr(2)
 816   character(1) :: carr(2)
 817   type(p4) :: t4
 818   type(p1), target :: t1
 819   type(p2), target :: t2
 820   type(p1), target :: t1arr(2)
 821   type(p2) :: t2arr(2)
 822   class(p1), pointer :: p
 823   class(p1), allocatable :: p1alloc
 824   class(p1), allocatable :: p2alloc
 825   class(p1), pointer :: parr(:)
 826
 827   call select_type7(t4)
 828   call select_type7(t2)
 829   call select_type7(t1)
 830
 831   call select_type1(t1)
 832   call select_type1(t2)
 833   call select_type1(t4)
 834
 835   call select_type6(a)
 836   print*, a
 837
 838   call select_type6(b)
 839   print*, b
 840
 841   print*, '> select_type8 with type(p1), dimension(2)'
 842   call select_type8(t1arr)
 843   print*, t1arr(1)
 844   print*, t1arr(2)
 845
 846   print*, '> select_type8 with type(p2), dimension(2)'
 847   call select_type8(t2arr)
 848   print*, t2arr(1)
 849   print*, t2arr(2)
 850
 851   print*, '> select_type8 with integer, dimension(2)'
 852   call select_type8(arr)
 853   print*, arr(:)
 854
 855   print*, '> select_type8 with real, dimension(2)'
 856   call select_type8(barr)
 857   print*, barr(:)
 858
 859   print*, '> select_type8 with character(1), dimension(2)'
 860   call select_type8(carr)
 861   print*, carr(:)
 862
 863   t1%a = 0
 864   p => t1
 865   print*, '> select_type10'
 866   call select_type10(p)
 867   print*, t1
 868
 869   t2%c = 0
 870   p => t2
 871   print*, '> select_type10'
 872   call select_type10(p)
 873   print*, t2
 874
 875   allocate(p1::p1alloc)
 876   print*, '> select_type11'
 877   call select_type11(p1alloc)
 878   print*, p1alloc%a
 879
 880   allocate(p2::p2alloc)
 881   print*, '> select_type11'
 882   call select_type11(p2alloc)
 883   print*, p2alloc%a
 884
 885   parr => t1arr
 886   call select_type12(parr)
 887   print*, t1arr(1)
 888   print*, t1arr(2)
 889 end