xref: /llvm-project/flang/test/Lower/select-type.f90 (revision 1710c8cf0f8def4984893e9dd646579de5528d95) 
1! RUN: bbc -emit-fir -hlfir=false %s -o - | FileCheck %s
2! RUN: bbc -emit-fir -hlfir=false %s -o - | fir-opt --fir-polymorphic-op | FileCheck --check-prefix=CFG %s
3module 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
29contains
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-9]+}} : (!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
807end module
808
809program 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)
889end
890