flang/test/Lower/derived-types.f90

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