1! Test basic parts of derived type entities lowering 2! RUN: bbc -emit-fir -hlfir=false %s -o - | FileCheck %s 3 4! Note: only testing non parameterized derived type here. 5 6module d 7 type r 8 real :: x 9 end type 10 type r2 11 real :: x_array(10, 20) 12 end type 13 type c 14 character(10) :: ch 15 end type 16 type c2 17 character(10) :: ch_array(20, 30) 18 end type 19contains 20 21! ----------------------------------------------------------------------------- 22! Test simple derived type symbol lowering 23! ----------------------------------------------------------------------------- 24 25! CHECK-LABEL: func @_QMdPderived_dummy( 26! CHECK-SAME: %{{.*}}: !fir.ref<!fir.type<_QMdTr{x:f32}>>{{.*}}, %{{.*}}: !fir.ref<!fir.type<_QMdTc2{ch_array:!fir.array<20x30x!fir.char<1,10>>}>>{{.*}}) { 27subroutine derived_dummy(some_r, some_c2) 28 type(r) :: some_r 29 type(c2) :: some_c2 30end subroutine 31 32! CHECK-LABEL: func @_QMdPlocal_derived( 33subroutine local_derived() 34 ! CHECK-DAG: fir.alloca !fir.type<_QMdTc2{ch_array:!fir.array<20x30x!fir.char<1,10>>}> 35 ! CHECK-DAG: fir.alloca !fir.type<_QMdTr{x:f32}> 36 type(r) :: some_r 37 type(c2) :: some_c2 38end subroutine 39 40! CHECK-LABEL: func @_QMdPsaved_derived( 41subroutine saved_derived() 42 ! CHECK-DAG: fir.address_of(@_QMdFsaved_derivedEsome_c2) : !fir.ref<!fir.type<_QMdTc2{ch_array:!fir.array<20x30x!fir.char<1,10>>}>> 43 ! CHECK-DAG: fir.address_of(@_QMdFsaved_derivedEsome_r) : !fir.ref<!fir.type<_QMdTr{x:f32}>> 44 type(r), save :: some_r 45 type(c2), save :: some_c2 46 call use_symbols(some_r, some_c2) 47end subroutine 48 49 50! ----------------------------------------------------------------------------- 51! Test simple derived type references 52! ----------------------------------------------------------------------------- 53 54! CHECK-LABEL: func @_QMdPscalar_numeric_ref( 55subroutine scalar_numeric_ref() 56 ! CHECK: %[[alloc:.*]] = fir.alloca !fir.type<_QMdTr{x:f32}> 57 type(r) :: some_r 58 ! CHECK: %[[field:.*]] = fir.field_index x, !fir.type<_QMdTr{x:f32}> 59 ! CHECK: fir.coordinate_of %[[alloc]], %[[field]] : (!fir.ref<!fir.type<_QMdTr{x:f32}>>, !fir.field) -> !fir.ref<f32> 60 call real_bar(some_r%x) 61end subroutine 62 63! CHECK-LABEL: func @_QMdPscalar_character_ref( 64subroutine scalar_character_ref() 65 ! CHECK: %[[alloc:.*]] = fir.alloca !fir.type<_QMdTc{ch:!fir.char<1,10>}> 66 type(c) :: some_c 67 ! CHECK: %[[field:.*]] = fir.field_index ch, !fir.type<_QMdTc{ch:!fir.char<1,10>}> 68 ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[alloc]], %[[field]] : (!fir.ref<!fir.type<_QMdTc{ch:!fir.char<1,10>}>>, !fir.field) -> !fir.ref<!fir.char<1,10>> 69 ! CHECK-DAG: %[[c10:.*]] = arith.constant 10 : index 70 ! CHECK: fir.emboxchar %[[coor]], %c10 : (!fir.ref<!fir.char<1,10>>, index) -> !fir.boxchar<1> 71 call char_bar(some_c%ch) 72end subroutine 73 74! FIXME: coordinate of generated for derived%array_comp(i) are not zero based as they 75! should be. 76 77! CHECK-LABEL: func @_QMdParray_comp_elt_ref( 78subroutine array_comp_elt_ref() 79 type(r2) :: some_r2 80 ! CHECK: %[[alloc:.*]] = fir.alloca !fir.type<_QMdTr2{x_array:!fir.array<10x20xf32>}> 81 ! CHECK: %[[field:.*]] = fir.field_index x_array, !fir.type<_QMdTr2{x_array:!fir.array<10x20xf32>}> 82 ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[alloc]], %[[field]] : (!fir.ref<!fir.type<_QMdTr2{x_array:!fir.array<10x20xf32>}>>, !fir.field) -> !fir.ref<!fir.array<10x20xf32>> 83 ! CHECK-DAG: %[[index1:.*]] = arith.subi %c5{{.*}}, %c1{{.*}} : i64 84 ! CHECK-DAG: %[[index2:.*]] = arith.subi %c6{{.*}}, %c1{{.*}} : i64 85 ! CHECK: fir.coordinate_of %[[coor]], %[[index1]], %[[index2]] : (!fir.ref<!fir.array<10x20xf32>>, i64, i64) -> !fir.ref<f32> 86 call real_bar(some_r2%x_array(5, 6)) 87end subroutine 88 89 90! CHECK-LABEL: func @_QMdPchar_array_comp_elt_ref( 91subroutine char_array_comp_elt_ref() 92 type(c2) :: some_c2 93 ! CHECK: %[[coor:.*]] = fir.coordinate_of %{{.*}}, %{{.*}} : (!fir.ref<!fir.type<_QMdTc2{ch_array:!fir.array<20x30x!fir.char<1,10>>}>>, !fir.field) -> !fir.ref<!fir.array<20x30x!fir.char<1,10>>> 94 ! CHECK-DAG: %[[index1:.*]] = arith.subi %c5{{.*}}, %c1{{.*}} : i64 95 ! CHECK-DAG: %[[index2:.*]] = arith.subi %c6{{.*}}, %c1{{.*}} : i64 96 ! CHECK: fir.coordinate_of %[[coor]], %[[index1]], %[[index2]] : (!fir.ref<!fir.array<20x30x!fir.char<1,10>>>, i64, i64) -> !fir.ref<!fir.char<1,10>> 97 ! CHECK: fir.emboxchar %{{.*}}, %c10 : (!fir.ref<!fir.char<1,10>>, index) -> !fir.boxchar<1> 98 call char_bar(some_c2%ch_array(5, 6)) 99end subroutine 100 101! CHECK: @_QMdParray_elt_comp_ref 102subroutine array_elt_comp_ref() 103 type(r) :: some_r_array(100) 104 ! CHECK: %[[alloca:.*]] = fir.alloca !fir.array<100x!fir.type<_QMdTr{x:f32}>> 105 ! CHECK: %[[index:.*]] = arith.subi %c5{{.*}}, %c1{{.*}} : i64 106 ! CHECK: %[[elt:.*]] = fir.coordinate_of %[[alloca]], %[[index]] : (!fir.ref<!fir.array<100x!fir.type<_QMdTr{x:f32}>>>, i64) -> !fir.ref<!fir.type<_QMdTr{x:f32}>> 107 ! CHECK: %[[field:.*]] = fir.field_index x, !fir.type<_QMdTr{x:f32}> 108 ! CHECK: fir.coordinate_of %[[elt]], %[[field]] : (!fir.ref<!fir.type<_QMdTr{x:f32}>>, !fir.field) -> !fir.ref<f32> 109 call real_bar(some_r_array(5)%x) 110end subroutine 111 112! CHECK: @_QMdPchar_array_elt_comp_ref 113subroutine char_array_elt_comp_ref() 114 type(c) :: some_c_array(100) 115 ! CHECK: fir.coordinate_of %{{.*}}, %{{.*}} : (!fir.ref<!fir.array<100x!fir.type<_QMdTc{ch:!fir.char<1,10>}>>>, i64) -> !fir.ref<!fir.type<_QMdTc{ch:!fir.char<1,10>}>> 116 ! CHECK: fir.coordinate_of %{{.*}}, %{{.*}} : (!fir.ref<!fir.type<_QMdTc{ch:!fir.char<1,10>}>>, !fir.field) -> !fir.ref<!fir.char<1,10>> 117 ! CHECK: fir.emboxchar %{{.*}}, %c10{{.*}} : (!fir.ref<!fir.char<1,10>>, index) -> !fir.boxchar<1> 118 call char_bar(some_c_array(5)%ch) 119end subroutine 120 121! ----------------------------------------------------------------------------- 122! Test loading derived type components 123! ----------------------------------------------------------------------------- 124 125! Most of the other tests only require lowering code to compute the address of 126! components. This one requires loading a component which tests other code paths 127! in lowering. 128 129! CHECK-LABEL: func @_QMdPscalar_numeric_load( 130! CHECK-SAME: %[[arg0:.*]]: !fir.ref<!fir.type<_QMdTr{x:f32}>> 131real function scalar_numeric_load(some_r) 132 type(r) :: some_r 133 ! CHECK: %[[field:.*]] = fir.field_index x, !fir.type<_QMdTr{x:f32}> 134 ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[arg0]], %[[field]] : (!fir.ref<!fir.type<_QMdTr{x:f32}>>, !fir.field) -> !fir.ref<f32> 135 ! CHECK: fir.load %[[coor]] 136 scalar_numeric_load = some_r%x 137end function 138 139! ----------------------------------------------------------------------------- 140! Test returned derived types (no length parameters) 141! ----------------------------------------------------------------------------- 142 143! CHECK-LABEL: func @_QMdPbar_return_derived() -> !fir.type<_QMdTr{x:f32}> 144function bar_return_derived() 145 ! CHECK: %[[res:.*]] = fir.alloca !fir.type<_QMdTr{x:f32}> 146 type(r) :: bar_return_derived 147 ! CHECK: %[[resLoad:.*]] = fir.load %[[res]] : !fir.ref<!fir.type<_QMdTr{x:f32}>> 148 ! CHECK: return %[[resLoad]] : !fir.type<_QMdTr{x:f32}> 149end function 150 151! CHECK-LABEL: func @_QMdPcall_bar_return_derived( 152subroutine call_bar_return_derived() 153 ! CHECK: %[[tmp:.*]] = fir.alloca !fir.type<_QMdTr{x:f32}> 154 ! CHECK: %[[call:.*]] = fir.call @_QMdPbar_return_derived() {{.*}}: () -> !fir.type<_QMdTr{x:f32}> 155 ! CHECK: fir.save_result %[[call]] to %[[tmp]] : !fir.type<_QMdTr{x:f32}>, !fir.ref<!fir.type<_QMdTr{x:f32}>> 156 ! CHECK: fir.call @_QPr_bar(%[[tmp]]) {{.*}}: (!fir.ref<!fir.type<_QMdTr{x:f32}>>) -> () 157 call r_bar(bar_return_derived()) 158end subroutine 159 160end module 161 162! ----------------------------------------------------------------------------- 163! Test derived type with pointer/allocatable components 164! ----------------------------------------------------------------------------- 165 166module d2 167 type recursive_t 168 real :: x 169 type(recursive_t), pointer :: ptr 170 end type 171contains 172! CHECK-LABEL: func @_QMd2Ptest_recursive_type( 173! CHECK-SAME: %{{.*}}: !fir.ref<!fir.type<_QMd2Trecursive_t{x:f32,ptr:!fir.box<!fir.ptr<!fir.type<_QMd2Trecursive_t>>>}>>{{.*}}) { 174subroutine test_recursive_type(some_recursive) 175 type(recursive_t) :: some_recursive 176end subroutine 177end module 178 179! ----------------------------------------------------------------------------- 180! Test global derived type symbol lowering 181! ----------------------------------------------------------------------------- 182 183module data_mod 184 use d 185 type(r) :: some_r 186 type(c2) :: some_c2 187end module 188 189! Test globals 190 191! CHECK-DAG: fir.global @_QMdata_modEsome_c2 : !fir.type<_QMdTc2{ch_array:!fir.array<20x30x!fir.char<1,10>>}> 192! CHECK-DAG: fir.global @_QMdata_modEsome_r : !fir.type<_QMdTr{x:f32}> 193! CHECK-DAG: fir.global internal @_QMdFsaved_derivedEsome_c2 : !fir.type<_QMdTc2{ch_array:!fir.array<20x30x!fir.char<1,10>>}> 194! CHECK-DAG: fir.global internal @_QMdFsaved_derivedEsome_r : !fir.type<_QMdTr{x:f32}> 195