1! Test that the selector is lowered as a box with the lower 2! bounds inherited from the original variable. Otherwise, 3! the bounds accessed inside the type guard block are going 4! to be default 1-based. 5! 6! 11.1.11.2 Execution of the SELECT TYPE construct 7! 5 Within the block following a TYPE IS type guard statement, the associating entity (19.5.5) is not polymorphic 8! (7.3.2.3), has the type named in the type guard statement, and has the type parameter values of the selector. 9! 8 The other attributes of the associating entity are described in 11.1.3.3. 10! ... 11! 11.1.3.3 Other attributes of associate names 12! 1 Within an ASSOCIATE, CHANGE TEAM, or SELECT TYPE construct, each associating entity has the same 13! rank as its associated selector. The lower bound of each dimension is the result of the intrinsic function LBOUND 14! (16.9.109) applied to the corresponding dimension of selector. The upper bound of each dimension is one less 15! than the sum of the lower bound and the extent. 16 17! RUN: bbc -emit-hlfir -I nowhere -o - %s | FileCheck %s 18 19subroutine test() 20 type t 21 end type t 22 class(*), allocatable :: x(:) 23 integer :: ub 24! allocate(x(-1:8)) 25 select type(x) 26 type is (t) 27 ub = ubound(x, 1) 28 end select 29end subroutine test 30! CHECK-LABEL: func.func @_QPtest() { 31! CHECK: %[[VAL_0:.*]] = fir.alloca i32 {bindc_name = "ub", uniq_name = "_QFtestEub"} 32! CHECK: %[[VAL_1:.*]]:2 = hlfir.declare %[[VAL_0]] {uniq_name = "_QFtestEub"} : (!fir.ref<i32>) -> (!fir.ref<i32>, !fir.ref<i32>) 33! CHECK: %[[VAL_2:.*]] = fir.alloca !fir.class<!fir.heap<!fir.array<?xnone>>> {bindc_name = "x", uniq_name = "_QFtestEx"} 34! CHECK: %[[VAL_3:.*]] = fir.zero_bits !fir.heap<!fir.array<?xnone>> 35! CHECK: %[[VAL_4:.*]] = arith.constant 0 : index 36! CHECK: %[[VAL_5:.*]] = fir.shape %[[VAL_4]] : (index) -> !fir.shape<1> 37! CHECK: %[[VAL_6:.*]] = fir.embox %[[VAL_3]](%[[VAL_5]]) : (!fir.heap<!fir.array<?xnone>>, !fir.shape<1>) -> !fir.class<!fir.heap<!fir.array<?xnone>>> 38! CHECK: fir.store %[[VAL_6]] to %[[VAL_2]] : !fir.ref<!fir.class<!fir.heap<!fir.array<?xnone>>>> 39! CHECK: %[[VAL_7:.*]]:2 = hlfir.declare %[[VAL_2]] {fortran_attrs = #fir.var_attrs<allocatable>, uniq_name = "_QFtestEx"} : (!fir.ref<!fir.class<!fir.heap<!fir.array<?xnone>>>>) -> (!fir.ref<!fir.class<!fir.heap<!fir.array<?xnone>>>>, !fir.ref<!fir.class<!fir.heap<!fir.array<?xnone>>>>) 40! CHECK: %[[VAL_8:.*]] = fir.load %[[VAL_7]]#1 : !fir.ref<!fir.class<!fir.heap<!fir.array<?xnone>>>> 41! CHECK: %[[VAL_9:.*]] = fir.load %[[VAL_7]]#1 : !fir.ref<!fir.class<!fir.heap<!fir.array<?xnone>>>> 42! CHECK: %[[VAL_10:.*]] = arith.constant 0 : index 43! CHECK: %[[VAL_11:.*]]:3 = fir.box_dims %[[VAL_9]], %[[VAL_10]] : (!fir.class<!fir.heap<!fir.array<?xnone>>>, index) -> (index, index, index) 44! CHECK: fir.select_type %[[VAL_8]] : !fir.class<!fir.heap<!fir.array<?xnone>>> [#fir.type_is<!fir.type<_QFtestTt>>, ^bb1, unit, ^bb2] 45! CHECK: ^bb1: 46! CHECK: %[[VAL_12:.*]] = fir.convert %[[VAL_8]] : (!fir.class<!fir.heap<!fir.array<?xnone>>>) -> !fir.box<!fir.heap<!fir.array<?x!fir.type<_QFtestTt>>>> 47! CHECK: %[[VAL_13:.*]] = fir.shift %[[VAL_11]]#0 : (index) -> !fir.shift<1> 48! CHECK: %[[VAL_14:.*]]:2 = hlfir.declare %[[VAL_12]](%[[VAL_13]]) {uniq_name = "_QFtestEx"} : (!fir.box<!fir.heap<!fir.array<?x!fir.type<_QFtestTt>>>>, !fir.shift<1>) -> (!fir.box<!fir.heap<!fir.array<?x!fir.type<_QFtestTt>>>>, !fir.box<!fir.heap<!fir.array<?x!fir.type<_QFtestTt>>>>) 49! CHECK: %[[VAL_15:.*]] = arith.constant 0 : index 50! CHECK: %[[VAL_16:.*]]:3 = fir.box_dims %[[VAL_14]]#0, %[[VAL_15]] : (!fir.box<!fir.heap<!fir.array<?x!fir.type<_QFtestTt>>>>, index) -> (index, index, index) 51! CHECK: %[[VAL_17:.*]] = fir.convert %[[VAL_16]]#1 : (index) -> i64 52! CHECK: %[[VAL_18:.*]] = fir.convert %[[VAL_11]]#0 : (index) -> i64 53! CHECK: %[[VAL_19:.*]] = arith.addi %[[VAL_17]], %[[VAL_18]] : i64 54! CHECK: %[[VAL_20:.*]] = arith.constant 1 : i64 55! CHECK: %[[VAL_21:.*]] = arith.subi %[[VAL_19]], %[[VAL_20]] : i64 56! CHECK: %[[VAL_22:.*]] = fir.convert %[[VAL_21]] : (i64) -> i32 57! CHECK: hlfir.assign %[[VAL_22]] to %[[VAL_1]]#0 : i32, !fir.ref<i32> 58! CHECK: cf.br ^bb2 59! CHECK: ^bb2: 60! CHECK: return 61! CHECK: } 62