diff --git a/flang/test/Lower/derived-allocatable-components.f90 b/flang/test/Lower/derived-allocatable-components.f90 new file mode 100644 --- /dev/null +++ b/flang/test/Lower/derived-allocatable-components.f90 @@ -0,0 +1,560 @@ +! Test lowering of allocatable components +! RUN: bbc -emit-fir %s -o - | FileCheck %s + +module acomp + implicit none + type t + real :: x + integer :: i + end type + interface + subroutine takes_real_scalar(x) + real :: x + end subroutine + subroutine takes_char_scalar(x) + character(*) :: x + end subroutine + subroutine takes_derived_scalar(x) + import t + type(t) :: x + end subroutine + subroutine takes_real_array(x) + real :: x(:) + end subroutine + subroutine takes_char_array(x) + character(*) :: x(:) + end subroutine + subroutine takes_derived_array(x) + import t + type(t) :: x(:) + end subroutine + subroutine takes_real_scalar_pointer(x) + real, allocatable :: x + end subroutine + subroutine takes_real_array_pointer(x) + real, allocatable :: x(:) + end subroutine + subroutine takes_logical(x) + logical :: x + end subroutine + end interface + + type real_a0 + real, allocatable :: p + end type + type real_a1 + real, allocatable :: p(:) + end type + type cst_char_a0 + character(10), allocatable :: p + end type + type cst_char_a1 + character(10), allocatable :: p(:) + end type + type def_char_a0 + character(:), allocatable :: p + end type + type def_char_a1 + character(:), allocatable :: p(:) + end type + type derived_a0 + type(t), allocatable :: p + end type + type derived_a1 + type(t), allocatable :: p(:) + end type + + real, target :: real_target, real_array_target(100) + character(10), target :: char_target, char_array_target(100) + +contains + +! ----------------------------------------------------------------------------- +! Test allocatable component references +! ----------------------------------------------------------------------------- + +! CHECK-LABEL: func @_QMacompPref_scalar_real_a( +! CHECK-SAME: %[[arg0:.*]]: !fir.ref>}>>{{.*}}, %[[arg1:.*]]: !fir.ref>>}>>{{.*}}, %[[arg2:.*]]: !fir.ref>}>>>{{.*}}, %[[arg3:.*]]: !fir.ref>>}>>>{{.*}}) { +subroutine ref_scalar_real_a(a0_0, a1_0, a0_1, a1_1) + type(real_a0) :: a0_0, a0_1(100) + type(real_a1) :: a1_0, a1_1(100) + + ! CHECK: %[[fld:.*]] = fir.field_index p, !fir.type<_QMacompTreal_a0{p:!fir.box>}> + ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[arg0]], %[[fld]] : (!fir.ref>}>>, !fir.field) -> !fir.ref>> + ! CHECK: %[[load:.*]] = fir.load %[[coor]] : !fir.ref>> + ! CHECK: %[[addr:.*]] = fir.box_addr %[[load]] : (!fir.box>) -> !fir.heap + ! CHECK: %[[cast:.*]] = fir.convert %[[addr]] : (!fir.heap) -> !fir.ref + ! CHECK: fir.call @_QPtakes_real_scalar(%[[cast]]) : (!fir.ref) -> () + call takes_real_scalar(a0_0%p) + + ! CHECK: %[[a0_1_coor:.*]] = fir.coordinate_of %[[arg2]], %{{.*}} : (!fir.ref>}>>>, i64) -> !fir.ref>}>> + ! CHECK: %[[fld:.*]] = fir.field_index p, !fir.type<_QMacompTreal_a0{p:!fir.box>}> + ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[a0_1_coor]], %[[fld]] : (!fir.ref>}>>, !fir.field) -> !fir.ref>> + ! CHECK: %[[load:.*]] = fir.load %[[coor]] : !fir.ref>> + ! CHECK: %[[addr:.*]] = fir.box_addr %[[load]] : (!fir.box>) -> !fir.heap + ! CHECK: %[[cast:.*]] = fir.convert %[[addr]] : (!fir.heap) -> !fir.ref + ! CHECK: fir.call @_QPtakes_real_scalar(%[[cast]]) : (!fir.ref) -> () + call takes_real_scalar(a0_1(5)%p) + + ! CHECK: %[[fld:.*]] = fir.field_index p, !fir.type<_QMacompTreal_a1{p:!fir.box>>}> + ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[arg1]], %[[fld]] : (!fir.ref>>}>>, !fir.field) -> !fir.ref>>> + ! CHECK: %[[box:.*]] = fir.load %[[coor]] : !fir.ref>>> + ! CHECK-DAG: %[[addr:.*]] = fir.box_addr %[[box]] : (!fir.box>>) -> !fir.heap> + ! CHECK-DAG: %[[dims:.*]]:3 = fir.box_dims %[[box]], %c0{{.*}} : (!fir.box>>, index) -> (index, index, index) + ! CHECK: %[[lb:.*]] = fir.convert %[[dims]]#0 : (index) -> i64 + ! CHECK: %[[index:.*]] = arith.subi %c7{{.*}}, %[[lb]] : i64 + ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[addr]], %[[index]] : (!fir.heap>, i64) -> !fir.ref + ! CHECK: fir.call @_QPtakes_real_scalar(%[[coor]]) : (!fir.ref) -> () + call takes_real_scalar(a1_0%p(7)) + + ! CHECK: %[[a1_1_coor:.*]] = fir.coordinate_of %[[arg3]], %{{.*}} : (!fir.ref>>}>>>, i64) -> !fir.ref>>}>> + ! CHECK: %[[fld:.*]] = fir.field_index p, !fir.type<_QMacompTreal_a1{p:!fir.box>>}> + ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[a1_1_coor]], %[[fld]] : (!fir.ref>>}>>, !fir.field) -> !fir.ref>>> + ! CHECK: %[[box:.*]] = fir.load %[[coor]] : !fir.ref>>> + ! CHECK-DAG: %[[addr:.*]] = fir.box_addr %[[box]] : (!fir.box>>) -> !fir.heap> + ! CHECK-DAG: %[[dims:.*]]:3 = fir.box_dims %[[box]], %c0{{.*}} : (!fir.box>>, index) -> (index, index, index) + ! CHECK: %[[lb:.*]] = fir.convert %[[dims]]#0 : (index) -> i64 + ! CHECK: %[[index:.*]] = arith.subi %c7{{.*}}, %[[lb]] : i64 + ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[addr]], %[[index]] : (!fir.heap>, i64) -> !fir.ref + ! CHECK: fir.call @_QPtakes_real_scalar(%[[coor]]) : (!fir.ref) -> () + call takes_real_scalar(a1_1(5)%p(7)) +end subroutine + +! CHECK-LABEL: func @_QMacompPref_array_real_a( +! CHECK-SAME: %[[VAL_0:.*]]: !fir.ref>>}>>{{.*}}, %[[VAL_1:.*]]: !fir.ref>>}>>>{{.*}}) { +! CHECK: %[[VAL_2:.*]] = fir.field_index p, !fir.type<_QMacompTreal_a1{p:!fir.box>>}> +! CHECK: %[[VAL_3:.*]] = fir.coordinate_of %[[VAL_0]], %[[VAL_2]] : (!fir.ref>>}>>, !fir.field) -> !fir.ref>>> +! CHECK: %[[VAL_4:.*]] = fir.load %[[VAL_3]] : !fir.ref>>> +! CHECK: %[[VAL_5:.*]] = arith.constant 0 : index +! CHECK: %[[VAL_6:.*]]:3 = fir.box_dims %[[VAL_4]], %[[VAL_5]] : (!fir.box>>, index) -> (index, index, index) +! CHECK: %[[VAL_7:.*]] = fir.box_addr %[[VAL_4]] : (!fir.box>>) -> !fir.heap> +! CHECK: %[[VAL_8:.*]] = arith.constant 20 : i64 +! CHECK: %[[VAL_9:.*]] = fir.convert %[[VAL_8]] : (i64) -> index +! CHECK: %[[VAL_10:.*]] = arith.constant 2 : i64 +! CHECK: %[[VAL_11:.*]] = fir.convert %[[VAL_10]] : (i64) -> index +! CHECK: %[[VAL_12:.*]] = arith.constant 50 : i64 +! CHECK: %[[VAL_13:.*]] = fir.convert %[[VAL_12]] : (i64) -> index +! CHECK: %[[VAL_14:.*]] = fir.shape_shift %[[VAL_6]]#0, %[[VAL_6]]#1 : (index, index) -> !fir.shapeshift<1> +! CHECK: %[[VAL_15:.*]] = fir.slice %[[VAL_9]], %[[VAL_13]], %[[VAL_11]] : (index, index, index) -> !fir.slice<1> +! CHECK: %[[VAL_16:.*]] = fir.embox %[[VAL_7]](%[[VAL_14]]) {{\[}}%[[VAL_15]]] : (!fir.heap>, !fir.shapeshift<1>, !fir.slice<1>) -> !fir.box> +! CHECK: fir.call @_QPtakes_real_array(%[[VAL_16]]) : (!fir.box>) -> () +! CHECK: %[[VAL_17:.*]] = arith.constant 5 : i64 +! CHECK: %[[VAL_18:.*]] = arith.constant 1 : i64 +! CHECK: %[[VAL_19:.*]] = arith.subi %[[VAL_17]], %[[VAL_18]] : i64 +! CHECK: %[[VAL_20:.*]] = fir.coordinate_of %[[VAL_1]], %[[VAL_19]] : (!fir.ref>>}>>>, i64) -> !fir.ref>>}>> +! CHECK: %[[VAL_21:.*]] = fir.field_index p, !fir.type<_QMacompTreal_a1{p:!fir.box>>}> +! CHECK: %[[VAL_22:.*]] = fir.coordinate_of %[[VAL_20]], %[[VAL_21]] : (!fir.ref>>}>>, !fir.field) -> !fir.ref>>> +! CHECK: %[[VAL_23:.*]] = fir.load %[[VAL_22]] : !fir.ref>>> +! CHECK: %[[VAL_24:.*]] = arith.constant 0 : index +! CHECK: %[[VAL_25:.*]]:3 = fir.box_dims %[[VAL_23]], %[[VAL_24]] : (!fir.box>>, index) -> (index, index, index) +! CHECK: %[[VAL_26:.*]] = fir.box_addr %[[VAL_23]] : (!fir.box>>) -> !fir.heap> +! CHECK: %[[VAL_27:.*]] = arith.constant 20 : i64 +! CHECK: %[[VAL_28:.*]] = fir.convert %[[VAL_27]] : (i64) -> index +! CHECK: %[[VAL_29:.*]] = arith.constant 2 : i64 +! CHECK: %[[VAL_30:.*]] = fir.convert %[[VAL_29]] : (i64) -> index +! CHECK: %[[VAL_31:.*]] = arith.constant 50 : i64 +! CHECK: %[[VAL_32:.*]] = fir.convert %[[VAL_31]] : (i64) -> index +! CHECK: %[[VAL_33:.*]] = fir.shape_shift %[[VAL_25]]#0, %[[VAL_25]]#1 : (index, index) -> !fir.shapeshift<1> +! CHECK: %[[VAL_34:.*]] = fir.slice %[[VAL_28]], %[[VAL_32]], %[[VAL_30]] : (index, index, index) -> !fir.slice<1> +! CHECK: %[[VAL_35:.*]] = fir.embox %[[VAL_26]](%[[VAL_33]]) {{\[}}%[[VAL_34]]] : (!fir.heap>, !fir.shapeshift<1>, !fir.slice<1>) -> !fir.box> +! CHECK: fir.call @_QPtakes_real_array(%[[VAL_35]]) : (!fir.box>) -> () +! CHECK: return +! CHECK: } + +subroutine ref_array_real_a(a1_0, a1_1) + type(real_a1) :: a1_0, a1_1(100) + call takes_real_array(a1_0%p(20:50:2)) + call takes_real_array(a1_1(5)%p(20:50:2)) +end subroutine + +! CHECK-LABEL: func @_QMacompPref_scalar_cst_char_a +! CHECK-SAME: (%[[a0_0:.*]]: {{.*}}, %[[a1_0:.*]]: {{.*}}, %[[a0_1:.*]]: {{.*}}, %[[a1_1:.*]]: {{.*}}) +subroutine ref_scalar_cst_char_a(a0_0, a1_0, a0_1, a1_1) + type(cst_char_a0) :: a0_0, a0_1(100) + type(cst_char_a1) :: a1_0, a1_1(100) + + ! CHECK: %[[fld:.*]] = fir.field_index p + ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[a0_0]], %[[fld]] + ! CHECK: %[[box:.*]] = fir.load %[[coor]] + ! CHECK: %[[addr:.*]] = fir.box_addr %[[box]] + ! CHECK: %[[cast:.*]] = fir.convert %[[addr]] + ! CHECK: %[[boxchar:.*]] = fir.emboxchar %[[cast]], %c10{{.*}} + ! CHECK: fir.call @_QPtakes_char_scalar(%[[boxchar]]) + call takes_char_scalar(a0_0%p) + + ! CHECK-DAG: %[[coor0:.*]] = fir.coordinate_of %[[a0_1]], %{{.*}} + ! CHECK-DAG: %[[fld:.*]] = fir.field_index p + ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[coor0]], %[[fld]] + ! CHECK: %[[box:.*]] = fir.load %[[coor]] + ! CHECK: %[[addr:.*]] = fir.box_addr %[[box]] + ! CHECK: %[[cast:.*]] = fir.convert %[[addr]] + ! CHECK: %[[boxchar:.*]] = fir.emboxchar %[[cast]], %c10{{.*}} + ! CHECK: fir.call @_QPtakes_char_scalar(%[[boxchar]]) + call takes_char_scalar(a0_1(5)%p) + + + ! CHECK-DAG: %[[fld:.*]] = fir.field_index p + ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[a1_0]], %[[fld]] + ! CHECK: %[[box:.*]] = fir.load %[[coor]] + ! CHECK-DAG: %[[base:.*]] = fir.box_addr %[[box]] + ! CHECK-DAG: %[[dims:.*]]:3 = fir.box_dims %[[box]], %c0{{.*}} + ! CHECK: %[[lb:.*]] = fir.convert %[[dims]]#0 : (index) -> i64 + ! CHECK: %[[index:.*]] = arith.subi %c7{{.*}}, %[[lb]] : i64 + ! CHECK: %[[addr:.*]] = fir.coordinate_of %[[base]], %[[index]] + ! CHECK: %[[cast:.*]] = fir.convert %[[addr]] + ! CHECK: %[[boxchar:.*]] = fir.emboxchar %[[cast]], %c10{{.*}} + ! CHECK: fir.call @_QPtakes_char_scalar(%[[boxchar]]) + call takes_char_scalar(a1_0%p(7)) + + + ! CHECK-DAG: %[[coor0:.*]] = fir.coordinate_of %[[a1_1]], %{{.*}} + ! CHECK-DAG: %[[fld:.*]] = fir.field_index p + ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[coor0]], %[[fld]] + ! CHECK: %[[box:.*]] = fir.load %[[coor]] + ! CHECK-DAG: %[[base:.*]] = fir.box_addr %[[box]] + ! CHECK-DAG: %[[dims:.*]]:3 = fir.box_dims %[[box]], %c0{{.*}} + ! CHECK: %[[lb:.*]] = fir.convert %[[dims]]#0 : (index) -> i64 + ! CHECK: %[[index:.*]] = arith.subi %c7{{.*}}, %[[lb]] : i64 + ! CHECK: %[[addr:.*]] = fir.coordinate_of %[[base]], %[[index]] + ! CHECK: %[[cast:.*]] = fir.convert %[[addr]] + ! CHECK: %[[boxchar:.*]] = fir.emboxchar %[[cast]], %c10{{.*}} + ! CHECK: fir.call @_QPtakes_char_scalar(%[[boxchar]]) + call takes_char_scalar(a1_1(5)%p(7)) + +end subroutine + +! CHECK-LABEL: func @_QMacompPref_scalar_def_char_a +! CHECK-SAME: (%[[a0_0:.*]]: {{.*}}, %[[a1_0:.*]]: {{.*}}, %[[a0_1:.*]]: {{.*}}, %[[a1_1:.*]]: {{.*}}) +subroutine ref_scalar_def_char_a(a0_0, a1_0, a0_1, a1_1) + type(def_char_a0) :: a0_0, a0_1(100) + type(def_char_a1) :: a1_0, a1_1(100) + + ! CHECK: %[[fld:.*]] = fir.field_index p + ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[a0_0]], %[[fld]] + ! CHECK: %[[box:.*]] = fir.load %[[coor]] + ! CHECK-DAG: %[[len:.*]] = fir.box_elesize %[[box]] + ! CHECK-DAG: %[[addr:.*]] = fir.box_addr %[[box]] + ! CHECK-DAG: %[[cast:.*]] = fir.convert %[[addr]] + ! CHECK: %[[boxchar:.*]] = fir.emboxchar %[[cast]], %[[len]] + ! CHECK: fir.call @_QPtakes_char_scalar(%[[boxchar]]) + call takes_char_scalar(a0_0%p) + + ! CHECK-DAG: %[[coor0:.*]] = fir.coordinate_of %[[a0_1]], %{{.*}} + ! CHECK-DAG: %[[fld:.*]] = fir.field_index p + ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[coor0]], %[[fld]] + ! CHECK: %[[box:.*]] = fir.load %[[coor]] + ! CHECK-DAG: %[[len:.*]] = fir.box_elesize %[[box]] + ! CHECK-DAG: %[[addr:.*]] = fir.box_addr %[[box]] + ! CHECK-DAG: %[[cast:.*]] = fir.convert %[[addr]] + ! CHECK: %[[boxchar:.*]] = fir.emboxchar %[[cast]], %[[len]] + ! CHECK: fir.call @_QPtakes_char_scalar(%[[boxchar]]) + call takes_char_scalar(a0_1(5)%p) + + + ! CHECK-DAG: %[[fld:.*]] = fir.field_index p + ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[a1_0]], %[[fld]] + ! CHECK: %[[box:.*]] = fir.load %[[coor]] + ! CHECK-DAG: %[[dims:.*]]:3 = fir.box_dims %[[box]], %c0{{.*}} + ! CHECK-DAG: %[[len:.*]] = fir.box_elesize %[[box]] + ! CHECK-DAG: %[[base:.*]] = fir.box_addr %[[box]] + ! CHECK: %[[cast:.*]] = fir.convert %[[base]] : (!fir.heap>>) -> !fir.ref>> + ! CHECK: %[[c7:.*]] = fir.convert %c7{{.*}} : (i64) -> index + ! CHECK: %[[sub:.*]] = arith.subi %[[c7]], %[[dims]]#0 : index + ! CHECK: %[[mul:.*]] = arith.muli %[[len]], %[[sub]] : index + ! CHECK: %[[offset:.*]] = arith.addi %[[mul]], %c0{{.*}} : index + ! CHECK: %[[cnvt:.*]] = fir.convert %[[cast]] + ! CHECK: %[[addr:.*]] = fir.coordinate_of %[[cnvt]], %[[offset]] + ! CHECK: %[[cnvt:.*]] = fir.convert %[[addr]] + ! CHECK: %[[boxchar:.*]] = fir.emboxchar %[[cnvt]], %[[len]] + ! CHECK: fir.call @_QPtakes_char_scalar(%[[boxchar]]) + call takes_char_scalar(a1_0%p(7)) + + + ! CHECK-DAG: %[[coor0:.*]] = fir.coordinate_of %[[a1_1]], %{{.*}} + ! CHECK-DAG: %[[fld:.*]] = fir.field_index p + ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[coor0]], %[[fld]] + ! CHECK: %[[box:.*]] = fir.load %[[coor]] + ! CHECK-DAG: %[[dims:.*]]:3 = fir.box_dims %[[box]], %c0{{.*}} + ! CHECK-DAG: %[[len:.*]] = fir.box_elesize %[[box]] + ! CHECK-DAG: %[[base:.*]] = fir.box_addr %[[box]] + ! CHECK: %[[cast:.*]] = fir.convert %[[base]] : (!fir.heap>>) -> !fir.ref>> + ! CHECK: %[[c7:.*]] = fir.convert %c7{{.*}} : (i64) -> index + ! CHECK: %[[sub:.*]] = arith.subi %[[c7]], %[[dims]]#0 : index + ! CHECK: %[[mul:.*]] = arith.muli %[[len]], %[[sub]] : index + ! CHECK: %[[offset:.*]] = arith.addi %[[mul]], %c0{{.*}} : index + ! CHECK: %[[cnvt:.*]] = fir.convert %[[cast]] + ! CHECK: %[[addr:.*]] = fir.coordinate_of %[[cnvt]], %[[offset]] + ! CHECK: %[[cnvt:.*]] = fir.convert %[[addr]] + ! CHECK: %[[boxchar:.*]] = fir.emboxchar %[[cnvt]], %[[len]] + ! CHECK: fir.call @_QPtakes_char_scalar(%[[boxchar]]) + call takes_char_scalar(a1_1(5)%p(7)) + +end subroutine + +! CHECK-LABEL: func @_QMacompPref_scalar_derived +! CHECK-SAME: (%[[a0_0:.*]]: {{.*}}, %[[a1_0:.*]]: {{.*}}, %[[a0_1:.*]]: {{.*}}, %[[a1_1:.*]]: {{.*}}) +subroutine ref_scalar_derived(a0_0, a1_0, a0_1, a1_1) + type(derived_a0) :: a0_0, a0_1(100) + type(derived_a1) :: a1_0, a1_1(100) + + ! CHECK: %[[fld:.*]] = fir.field_index p + ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[a0_0]], %[[fld]] + ! CHECK: %[[box:.*]] = fir.load %[[coor]] + ! CHECK: %[[fldx:.*]] = fir.field_index x + ! CHECK: %[[addr:.*]] = fir.coordinate_of %[[box]], %[[fldx]] + ! CHECK: fir.call @_QPtakes_real_scalar(%[[addr]]) + call takes_real_scalar(a0_0%p%x) + + ! CHECK-DAG: %[[coor0:.*]] = fir.coordinate_of %[[a0_1]], %{{.*}} + ! CHECK-DAG: %[[fld:.*]] = fir.field_index p + ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[coor0]], %[[fld]] + ! CHECK: %[[box:.*]] = fir.load %[[coor]] + ! CHECK: %[[fldx:.*]] = fir.field_index x + ! CHECK: %[[addr:.*]] = fir.coordinate_of %[[box]], %[[fldx]] + ! CHECK: fir.call @_QPtakes_real_scalar(%[[addr]]) + call takes_real_scalar(a0_1(5)%p%x) + + ! CHECK: %[[fld:.*]] = fir.field_index p + ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[a1_0]], %[[fld]] + ! CHECK: %[[box:.*]] = fir.load %[[coor]] + ! CHECK: %[[dims:.*]]:3 = fir.box_dims %[[box]], %c0{{.*}} + ! CHECK: %[[lb:.*]] = fir.convert %[[dims]]#0 : (index) -> i64 + ! CHECK: %[[index:.*]] = arith.subi %c7{{.*}}, %[[lb]] : i64 + ! CHECK: %[[elem:.*]] = fir.coordinate_of %[[box]], %[[index]] + ! CHECK: %[[fldx:.*]] = fir.field_index x + ! CHECK: %[[addr:.*]] = fir.coordinate_of %[[elem]], %[[fldx]] + ! CHECK: fir.call @_QPtakes_real_scalar(%[[addr]]) + call takes_real_scalar(a1_0%p(7)%x) + + ! CHECK-DAG: %[[coor0:.*]] = fir.coordinate_of %[[a1_1]], %{{.*}} + ! CHECK-DAG: %[[fld:.*]] = fir.field_index p + ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[coor0]], %[[fld]] + ! CHECK: %[[box:.*]] = fir.load %[[coor]] + ! CHECK: %[[dims:.*]]:3 = fir.box_dims %[[box]], %c0{{.*}} + ! CHECK: %[[lb:.*]] = fir.convert %[[dims]]#0 : (index) -> i64 + ! CHECK: %[[index:.*]] = arith.subi %c7{{.*}}, %[[lb]] : i64 + ! CHECK: %[[elem:.*]] = fir.coordinate_of %[[box]], %[[index]] + ! CHECK: %[[fldx:.*]] = fir.field_index x + ! CHECK: %[[addr:.*]] = fir.coordinate_of %[[elem]], %[[fldx]] + ! CHECK: fir.call @_QPtakes_real_scalar(%[[addr]]) + call takes_real_scalar(a1_1(5)%p(7)%x) + +end subroutine + +! ----------------------------------------------------------------------------- +! Test passing allocatable component references as allocatables +! ----------------------------------------------------------------------------- + +! CHECK-LABEL: func @_QMacompPpass_real_a +! CHECK-SAME: (%[[a0_0:.*]]: {{.*}}, %[[a1_0:.*]]: {{.*}}, %[[a0_1:.*]]: {{.*}}, %[[a1_1:.*]]: {{.*}}) +subroutine pass_real_a(a0_0, a1_0, a0_1, a1_1) + type(real_a0) :: a0_0, a0_1(100) + type(real_a1) :: a1_0, a1_1(100) + ! CHECK: %[[fld:.*]] = fir.field_index p + ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[a0_0]], %[[fld]] + ! CHECK: fir.call @_QPtakes_real_scalar_pointer(%[[coor]]) + call takes_real_scalar_pointer(a0_0%p) + + ! CHECK-DAG: %[[coor0:.*]] = fir.coordinate_of %[[a0_1]], %{{.*}} + ! CHECK-DAG: %[[fld:.*]] = fir.field_index p + ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[coor0]], %[[fld]] + ! CHECK: fir.call @_QPtakes_real_scalar_pointer(%[[coor]]) + call takes_real_scalar_pointer(a0_1(5)%p) + + ! CHECK: %[[fld:.*]] = fir.field_index p + ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[a1_0]], %[[fld]] + ! CHECK: fir.call @_QPtakes_real_array_pointer(%[[coor]]) + call takes_real_array_pointer(a1_0%p) + + ! CHECK-DAG: %[[coor0:.*]] = fir.coordinate_of %[[a1_1]], %{{.*}} + ! CHECK-DAG: %[[fld:.*]] = fir.field_index p + ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[coor0]], %[[fld]] + ! CHECK: fir.call @_QPtakes_real_array_pointer(%[[coor]]) + call takes_real_array_pointer(a1_1(5)%p) +end subroutine + +! ----------------------------------------------------------------------------- +! Test usage in intrinsics where pointer aspect matters +! ----------------------------------------------------------------------------- + +! CHECK-LABEL: func @_QMacompPallocated_p +! CHECK-SAME: (%[[a0_0:.*]]: {{.*}}, %[[a1_0:.*]]: {{.*}}, %[[a0_1:.*]]: {{.*}}, %[[a1_1:.*]]: {{.*}}) +subroutine allocated_p(a0_0, a1_0, a0_1, a1_1) + type(real_a0) :: a0_0, a0_1(100) + type(def_char_a1) :: a1_0, a1_1(100) + ! CHECK: %[[fld:.*]] = fir.field_index p + ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[a0_0]], %[[fld]] + ! CHECK: %[[box:.*]] = fir.load %[[coor]] + ! CHECK: fir.box_addr %[[box]] + call takes_logical(allocated(a0_0%p)) + + ! CHECK-DAG: %[[coor0:.*]] = fir.coordinate_of %[[a0_1]], %{{.*}} + ! CHECK-DAG: %[[fld:.*]] = fir.field_index p + ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[coor0]], %[[fld]] + ! CHECK: %[[box:.*]] = fir.load %[[coor]] + ! CHECK: fir.box_addr %[[box]] + call takes_logical(allocated(a0_1(5)%p)) + + ! CHECK: %[[fld:.*]] = fir.field_index p + ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[a1_0]], %[[fld]] + ! CHECK: %[[box:.*]] = fir.load %[[coor]] + ! CHECK: fir.box_addr %[[box]] + call takes_logical(allocated(a1_0%p)) + + ! CHECK-DAG: %[[coor0:.*]] = fir.coordinate_of %[[a1_1]], %{{.*}} + ! CHECK-DAG: %[[fld:.*]] = fir.field_index p + ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[coor0]], %[[fld]] + ! CHECK: %[[box:.*]] = fir.load %[[coor]] + ! CHECK: fir.box_addr %[[box]] + call takes_logical(allocated(a1_1(5)%p)) +end subroutine + +! ----------------------------------------------------------------------------- +! Test allocation +! ----------------------------------------------------------------------------- + +! CHECK-LABEL: func @_QMacompPallocate_real +! CHECK-SAME: (%[[a0_0:.*]]: {{.*}}, %[[a1_0:.*]]: {{.*}}, %[[a0_1:.*]]: {{.*}}, %[[a1_1:.*]]: {{.*}}) +subroutine allocate_real(a0_0, a1_0, a0_1, a1_1) + type(real_a0) :: a0_0, a0_1(100) + type(real_a1) :: a1_0, a1_1(100) + ! CHECK: %[[fld:.*]] = fir.field_index p + ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[a0_0]], %[[fld]] + ! CHECK: fir.store {{.*}} to %[[coor]] + allocate(a0_0%p) + + ! CHECK-DAG: %[[coor0:.*]] = fir.coordinate_of %[[a0_1]], %{{.*}} + ! CHECK-DAG: %[[fld:.*]] = fir.field_index p + ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[coor0]], %[[fld]] + ! CHECK: fir.store {{.*}} to %[[coor]] + allocate(a0_1(5)%p) + + ! CHECK: %[[fld:.*]] = fir.field_index p + ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[a1_0]], %[[fld]] + ! CHECK: fir.store {{.*}} to %[[coor]] + allocate(a1_0%p(100)) + + ! CHECK-DAG: %[[coor0:.*]] = fir.coordinate_of %[[a1_1]], %{{.*}} + ! CHECK-DAG: %[[fld:.*]] = fir.field_index p + ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[coor0]], %[[fld]] + ! CHECK: fir.store {{.*}} to %[[coor]] + allocate(a1_1(5)%p(100)) +end subroutine + +! CHECK-LABEL: func @_QMacompPallocate_cst_char +! CHECK-SAME: (%[[a0_0:.*]]: {{.*}}, %[[a1_0:.*]]: {{.*}}, %[[a0_1:.*]]: {{.*}}, %[[a1_1:.*]]: {{.*}}) +subroutine allocate_cst_char(a0_0, a1_0, a0_1, a1_1) + type(cst_char_a0) :: a0_0, a0_1(100) + type(cst_char_a1) :: a1_0, a1_1(100) + ! CHECK: %[[fld:.*]] = fir.field_index p + ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[a0_0]], %[[fld]] + ! CHECK: fir.store {{.*}} to %[[coor]] + allocate(a0_0%p) + + ! CHECK-DAG: %[[coor0:.*]] = fir.coordinate_of %[[a0_1]], %{{.*}} + ! CHECK-DAG: %[[fld:.*]] = fir.field_index p + ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[coor0]], %[[fld]] + ! CHECK: fir.store {{.*}} to %[[coor]] + allocate(a0_1(5)%p) + + ! CHECK: %[[fld:.*]] = fir.field_index p + ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[a1_0]], %[[fld]] + ! CHECK: fir.store {{.*}} to %[[coor]] + allocate(a1_0%p(100)) + + ! CHECK-DAG: %[[coor0:.*]] = fir.coordinate_of %[[a1_1]], %{{.*}} + ! CHECK-DAG: %[[fld:.*]] = fir.field_index p + ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[coor0]], %[[fld]] + ! CHECK: fir.store {{.*}} to %[[coor]] + allocate(a1_1(5)%p(100)) +end subroutine + +! CHECK-LABEL: func @_QMacompPallocate_def_char +! CHECK-SAME: (%[[a0_0:.*]]: {{.*}}, %[[a1_0:.*]]: {{.*}}, %[[a0_1:.*]]: {{.*}}, %[[a1_1:.*]]: {{.*}}) +subroutine allocate_def_char(a0_0, a1_0, a0_1, a1_1) + type(def_char_a0) :: a0_0, a0_1(100) + type(def_char_a1) :: a1_0, a1_1(100) + ! CHECK: %[[fld:.*]] = fir.field_index p + ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[a0_0]], %[[fld]] + ! CHECK: fir.store {{.*}} to %[[coor]] + allocate(character(18)::a0_0%p) + + ! CHECK-DAG: %[[coor0:.*]] = fir.coordinate_of %[[a0_1]], %{{.*}} + ! CHECK-DAG: %[[fld:.*]] = fir.field_index p + ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[coor0]], %[[fld]] + ! CHECK: fir.store {{.*}} to %[[coor]] + allocate(character(18)::a0_1(5)%p) + + ! CHECK: %[[fld:.*]] = fir.field_index p + ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[a1_0]], %[[fld]] + ! CHECK: fir.store {{.*}} to %[[coor]] + allocate(character(18)::a1_0%p(100)) + + ! CHECK-DAG: %[[coor0:.*]] = fir.coordinate_of %[[a1_1]], %{{.*}} + ! CHECK-DAG: %[[fld:.*]] = fir.field_index p + ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[coor0]], %[[fld]] + ! CHECK: fir.store {{.*}} to %[[coor]] + allocate(character(18)::a1_1(5)%p(100)) +end subroutine + +! ----------------------------------------------------------------------------- +! Test deallocation +! ----------------------------------------------------------------------------- + +! CHECK-LABEL: func @_QMacompPdeallocate_real +! CHECK-SAME: (%[[a0_0:.*]]: {{.*}}, %[[a1_0:.*]]: {{.*}}, %[[a0_1:.*]]: {{.*}}, %[[a1_1:.*]]: {{.*}}) +subroutine deallocate_real(a0_0, a1_0, a0_1, a1_1) + type(real_a0) :: a0_0, a0_1(100) + type(real_a1) :: a1_0, a1_1(100) + ! CHECK: %[[fld:.*]] = fir.field_index p + ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[a0_0]], %[[fld]] + ! CHECK: fir.store {{.*}} to %[[coor]] + deallocate(a0_0%p) + + ! CHECK-DAG: %[[coor0:.*]] = fir.coordinate_of %[[a0_1]], %{{.*}} + ! CHECK-DAG: %[[fld:.*]] = fir.field_index p + ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[coor0]], %[[fld]] + ! CHECK: fir.store {{.*}} to %[[coor]] + deallocate(a0_1(5)%p) + + ! CHECK: %[[fld:.*]] = fir.field_index p + ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[a1_0]], %[[fld]] + ! CHECK: fir.store {{.*}} to %[[coor]] + deallocate(a1_0%p) + + ! CHECK-DAG: %[[coor0:.*]] = fir.coordinate_of %[[a1_1]], %{{.*}} + ! CHECK-DAG: %[[fld:.*]] = fir.field_index p + ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[coor0]], %[[fld]] + ! CHECK: fir.store {{.*}} to %[[coor]] + deallocate(a1_1(5)%p) +end subroutine + +! ----------------------------------------------------------------------------- +! Test a recursive derived type reference +! ----------------------------------------------------------------------------- + +! CHECK: func @_QMacompPtest_recursive +! CHECK-SAME: (%[[x:.*]]: {{.*}}) +subroutine test_recursive(x) + type t + integer :: i + type(t), allocatable :: next + end type + type(t) :: x + + ! CHECK: %[[fldNext1:.*]] = fir.field_index next + ! CHECK: %[[next1:.*]] = fir.coordinate_of %[[x]], %[[fldNext1]] + ! CHECK: %[[nextBox1:.*]] = fir.load %[[next1]] + ! CHECK: %[[fldNext2:.*]] = fir.field_index next + ! CHECK: %[[next2:.*]] = fir.coordinate_of %[[nextBox1]], %[[fldNext2]] + ! CHECK: %[[nextBox2:.*]] = fir.load %[[next2]] + ! CHECK: %[[fldNext3:.*]] = fir.field_index next + ! CHECK: %[[next3:.*]] = fir.coordinate_of %[[nextBox2]], %[[fldNext3]] + ! CHECK: %[[nextBox3:.*]] = fir.load %[[next3]] + ! CHECK: %[[fldi:.*]] = fir.field_index i + ! CHECK: %[[i:.*]] = fir.coordinate_of %[[nextBox3]], %[[fldi]] + ! CHECK: %[[nextBox3:.*]] = fir.load %[[i]] : !fir.ref + print *, x%next%next%next%i +end subroutine + +end module diff --git a/flang/test/Lower/derived-assignments.f90 b/flang/test/Lower/derived-assignments.f90 new file mode 100644 --- /dev/null +++ b/flang/test/Lower/derived-assignments.f90 @@ -0,0 +1,228 @@ +! Test lowering of derived type assignments +! RUN: bbc -emit-fir %s -o - | FileCheck %s + +! Assignment of simple "struct" with trivial intrinsic members. +! CHECK-LABEL: func @_QPtest1 +subroutine test1 + type t + integer a + integer b + end type t + type(t) :: t1, t2 + ! CHECK-DAG: %[[VAL_0:.*]] = fir.alloca !fir.type<_QFtest1Tt{a:i32,b:i32}> {{{.*}}uniq_name = "_QFtest1Et1"} + ! CHECK-DAG: %[[VAL_1:.*]] = fir.alloca !fir.type<_QFtest1Tt{a:i32,b:i32}> {{{.*}}uniq_name = "_QFtest1Et2"} + ! CHECK: %[[VAL_2:.*]] = fir.field_index a, !fir.type<_QFtest1Tt{a:i32,b:i32}> + ! CHECK: %[[VAL_3:.*]] = fir.coordinate_of %[[VAL_1]], %[[VAL_2]] : (!fir.ref>, !fir.field) -> !fir.ref + ! CHECK: %[[VAL_4:.*]] = fir.coordinate_of %[[VAL_0]], %[[VAL_2]] : (!fir.ref>, !fir.field) -> !fir.ref + ! CHECK: %[[VAL_5:.*]] = fir.load %[[VAL_3]] : !fir.ref + ! CHECK: fir.store %[[VAL_5]] to %[[VAL_4]] : !fir.ref + ! CHECK: %[[VAL_6:.*]] = fir.field_index b, !fir.type<_QFtest1Tt{a:i32,b:i32}> + ! CHECK: %[[VAL_7:.*]] = fir.coordinate_of %[[VAL_1]], %[[VAL_6]] : (!fir.ref>, !fir.field) -> !fir.ref + ! CHECK: %[[VAL_8:.*]] = fir.coordinate_of %[[VAL_0]], %[[VAL_6]] : (!fir.ref>, !fir.field) -> !fir.ref + ! CHECK: %[[VAL_9:.*]] = fir.load %[[VAL_7]] : !fir.ref + ! CHECK: fir.store %[[VAL_9]] to %[[VAL_8]] : !fir.ref + t1 = t2 +end subroutine test1 + +! Test a defined assignment on a simple struct. +module m2 + type t + integer a + integer b + end type t + interface assignment (=) + module procedure t_to_t + end interface assignment (=) +contains + ! CHECK-LABEL: func @_QMm2Ptest2 + subroutine test2 + type(t) :: t1, t2 + ! CHECK: fir.call @_QMm2Pt_to_t(%{{.*}}, %{{.*}}) : (!fir.ref>, !fir.ref>) -> () + t1 = t2 + ! CHECK: return + end subroutine test2 + + ! Swap elements on assignment. + ! CHECK-LABEL: func @_QMm2Pt_to_t( + ! CHECK-SAME: %[[a1:[^:]*]]: !fir.ref>{{.*}}, %[[b1:[^:]*]]: !fir.ref>{{.*}}) { + subroutine t_to_t(a1,b1) + type(t), intent(out) :: a1 + type(t), intent(in) :: b1 + ! CHECK: %[[b:.*]] = fir.field_index b, !fir.type<_QMm2Tt{a:i32,b:i32}> + ! CHECK: %[[b1b:.*]] = fir.coordinate_of %[[b1]], %[[b]] : (!fir.ref>, !fir.field) -> !fir.ref + ! CHECK: %[[v:.*]] = fir.load %[[b1b]] : !fir.ref + ! CHECK: %[[a:.*]] = fir.field_index a, !fir.type<_QMm2Tt{a:i32,b:i32}> + ! CHECK: %[[a1a:.*]] = fir.coordinate_of %[[a1]], %[[a]] : (!fir.ref>, !fir.field) -> !fir.ref + ! CHECK: fir.store %[[v]] to %[[a1a]] : !fir.ref + ! CHECK: %[[a:.*]] = fir.field_index a, !fir.type<_QMm2Tt{a:i32,b:i32}> + ! CHECK: %[[b1a:.*]] = fir.coordinate_of %[[b1]], %[[a]] : (!fir.ref>, !fir.field) -> !fir.ref + ! CHECK: %[[v:.*]] = fir.load %[[b1a]] : !fir.ref + ! CHECK: %[[b:.*]] = fir.field_index b, !fir.type<_QMm2Tt{a:i32,b:i32}> + ! CHECK: %[[a1b:.*]] = fir.coordinate_of %[[a1]], %[[b]] : (!fir.ref>, !fir.field) -> !fir.ref + ! CHECK: fir.store %[[v]] to %[[a1b]] : !fir.ref + a1%a = b1%b + a1%b = b1%a + ! CHECK: return + end subroutine t_to_t +end module m2 + +! CHECK-LABEL: func @_QPtest3 +subroutine test3 + type t + character(LEN=20) :: m_c + integer :: m_i + end type t + type(t) :: t1, t2 + ! CHECK-DAG: %[[VAL_0:.*]] = fir.alloca !fir.type<_QFtest3Tt{m_c:!fir.char<1,20>,m_i:i32}> {{{.*}}uniq_name = "_QFtest3Et1"} + ! CHECK-DAG: %[[VAL_1:.*]] = fir.alloca !fir.type<_QFtest3Tt{m_c:!fir.char<1,20>,m_i:i32}> {{{.*}}uniq_name = "_QFtest3Et2"} + ! CHECK: %[[VAL_2:.*]] = fir.field_index m_c, !fir.type<_QFtest3Tt{m_c:!fir.char<1,20>,m_i:i32}> + ! CHECK: %[[VAL_3:.*]] = fir.coordinate_of %[[VAL_1]], %[[VAL_2]] : (!fir.ref,m_i:i32}>>, !fir.field) -> !fir.ref> + ! CHECK: %[[VAL_4:.*]] = fir.coordinate_of %[[VAL_0]], %[[VAL_2]] : (!fir.ref,m_i:i32}>>, !fir.field) -> !fir.ref> + ! CHECK: %[[VAL_5:.*]] = arith.constant 20 : index + ! CHECK: %[[VAL_6:.*]] = arith.constant 1 : i64 + ! CHECK: %[[VAL_7:.*]] = fir.convert %[[VAL_5]] : (index) -> i64 + ! CHECK: %[[VAL_8:.*]] = arith.muli %[[VAL_6]], %[[VAL_7]] : i64 + ! CHECK: %[[VAL_9:.*]] = arith.constant false + ! CHECK: %[[VAL_10:.*]] = fir.convert %[[VAL_4]] : (!fir.ref>) -> !fir.ref + ! CHECK: %[[VAL_11:.*]] = fir.convert %[[VAL_3]] : (!fir.ref>) -> !fir.ref + ! CHECK: fir.call @llvm.memmove.p0i8.p0i8.i64(%[[VAL_10]], %[[VAL_11]], %[[VAL_8]], %[[VAL_9]]) : (!fir.ref, !fir.ref, i64, i1) -> () + ! CHECK: %[[VAL_12:.*]] = fir.field_index m_i, !fir.type<_QFtest3Tt{m_c:!fir.char<1,20>,m_i:i32}> + ! CHECK: %[[VAL_13:.*]] = fir.coordinate_of %[[VAL_1]], %[[VAL_12]] : (!fir.ref,m_i:i32}>>, !fir.field) -> !fir.ref + ! CHECK: %[[VAL_14:.*]] = fir.coordinate_of %[[VAL_0]], %[[VAL_12]] : (!fir.ref,m_i:i32}>>, !fir.field) -> !fir.ref + ! CHECK: %[[VAL_15:.*]] = fir.load %[[VAL_13]] : !fir.ref + ! CHECK: fir.store %[[VAL_15]] to %[[VAL_14]] : !fir.ref + t1 = t2 + ! CHECK: return +end subroutine test3 + +! CHECK-LABEL: func @_QPtest_array_comp( +! CHECK-SAME: %[[VAL_0:.*]]: !fir.ref,m_i:i32}>>{{.*}}, %[[VAL_1:.*]]: !fir.ref,m_i:i32}>>{{.*}}) { +subroutine test_array_comp(t1, t2) + type t + real :: m_x(10) + integer :: m_i + end type t + type(t) :: t1, t2 + + ! CHECK: %[[VAL_2:.*]] = fir.field_index m_x, !fir.type<_QFtest_array_compTt{m_x:!fir.array<10xf32>,m_i:i32}> + ! CHECK: %[[VAL_3:.*]] = fir.coordinate_of %[[VAL_1]], %[[VAL_2]] : (!fir.ref,m_i:i32}>>, !fir.field) -> !fir.ref> + ! CHECK: %[[VAL_4:.*]] = fir.coordinate_of %[[VAL_0]], %[[VAL_2]] : (!fir.ref,m_i:i32}>>, !fir.field) -> !fir.ref> + ! CHECK: %[[VAL_5:.*]] = arith.constant 0 : index + ! CHECK: %[[VAL_6:.*]] = arith.constant 1 : index + ! CHECK: %[[VAL_7:.*]] = arith.constant 9 : index + ! CHECK: fir.do_loop %[[VAL_8:.*]] = %[[VAL_5]] to %[[VAL_7]] step %[[VAL_6]] { + ! CHECK: %[[VAL_9:.*]] = fir.coordinate_of %[[VAL_4]], %[[VAL_8]] : (!fir.ref>, index) -> !fir.ref + ! CHECK: %[[VAL_10:.*]] = fir.coordinate_of %[[VAL_3]], %[[VAL_8]] : (!fir.ref>, index) -> !fir.ref + ! CHECK: %[[VAL_11:.*]] = fir.load %[[VAL_10]] : !fir.ref + ! CHECK: fir.store %[[VAL_11]] to %[[VAL_9]] : !fir.ref + ! CHECK: } + ! CHECK: %[[VAL_12:.*]] = fir.field_index m_i, !fir.type<_QFtest_array_compTt{m_x:!fir.array<10xf32>,m_i:i32}> + ! CHECK: %[[VAL_13:.*]] = fir.coordinate_of %[[VAL_1]], %[[VAL_12]] : (!fir.ref,m_i:i32}>>, !fir.field) -> !fir.ref + ! CHECK: %[[VAL_14:.*]] = fir.coordinate_of %[[VAL_0]], %[[VAL_12]] : (!fir.ref,m_i:i32}>>, !fir.field) -> !fir.ref + ! CHECK: %[[VAL_15:.*]] = fir.load %[[VAL_13]] : !fir.ref + ! CHECK: fir.store %[[VAL_15]] to %[[VAL_14]] : !fir.ref + t1 = t2 +end subroutine + +! CHECK-LABEL: func @_QPtest_ptr_comp( +! CHECK-SAME: %[[VAL_0:.*]]: !fir.ref>>>,m_i:i32}>>{{.*}}, %[[VAL_1]]: !fir.ref>>>,m_i:i32}>>{{.*}}) { +subroutine test_ptr_comp(t1, t2) + type t + complex, pointer :: ptr(:) + integer :: m_i + end type t + type(t) :: t1, t2 + + ! CHECK: %[[VAL_2:.*]] = fir.field_index ptr, !fir.type<_QFtest_ptr_compTt{ptr:!fir.box>>>,m_i:i32}> + ! CHECK: %[[VAL_3:.*]] = fir.coordinate_of %[[VAL_1]], %[[VAL_2]] : (!fir.ref>>>,m_i:i32}>>, !fir.field) -> !fir.ref>>>> + ! CHECK: %[[VAL_4:.*]] = fir.coordinate_of %[[VAL_0]], %[[VAL_2]] : (!fir.ref>>>,m_i:i32}>>, !fir.field) -> !fir.ref>>>> + ! CHECK: %[[VAL_5:.*]] = fir.load %[[VAL_3]] : !fir.ref>>>> + ! CHECK: fir.store %[[VAL_5]] to %[[VAL_4]] : !fir.ref>>>> + ! CHECK: %[[VAL_6:.*]] = fir.field_index m_i, !fir.type<_QFtest_ptr_compTt{ptr:!fir.box>>>,m_i:i32}> + ! CHECK: %[[VAL_7:.*]] = fir.coordinate_of %[[VAL_1]], %[[VAL_6]] : (!fir.ref>>>,m_i:i32}>>, !fir.field) -> !fir.ref + ! CHECK: %[[VAL_8:.*]] = fir.coordinate_of %[[VAL_0]], %[[VAL_6]] : (!fir.ref>>>,m_i:i32}>>, !fir.field) -> !fir.ref + ! CHECK: %[[VAL_9:.*]] = fir.load %[[VAL_7]] : !fir.ref + ! CHECK: fir.store %[[VAL_9]] to %[[VAL_8]] : !fir.ref + t1 = t2 +end subroutine + +! CHECK-LABEL: func @_QPtest_box_assign( +! CHECK-SAME: %[[t1:.*]]: !fir.ref>>>{{.*}}, %[[t2:.*]]: !fir.ref>>>{{.*}}) { +subroutine test_box_assign(t1, t2) + type t + integer :: i + end type t + ! Note: the implementation of this case is not optimal, the runtime call is overkill, but right now + ! lowering is conservative with derived type pointers because it does not make a difference between the + ! polymorphic and non polymorphic ones at the FIR level. + type(t), pointer :: t1, t2 + ! CHECK: %[[tmpBox:.*]] = fir.alloca !fir.box>> + ! CHECK: %[[t2Load:.*]] = fir.load %[[t2]] : !fir.ref>>> + ! CHECK: %[[t1Load:.*]] = fir.load %[[t1]] : !fir.ref>>> + ! CHECK: fir.store %[[t1Load]] to %[[tmpBox]] : !fir.ref>>> + ! CHECK: %[[lhs:.*]] = fir.convert %[[tmpBox]] : (!fir.ref>>>) -> !fir.ref> + ! CHECK: %[[rhs:.*]] = fir.convert %[[t2Load]] : (!fir.box>>) -> !fir.box + ! CHECK: fir.call @_FortranAAssign(%[[lhs]], %[[rhs]], %{{.*}}, %{{.*}}) : (!fir.ref>, !fir.box, !fir.ref, i32) -> none + t1 = t2 +end subroutine + +! CHECK-LABEL: func @_QPtest_alloc_comp( +! CHECK-SAME: %[[t1:.*]]: !fir.ref>>,i:i32}>>{{.*}}, %[[t2:.*]]: !fir.ref>>,i:i32}>>{{.*}}) { +subroutine test_alloc_comp(t1, t2) +! Test that derived type assignment with allocatable components are using the +! runtime to handle the deep copy. + type t + real, allocatable :: x(:, :) + integer :: i + end type + type(t) :: t1, t2 + ! CHECK: %[[tmpBox:.*]] = fir.alloca !fir.box> + ! CHECK: %[[t1Box:.*]] = fir.embox %[[t1]] : (!fir.ref>) -> !fir.box> + ! CHECK: %[[t2Box:.*]] = fir.embox %[[t2]] : (!fir.ref>) -> !fir.box> + ! CHECK: fir.store %[[t1Box]] to %[[tmpBox]] : !fir.ref>> + ! CHECK: %[[lhs:.*]] = fir.convert %[[tmpBox]] : (!fir.ref>>) -> !fir.ref> + ! CHECK: %[[rhs:.*]] = fir.convert %[[t2Box]] : (!fir.box>) -> !fir.box + ! CHECK: fir.call @_FortranAAssign(%[[lhs]], %[[rhs]], %{{.*}}, %{{.*}}) : (!fir.ref>, !fir.box, !fir.ref, i32) -> none + t1 = t2 +end subroutine + +! Reinstate this test when polymorphic types are more fully supported. +! +!module component_with_user_def_assign +! type t0 +! integer :: i +! integer :: j +! contains +! procedure :: user_def +! generic :: assignment(=) => user_def +! end type +! interface +! subroutine user_def(other, self) +! import t0 +! class(t0), intent(out) :: other +! class(t0), intent(in) :: self +! end subroutine +! end interface + +! ! Assignments of type(t) must call the user defined assignment for component a. +! ! Currently this is delegated to the runtime. +! type t +! type(t0) :: a +! integer :: i +! end type + +!contains +! ! cHECK-LABEL: func @_QMcomponent_with_user_def_assignPtest( +! ! cHECK-SAME: %[[t1:.*]]: !fir.ref,i:i32}>>{{.*}}, %[[t2:.*]]: !fir.ref,i:i32}>>{{.*}}) { +! subroutine test(t1, t2) +! type(t) :: t1, t2 +! ! cHECK: %[[tmpBox:.*]] = fir.alloca !fir.box> +! ! cHECK: %[[t1Box:.*]] = fir.embox %[[t1]] : (!fir.ref>) -> !fir.box> +! ! cHECK: %[[t2Box:.*]] = fir.embox %[[t2]] : (!fir.ref>) -> !fir.box> +! ! cHECK: fir.store %[[t1Box]] to %[[tmpBox]] : !fir.ref>> +! ! cHECK: %[[lhs:.*]] = fir.convert %[[tmpBox]] : (!fir.ref>>) -> !fir.ref> +! ! cHECK: %[[rhs:.*]] = fir.convert %[[t2Box]] : (!fir.box>) -> !fir.box +! ! cHECK: fir.call @_FortranAAssign(%[[lhs]], %[[rhs]], %{{.*}}, %{{.*}}) : (!fir.ref>, !fir.box, !fir.ref, i32) -> none +! t1 = t2 +! end subroutine +!end module diff --git a/flang/test/Lower/derived-type-descriptor.f90 b/flang/test/Lower/derived-type-descriptor.f90 new file mode 100644 --- /dev/null +++ b/flang/test/Lower/derived-type-descriptor.f90 @@ -0,0 +1,54 @@ +! Test lowering of derived type descriptors builtin data +! RUN: bbc -emit-fir %s -o - | FileCheck %s + +subroutine foo() + real, save, target :: init_values(10, 10) + type sometype + integer :: num = 42 + real, pointer :: values(:, :) => init_values + end type + type(sometype), allocatable, save :: x(:) +end subroutine + +! CHECK-LABEL: fir.global linkonce_odr @_QFfooE.n.num constant : !fir.char<1,3> { +! CHECK: %[[res:.*]] = fir.string_lit "num"(3) : !fir.char<1,3> +! CHECK: fir.has_value %[[res]] : !fir.char<1,3> +! CHECK-LABEL: fir.global linkonce_odr @_QFfooE.di.sometype.num constant : i32 +! CHECK-LABEL: fir.global linkonce_odr @_QFfooE.n.values constant : !fir.char<1,6> { +! CHECK: %[[res:.*]] = fir.string_lit "values"(6) : !fir.char<1,6> +! CHECK: fir.has_value %[[res]] : !fir.char<1,6> +! CHECK-LABEL: fir.global linkonce_odr @_QFfooE.n.sometype constant : !fir.char<1,8> { +! CHECK: %[[res:.*]] = fir.string_lit "sometype"(8) : !fir.char<1,8> +! CHECK: fir.has_value %[[res]] : !fir.char<1,8> + +! CHECK-LABEL: fir.global linkonce_odr @_QFfooE.di.sometype.values constant : !fir.type<_QFfooT.dp.sometype.values{values:!fir.box>>}> { + ! CHECK: fir.address_of(@_QFfooEinit_values) +! CHECK: } + +! CHECK-LABEL: fir.global linkonce_odr @_QFfooE.dt.sometype constant {{.*}} { + !CHECK: fir.address_of(@_QFfooE.n.sometype) + !CHECK: fir.address_of(@_QFfooE.c.sometype) +! CHECK:} + +! CHECK-LABEL: fir.global linkonce_odr @_QFfooE.c.sometype constant {{.*}} { + ! CHECK: fir.address_of(@_QFfooE.n.num) + ! CHECK: fir.address_of(@_QFfooE.di.sometype.num) : !fir.ref + ! CHECK: fir.address_of(@_QFfooE.n.values) + ! CHECK: fir.address_of(@_QFfooE.di.sometype.values) +! CHECK: } + +subroutine char_comp_init() + implicit none + type t + character(8) :: name='Empty' + end type t + type(t) :: a +end subroutine + +! CHECK-LABEL: fir.global linkonce_odr @_QFchar_comp_initE.di.t.name constant : !fir.char<1,8> { +! CHECK: %[[res:.*]] = fir.string_lit "Empty "(8) : !fir.char<1,8> +! CHECK: fir.has_value %[[res]] : !fir.char<1,8> + +! CHECK-LABEL: fir.global linkonce_odr @_QFchar_comp_initE.c.t constant : {{.*}} { + ! CHECK: fir.address_of(@_QFchar_comp_initE.di.t.name) : !fir.ref> +! CHECK: }