1! Test lowering of variables to fir.declare 2! RUN: bbc -emit-hlfir %s -o - | FileCheck %s 3 4subroutine scalar_numeric(x) 5 integer :: x 6end subroutine 7! CHECK-LABEL: func.func @_QPscalar_numeric( 8! CHECK-SAME: %[[VAL_0:.*]]: !fir.ref<i32> 9! CHECK: %[[VAL_1:.*]] = hlfir.declare %[[VAL_0]] dummy_scope %{{[0-9]+}} {uniq_name = "_QFscalar_numericEx"} : (!fir.ref<i32>, !fir.dscope) -> (!fir.ref<i32>, !fir.ref<i32>) 10 11subroutine scalar_character(c) 12 character(*) :: c 13end subroutine 14! CHECK-LABEL: func.func @_QPscalar_character( 15! CHECK-SAME: %[[VAL_0:.*]]: !fir.boxchar<1> 16! CHECK: %[[VAL_1:.*]]:2 = fir.unboxchar %[[VAL_0]] : (!fir.boxchar<1>) -> (!fir.ref<!fir.char<1,?>>, index) 17! CHECK: %[[VAL_2:.*]] = hlfir.declare %[[VAL_1]]#0 typeparams %[[VAL_1]]#1 dummy_scope %{{[0-9]+}} {uniq_name = "_QFscalar_characterEc"} : (!fir.ref<!fir.char<1,?>>, index, !fir.dscope) -> (!fir.boxchar<1>, !fir.ref<!fir.char<1,?>>) 18 19subroutine scalar_character_cst_len(c) 20 character(10) :: c 21end subroutine 22! CHECK-LABEL: func.func @_QPscalar_character_cst_len( 23! CHECK-SAME: %[[VAL_0:.*]]: !fir.boxchar<1> 24! CHECK: %[[VAL_1:.*]]:2 = fir.unboxchar %[[VAL_0]] : (!fir.boxchar<1>) -> (!fir.ref<!fir.char<1,?>>, index) 25! CHECK: %[[VAL_3:.*]] = fir.convert %[[VAL_1]]#0 : (!fir.ref<!fir.char<1,?>>) -> !fir.ref<!fir.char<1,10>> 26! CHECK: %[[VAL_2:.*]] = arith.constant 10 : index 27! CHECK: %[[VAL_4:.*]] = hlfir.declare %[[VAL_3]] typeparams %[[VAL_2]] dummy_scope %{{[0-9]+}} {uniq_name = "_QFscalar_character_cst_lenEc"} : (!fir.ref<!fir.char<1,10>>, index, !fir.dscope) -> (!fir.ref<!fir.char<1,10>>, !fir.ref<!fir.char<1,10>>) 28 29subroutine array_numeric(x) 30 integer :: x(10, 20) 31end subroutine 32! CHECK-LABEL: func.func @_QParray_numeric( 33! CHECK-SAME: %[[VAL_0:.*]]: !fir.ref<!fir.array<10x20xi32>> 34! CHECK: %[[VAL_1:.*]] = arith.constant 10 : index 35! CHECK: %[[VAL_2:.*]] = arith.constant 20 : index 36! CHECK: %[[VAL_3:.*]] = fir.shape %[[VAL_1]], %[[VAL_2]] : (index, index) -> !fir.shape<2> 37! CHECK: %[[VAL_4:.*]] = hlfir.declare %[[VAL_0]](%[[VAL_3]]) dummy_scope %{{[0-9]+}} {uniq_name = "_QFarray_numericEx"} : (!fir.ref<!fir.array<10x20xi32>>, !fir.shape<2>, !fir.dscope) -> (!fir.ref<!fir.array<10x20xi32>>, !fir.ref<!fir.array<10x20xi32>>) 38 39 40subroutine array_numeric_lbounds(x) 41 integer :: x(-1:10, -2:20) 42end subroutine 43! CHECK-LABEL: func.func @_QParray_numeric_lbounds( 44! CHECK-SAME: %[[VAL_0:.*]]: !fir.ref<!fir.array<12x23xi32>> 45! CHECK: %[[VAL_1:.*]] = arith.constant -1 : index 46! CHECK: %[[VAL_2:.*]] = arith.constant 12 : index 47! CHECK: %[[VAL_3:.*]] = arith.constant -2 : index 48! CHECK: %[[VAL_4:.*]] = arith.constant 23 : index 49! CHECK: %[[VAL_5:.*]] = fir.shape_shift %[[VAL_1]], %[[VAL_2]], %[[VAL_3]], %[[VAL_4]] : (index, index, index, index) -> !fir.shapeshift<2> 50! CHECK: %[[VAL_6:.*]] = hlfir.declare %[[VAL_0]](%[[VAL_5]]) dummy_scope %{{[0-9]+}} {uniq_name = "_QFarray_numeric_lboundsEx"} : (!fir.ref<!fir.array<12x23xi32>>, !fir.shapeshift<2>, !fir.dscope) -> (!fir.box<!fir.array<12x23xi32>>, !fir.ref<!fir.array<12x23xi32>>) 51 52subroutine array_character(c) 53 character(*) :: c(50) 54end subroutine 55! CHECK-LABEL: func.func @_QParray_character( 56! CHECK-SAME: %[[VAL_0:.*]]: !fir.boxchar<1> 57! CHECK: %[[VAL_1:.*]]:2 = fir.unboxchar %[[VAL_0]] : (!fir.boxchar<1>) -> (!fir.ref<!fir.char<1,?>>, index) 58! CHECK: %[[VAL_2:.*]] = fir.convert %[[VAL_1]]#0 : (!fir.ref<!fir.char<1,?>>) -> !fir.ref<!fir.array<50x!fir.char<1,?>>> 59! CHECK: %[[VAL_3:.*]] = arith.constant 50 : index 60! CHECK: %[[VAL_4:.*]] = fir.shape %[[VAL_3]] : (index) -> !fir.shape<1> 61! CHECK: %[[VAL_5:.*]] = hlfir.declare %[[VAL_2]](%[[VAL_4]]) typeparams %[[VAL_1]]#1 dummy_scope %{{[0-9]+}} {uniq_name = "_QFarray_characterEc"} : (!fir.ref<!fir.array<50x!fir.char<1,?>>>, !fir.shape<1>, index, !fir.dscope) -> (!fir.box<!fir.array<50x!fir.char<1,?>>>, !fir.ref<!fir.array<50x!fir.char<1,?>>>) 62 63subroutine scalar_numeric_attributes(x) 64 integer, optional, target, intent(in) :: x 65end subroutine 66! CHECK-LABEL: func.func @_QPscalar_numeric_attributes( 67! CHECK-SAME: %[[VAL_0:.*]]: !fir.ref<i32> 68! CHECK: %[[VAL_1:.*]] = hlfir.declare %[[VAL_0]] dummy_scope %{{[0-9]+}} {fortran_attrs = #fir.var_attrs<intent_in, optional, target>, uniq_name = "_QFscalar_numeric_attributesEx"} : (!fir.ref<i32>, !fir.dscope) -> (!fir.ref<i32>, !fir.ref<i32>) 69 70subroutine scalar_numeric_attributes_2(x) 71 real(16), value :: x(100) 72end subroutine 73! CHECK-LABEL: func.func @_QPscalar_numeric_attributes_2( 74! CHECK-SAME: %[[VAL_0:.*]]: !fir.ref<!fir.array<100xf128>> 75! CHECK: %[[VAL_1:.*]] = arith.constant 100 : index 76! CHECK: %[[VAL_2:.*]] = fir.shape %[[VAL_1]] : (index) -> !fir.shape<1> 77! CHECK: %[[VAL_3:.*]] = hlfir.declare %[[VAL_0]](%[[VAL_2]]) dummy_scope %{{[0-9]+}} {fortran_attrs = #fir.var_attrs<value>, uniq_name = "_QFscalar_numeric_attributes_2Ex"} : (!fir.ref<!fir.array<100xf128>>, !fir.shape<1>, !fir.dscope) -> (!fir.ref<!fir.array<100xf128>>, !fir.ref<!fir.array<100xf128>>) 78 79subroutine scalar_numeric_attributes_3(x) 80 real, intent(in) :: x 81end subroutine 82! CHECK-LABEL: func.func @_QPscalar_numeric_attributes_3( 83! CHECK-SAME: %[[VAL_0:.*]]: !fir.ref<f32> 84! CHECK: %[[VAL_1:.*]] = hlfir.declare %[[VAL_0]] dummy_scope %{{[0-9]+}} {fortran_attrs = #fir.var_attrs<intent_in>, uniq_name = "_QFscalar_numeric_attributes_3Ex"} : (!fir.ref<f32>, !fir.dscope) -> (!fir.ref<f32>, !fir.ref<f32>) 85 86subroutine scalar_numeric_attributes_4(x) 87 logical(8), intent(out) :: x 88end subroutine 89! CHECK-LABEL: func.func @_QPscalar_numeric_attributes_4( 90! CHECK-SAME: %[[VAL_0:.*]]: !fir.ref<!fir.logical<8>> 91! CHECK: %[[VAL_1:.*]] = hlfir.declare %[[VAL_0]] dummy_scope %{{[0-9]+}} {fortran_attrs = #fir.var_attrs<intent_out>, uniq_name = "_QFscalar_numeric_attributes_4Ex"} : (!fir.ref<!fir.logical<8>>, !fir.dscope) -> (!fir.ref<!fir.logical<8>>, !fir.ref<!fir.logical<8>>) 92 93subroutine scalar_numeric_parameter() 94 integer, parameter :: p = 42 95end subroutine 96! CHECK-LABEL: func.func @_QPscalar_numeric_parameter() { 97! CHECK: %[[VAL_0:.*]] = fir.address_of(@_QFscalar_numeric_parameterECp) : !fir.ref<i32> 98! CHECK: %[[VAL_1:.*]] = hlfir.declare %[[VAL_0]] {fortran_attrs = #fir.var_attrs<parameter>, uniq_name = "_QFscalar_numeric_parameterECp"} : (!fir.ref<i32>) -> (!fir.ref<i32>, !fir.ref<i32>) 99 100subroutine test_component_in_spec_expr(x, derived) 101 type t 102 integer :: component 103 end type 104 type(t) :: derived 105 ! Test that we do not try to instantiate "component" just because 106 ! its symbol appears in a specification expression. 107 real :: x(derived%component) 108end subroutine 109! CHECK-LABEL: func.func @_QPtest_component_in_spec_expr( 110! CHECK-NOT: alloca 111! CHECK: return 112