192 lines · plain
1! Test basic parts of derived type entities lowering2! RUN: bbc -emit-fir -hlfir=false %s -o - | FileCheck %s3 4! Note: only testing non parameterized derived type here.5 6module d7 type r8 real :: x9 end type10 type r211 real :: x_array(10, 20)12 end type13 type c14 character(10) :: ch15 end type16 type c217 character(10) :: ch_array(20, 30)18 end type19contains20 21! -----------------------------------------------------------------------------22! Test simple derived type symbol lowering23! -----------------------------------------------------------------------------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_r29 type(c2) :: some_c230end subroutine31 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_r37 type(c2) :: some_c238 print *, some_c2%ch_array(1,1)39 print *, some_r%x40end subroutine41 42! CHECK-LABEL: func @_QMdPsaved_derived(43subroutine saved_derived()44 ! CHECK-DAG: fir.address_of(@_QMdFsaved_derivedEsome_c2) : !fir.ref<!fir.type<_QMdTc2{ch_array:!fir.array<20x30x!fir.char<1,10>>}>>45 ! CHECK-DAG: fir.address_of(@_QMdFsaved_derivedEsome_r) : !fir.ref<!fir.type<_QMdTr{x:f32}>>46 type(r), save :: some_r47 type(c2), save :: some_c248 call use_symbols(some_r, some_c2)49end subroutine50 51 52! -----------------------------------------------------------------------------53! Test simple derived type references54! -----------------------------------------------------------------------------55 56! CHECK-LABEL: func @_QMdPscalar_numeric_ref(57subroutine scalar_numeric_ref()58 ! CHECK: %[[alloc:.*]] = fir.alloca !fir.type<_QMdTr{x:f32}>59 type(r) :: some_r60 ! CHECK: fir.coordinate_of %[[alloc]], x : (!fir.ref<!fir.type<_QMdTr{x:f32}>>) -> !fir.ref<f32>61 call real_bar(some_r%x)62end subroutine63 64! CHECK-LABEL: func @_QMdPscalar_character_ref(65subroutine scalar_character_ref()66 ! CHECK: %[[alloc:.*]] = fir.alloca !fir.type<_QMdTc{ch:!fir.char<1,10>}>67 type(c) :: some_c68 ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[alloc]], ch : (!fir.ref<!fir.type<_QMdTc{ch:!fir.char<1,10>}>>) -> !fir.ref<!fir.char<1,10>>69 ! CHECK-DAG: %[[c10:.*]] = arith.constant 10 : index70 ! CHECK: fir.emboxchar %[[coor]], %c10 : (!fir.ref<!fir.char<1,10>>, index) -> !fir.boxchar<1>71 call char_bar(some_c%ch)72end subroutine73 74! FIXME: coordinate of generated for derived%array_comp(i) are not zero based as they75! should be.76 77! CHECK-LABEL: func @_QMdParray_comp_elt_ref(78subroutine array_comp_elt_ref()79 type(r2) :: some_r280 ! CHECK: %[[alloc:.*]] = fir.alloca !fir.type<_QMdTr2{x_array:!fir.array<10x20xf32>}>81 ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[alloc]], x_array : (!fir.ref<!fir.type<_QMdTr2{x_array:!fir.array<10x20xf32>}>>) -> !fir.ref<!fir.array<10x20xf32>>82 ! CHECK-DAG: %[[index1:.*]] = arith.subi %c5{{.*}}, %c1{{.*}} : i6483 ! CHECK-DAG: %[[index2:.*]] = arith.subi %c6{{.*}}, %c1{{.*}} : i6484 ! CHECK: fir.coordinate_of %[[coor]], %[[index1]], %[[index2]] : (!fir.ref<!fir.array<10x20xf32>>, i64, i64) -> !fir.ref<f32>85 call real_bar(some_r2%x_array(5, 6))86end subroutine87 88 89! CHECK-LABEL: func @_QMdPchar_array_comp_elt_ref(90subroutine char_array_comp_elt_ref()91 type(c2) :: some_c292 ! CHECK: %[[coor:.*]] = fir.coordinate_of %{{.*}}, ch_array : (!fir.ref<!fir.type<_QMdTc2{ch_array:!fir.array<20x30x!fir.char<1,10>>}>>) -> !fir.ref<!fir.array<20x30x!fir.char<1,10>>>93 ! CHECK-DAG: %[[index1:.*]] = arith.subi %c5{{.*}}, %c1{{.*}} : i6494 ! CHECK-DAG: %[[index2:.*]] = arith.subi %c6{{.*}}, %c1{{.*}} : i6495 ! CHECK: fir.coordinate_of %[[coor]], %[[index1]], %[[index2]] : (!fir.ref<!fir.array<20x30x!fir.char<1,10>>>, i64, i64) -> !fir.ref<!fir.char<1,10>>96 ! CHECK: fir.emboxchar %{{.*}}, %c10 : (!fir.ref<!fir.char<1,10>>, index) -> !fir.boxchar<1>97 call char_bar(some_c2%ch_array(5, 6))98end subroutine99 100! CHECK: @_QMdParray_elt_comp_ref101subroutine array_elt_comp_ref()102 type(r) :: some_r_array(100)103 ! CHECK: %[[alloca:.*]] = fir.alloca !fir.array<100x!fir.type<_QMdTr{x:f32}>>104 ! CHECK: %[[index:.*]] = arith.subi %c5{{.*}}, %c1{{.*}} : i64105 ! 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}>>106 ! CHECK: fir.coordinate_of %[[elt]], x : (!fir.ref<!fir.type<_QMdTr{x:f32}>>) -> !fir.ref<f32>107 call real_bar(some_r_array(5)%x)108end subroutine109 110! CHECK: @_QMdPchar_array_elt_comp_ref111subroutine char_array_elt_comp_ref()112 type(c) :: some_c_array(100)113 ! 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>}>>114 ! CHECK: fir.coordinate_of %{{.*}}, ch : (!fir.ref<!fir.type<_QMdTc{ch:!fir.char<1,10>}>>) -> !fir.ref<!fir.char<1,10>>115 ! CHECK: fir.emboxchar %{{.*}}, %c10{{.*}} : (!fir.ref<!fir.char<1,10>>, index) -> !fir.boxchar<1>116 call char_bar(some_c_array(5)%ch)117end subroutine118 119! -----------------------------------------------------------------------------120! Test loading derived type components121! -----------------------------------------------------------------------------122 123! Most of the other tests only require lowering code to compute the address of124! components. This one requires loading a component which tests other code paths125! in lowering.126 127! CHECK-LABEL: func @_QMdPscalar_numeric_load(128! CHECK-SAME: %[[arg0:.*]]: !fir.ref<!fir.type<_QMdTr{x:f32}>>129real function scalar_numeric_load(some_r)130 type(r) :: some_r131 ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[arg0]], x : (!fir.ref<!fir.type<_QMdTr{x:f32}>>) -> !fir.ref<f32>132 ! CHECK: fir.load %[[coor]]133 scalar_numeric_load = some_r%x134end function135 136! -----------------------------------------------------------------------------137! Test returned derived types (no length parameters)138! -----------------------------------------------------------------------------139 140! CHECK-LABEL: func @_QMdPbar_return_derived() -> !fir.type<_QMdTr{x:f32}>141function bar_return_derived()142 ! CHECK: %[[res:.*]] = fir.alloca !fir.type<_QMdTr{x:f32}>143 type(r) :: bar_return_derived144 ! CHECK: %[[resLoad:.*]] = fir.load %[[res]] : !fir.ref<!fir.type<_QMdTr{x:f32}>>145 ! CHECK: return %[[resLoad]] : !fir.type<_QMdTr{x:f32}>146end function147 148! CHECK-LABEL: func @_QMdPcall_bar_return_derived(149subroutine call_bar_return_derived()150 ! CHECK: %[[tmp:.*]] = fir.alloca !fir.type<_QMdTr{x:f32}>151 ! CHECK: %[[call:.*]] = fir.call @_QMdPbar_return_derived() {{.*}}: () -> !fir.type<_QMdTr{x:f32}>152 ! CHECK: fir.save_result %[[call]] to %[[tmp]] : !fir.type<_QMdTr{x:f32}>, !fir.ref<!fir.type<_QMdTr{x:f32}>>153 ! CHECK: fir.call @_QPr_bar(%[[tmp]]) {{.*}}: (!fir.ref<!fir.type<_QMdTr{x:f32}>>) -> ()154 call r_bar(bar_return_derived())155end subroutine156 157end module158 159! -----------------------------------------------------------------------------160! Test derived type with pointer/allocatable components161! -----------------------------------------------------------------------------162 163module d2164 type recursive_t165 real :: x166 type(recursive_t), pointer :: ptr167 end type168contains169! CHECK-LABEL: func @_QMd2Ptest_recursive_type(170! CHECK-SAME: %{{.*}}: !fir.ref<!fir.type<_QMd2Trecursive_t{x:f32,ptr:!fir.box<!fir.ptr<!fir.type<_QMd2Trecursive_t>>>}>>{{.*}}) {171subroutine test_recursive_type(some_recursive)172 type(recursive_t) :: some_recursive173end subroutine174end module175 176! -----------------------------------------------------------------------------177! Test global derived type symbol lowering178! -----------------------------------------------------------------------------179 180module data_mod181 use d182 type(r) :: some_r183 type(c2) :: some_c2184end module185 186! Test globals187 188! CHECK-DAG: fir.global @_QMdata_modEsome_c2 : !fir.type<_QMdTc2{ch_array:!fir.array<20x30x!fir.char<1,10>>}>189! CHECK-DAG: fir.global @_QMdata_modEsome_r : !fir.type<_QMdTr{x:f32}>190! CHECK-DAG: fir.global internal @_QMdFsaved_derivedEsome_c2 : !fir.type<_QMdTc2{ch_array:!fir.array<20x30x!fir.char<1,10>>}>191! CHECK-DAG: fir.global internal @_QMdFsaved_derivedEsome_r : !fir.type<_QMdTr{x:f32}>192