1! Test lowering of structure constructors of derived types with allocatable component 2! RUN: bbc -emit-hlfir %s -o - | FileCheck --check-prefixes=HLFIR %s 3 4module m_struct_ctor 5 implicit none 6 7 type t_alloc 8 real :: x 9 integer, allocatable :: a(:) 10 end type 11 12 type t_alloc_char 13 character(:), allocatable :: a 14 end type 15 16 type t_alloc_char_cst_len 17 character(2), allocatable :: a 18 end type 19 20contains 21 subroutine test_alloc1(y) 22 real :: y 23 call print_alloc_comp(t_alloc(x=y, a=null())) 24! HLFIR-LABEL: func.func @_QMm_struct_ctorPtest_alloc1( 25! HLFIR-SAME: %[[ARG_0:.*]]: !fir.ref<f32> {fir.bindc_name = "y"}) { 26! HLFIR: %[[VAL_0:.*]] = fir.alloca !fir.type<_QMm_struct_ctorTt_alloc{x:f32,a:!fir.box<!fir.heap<!fir.array<?xi32>>>}> 27! HLFIR: %[[VAL_12:.*]]:2 = hlfir.declare %[[ARG_0]] dummy_scope %{{[0-9]+}} {uniq_name = "_QMm_struct_ctorFtest_alloc1Ey"} : (!fir.ref<f32>, !fir.dscope) -> (!fir.ref<f32>, !fir.ref<f32>) 28! HLFIR: %[[VAL_13:.*]]:2 = hlfir.declare %[[VAL_0]] {uniq_name = "ctor.temp"} : (!fir.ref<!fir.type<_QMm_struct_ctorTt_alloc{x:f32,a:!fir.box<!fir.heap<!fir.array<?xi32>>>}>>) -> (!fir.ref<!fir.type<_QMm_struct_ctorTt_alloc{x:f32,a:!fir.box<!fir.heap<!fir.array<?xi32>>>}>>, !fir.ref<!fir.type<_QMm_struct_ctorTt_alloc{x:f32,a:!fir.box<!fir.heap<!fir.array<?xi32>>>}>>) 29! HLFIR: %[[VAL_14:.*]] = fir.embox %[[VAL_13]]#0 : (!fir.ref<!fir.type<_QMm_struct_ctorTt_alloc{x:f32,a:!fir.box<!fir.heap<!fir.array<?xi32>>>}>>) -> !fir.box<!fir.type<_QMm_struct_ctorTt_alloc{x:f32,a:!fir.box<!fir.heap<!fir.array<?xi32>>>}>> 30! HLFIR: %[[VAL_15:.*]] = fir.address_of(@_QQ{{.*}}) : !fir.ref<!fir.char<1,{{.*}}>> 31! HLFIR: %[[CONS_6:.*]] = arith.constant {{.*}} : i32 32! HLFIR: %[[VAL_16:.*]] = fir.convert %[[VAL_14]] : (!fir.box<!fir.type<_QMm_struct_ctorTt_alloc{x:f32,a:!fir.box<!fir.heap<!fir.array<?xi32>>>}>>) -> !fir.box<none> 33! HLFIR: %[[VAL_17:.*]] = fir.convert %[[VAL_15]] : (!fir.ref<!fir.char<1,{{.*}}>>) -> !fir.ref<i8> 34! HLFIR: fir.call @_FortranAInitialize(%[[VAL_16]], %[[VAL_17]], %[[CONS_6]]) fastmath<contract> : (!fir.box<none>, !fir.ref<i8>, i32) -> () 35! HLFIR: %[[VAL_18:.*]] = hlfir.designate %[[VAL_13]]#0{"x"} : (!fir.ref<!fir.type<_QMm_struct_ctorTt_alloc{x:f32,a:!fir.box<!fir.heap<!fir.array<?xi32>>>}>>) -> !fir.ref<f32> 36! HLFIR: %[[VAL_19:.*]] = fir.load %[[VAL_12]]#0 : !fir.ref<f32> 37! HLFIR: hlfir.assign %[[VAL_19]] to %[[VAL_18]] temporary_lhs : f32, !fir.ref<f32> 38! HLFIR: fir.call @_QPprint_alloc_comp(%[[VAL_13]]#1) fastmath<contract> : (!fir.ref<!fir.type<_QMm_struct_ctorTt_alloc{x:f32,a:!fir.box<!fir.heap<!fir.array<?xi32>>>}>>) -> () 39! HLFIR: return 40! HLFIR: } 41 end subroutine 42 43 subroutine test_alloc2(y, b) 44 real :: y 45 integer :: b(5) 46 call print_alloc_comp(t_alloc(x=y, a=b)) 47! HLFIR-LABEL: func.func @_QMm_struct_ctorPtest_alloc2 48! HLFIR-SAME: (%[[ARG_0:.*]]: !fir.ref<f32> {fir.bindc_name = "y"}, %[[ARG_1:.*]]: !fir.ref<!fir.array<5xi32>> {fir.bindc_name = "b"}) { 49! HLFIR: %[[VAL_0:.*]] = fir.alloca !fir.type<_QMm_struct_ctorTt_alloc{x:f32,a:!fir.box<!fir.heap<!fir.array<?xi32>>>}> 50! HLFIR: %[[CONS_6:.*]] = arith.constant 5 : index 51! HLFIR: %[[VAL_12:.*]] = fir.shape %[[CONS_6]] : (index) -> !fir.shape<1> 52! HLFIR: %[[VAL_13:.*]]:2 = hlfir.declare %[[ARG_1]](%[[VAL_12]]) dummy_scope %{{[0-9]+}} {uniq_name = "_QMm_struct_ctorFtest_alloc2Eb"} : (!fir.ref<!fir.array<5xi32>>, !fir.shape<1>, !fir.dscope) -> (!fir.ref<!fir.array<5xi32>>, !fir.ref<!fir.array<5xi32>>) 53! HLFIR: %[[VAL_14:.*]]:2 = hlfir.declare %[[ARG_0]] dummy_scope %{{[0-9]+}} {uniq_name = "_QMm_struct_ctorFtest_alloc2Ey"} : (!fir.ref<f32>, !fir.dscope) -> (!fir.ref<f32>, !fir.ref<f32>) 54! HLFIR: %[[VAL_15:.*]]:2 = hlfir.declare %[[VAL_0]] {uniq_name = "ctor.temp"} : (!fir.ref<!fir.type<_QMm_struct_ctorTt_alloc{x:f32,a:!fir.box<!fir.heap<!fir.array<?xi32>>>}>>) -> (!fir.ref<!fir.type<_QMm_struct_ctorTt_alloc{x:f32,a:!fir.box<!fir.heap<!fir.array<?xi32>>>}>>, !fir.ref<!fir.type<_QMm_struct_ctorTt_alloc{x:f32,a:!fir.box<!fir.heap<!fir.array<?xi32>>>}>>) 55! HLFIR: %[[VAL_16:.*]] = fir.embox %[[VAL_15]]#0 : (!fir.ref<!fir.type<_QMm_struct_ctorTt_alloc{x:f32,a:!fir.box<!fir.heap<!fir.array<?xi32>>>}>>) -> !fir.box<!fir.type<_QMm_struct_ctorTt_alloc{x:f32,a:!fir.box<!fir.heap<!fir.array<?xi32>>>}>> 56! HLFIR: %[[VAL_17:.*]] = fir.address_of(@_QQ{{.*}}) : !fir.ref<!fir.char<1,{{.*}}>> 57! HLFIR: %[[CONS_7:.*]] = arith.constant {{.*}} : i32 58! HLFIR: %[[VAL_18:.*]] = fir.convert %[[VAL_16]] : (!fir.box<!fir.type<_QMm_struct_ctorTt_alloc{x:f32,a:!fir.box<!fir.heap<!fir.array<?xi32>>>}>>) -> !fir.box<none> 59! HLFIR: %[[VAL_19:.*]] = fir.convert %[[VAL_17]] : (!fir.ref<!fir.char<1,{{.*}}>>) -> !fir.ref<i8> 60! HLFIR: fir.call @_FortranAInitialize(%[[VAL_18]], %[[VAL_19]], %[[CONS_7]]) fastmath<contract> : (!fir.box<none>, !fir.ref<i8>, i32) -> () 61! HLFIR: %[[VAL_20:.*]] = hlfir.designate %[[VAL_15]]#0{"x"} : (!fir.ref<!fir.type<_QMm_struct_ctorTt_alloc{x:f32,a:!fir.box<!fir.heap<!fir.array<?xi32>>>}>>) -> !fir.ref<f32> 62! HLFIR: %[[VAL_21:.*]] = fir.load %[[VAL_14]]#0 : !fir.ref<f32> 63! HLFIR: hlfir.assign %[[VAL_21]] to %[[VAL_20]] temporary_lhs : f32, !fir.ref<f32> 64! HLFIR: %[[VAL_22:.*]] = hlfir.designate %[[VAL_15]]#0{"a"} {fortran_attrs = #fir.var_attrs<allocatable>} : (!fir.ref<!fir.type<_QMm_struct_ctorTt_alloc{x:f32,a:!fir.box<!fir.heap<!fir.array<?xi32>>>}>>) -> !fir.ref<!fir.box<!fir.heap<!fir.array<?xi32>>>> 65! HLFIR: hlfir.assign %[[VAL_13]]#0 to %[[VAL_22]] realloc temporary_lhs : !fir.ref<!fir.array<5xi32>>, !fir.ref<!fir.box<!fir.heap<!fir.array<?xi32>>>> 66! HLFIR: fir.call @_QPprint_alloc_comp(%[[VAL_15]]#1) fastmath<contract> : (!fir.ref<!fir.type<_QMm_struct_ctorTt_alloc{x:f32,a:!fir.box<!fir.heap<!fir.array<?xi32>>>}>>) -> () 67! HLFIR: return 68! HLFIR: } 69 end subroutine 70 71 subroutine test_alloc3() 72 type(t_alloc) :: t1 = t_alloc(x=5, a=null()) 73! HLFIR-LABEL: func.func @_QMm_struct_ctorPtest_alloc3() { 74! HLFIR: %[[VAL_11:.*]] = fir.address_of(@_QMm_struct_ctorFtest_alloc3Et1) : !fir.ref<!fir.type<_QMm_struct_ctorTt_alloc{x:f32,a:!fir.box<!fir.heap<!fir.array<?xi32>>>}>> 75! HLFIR: {{.*}}:2 = hlfir.declare %[[VAL_11]] {uniq_name = "_QMm_struct_ctorFtest_alloc3Et1"} 76! HLFIR: return 77! HLFIR: } 78 end subroutine 79 80 subroutine test_alloc4() 81 integer, pointer :: p(:) 82 type(t_alloc) :: t1 = t_alloc(x=5, a=null(p)) 83! HLFIR-LABEL: func.func @_QMm_struct_ctorPtest_alloc4() { 84! HLFIR: %[[VAL_11:.*]] = fir.alloca !fir.box<!fir.ptr<!fir.array<?xi32>>> {bindc_name = "p", uniq_name = "_QMm_struct_ctorFtest_alloc4Ep"} 85! HLFIR: %[[VAL_12:.*]] = fir.zero_bits !fir.ptr<!fir.array<?xi32>> 86! HLFIR: %[[CONS_6:.*]] = arith.constant 0 : index 87! HLFIR: %[[VAL_13:.*]] = fir.shape %[[CONS_6]] : (index) -> !fir.shape<1> 88! HLFIR: %[[VAL_14:.*]] = fir.embox %[[VAL_12]](%[[VAL_13]]) : (!fir.ptr<!fir.array<?xi32>>, !fir.shape<1>) -> !fir.box<!fir.ptr<!fir.array<?xi32>>> 89! HLFIR: fir.store %[[VAL_14]] to %[[VAL_11]] : !fir.ref<!fir.box<!fir.ptr<!fir.array<?xi32>>>> 90! HLFIR: %[[VAL_15:.*]]:2 = hlfir.declare %[[VAL_11]] {fortran_attrs = #fir.var_attrs<pointer>, uniq_name = "_QMm_struct_ctorFtest_alloc4Ep"} 91! HLFIR: %[[VAL_16:.*]] = fir.address_of(@_QMm_struct_ctorFtest_alloc4Et1) : !fir.ref<!fir.type<_QMm_struct_ctorTt_alloc{x:f32,a:!fir.box<!fir.heap<!fir.array<?xi32>>>}>> 92! HLFIR: %[[VAL_17:.*]]:2 = hlfir.declare %[[VAL_16]] {uniq_name = "_QMm_struct_ctorFtest_alloc4Et1"} 93! HLFIR: return 94! HLFIR: } 95 end subroutine 96 97end module m_struct_ctor 98 99subroutine test_character_1() 100 use m_struct_ctor, only : t_alloc_char 101 interface 102 subroutine takes_ta_alloc_char(x) 103 import t_alloc_char 104 type(t_alloc_char) :: x 105 end subroutine 106 end interface 107 call takes_ta_alloc_char(t_alloc_char("hello")) 108end subroutine 109! HLFIR-LABEL: func.func @_QPtest_character_1() { 110! HLFIR: %[[VAL_0:.*]] = fir.alloca !fir.type<_QMm_struct_ctorTt_alloc_char{a:!fir.box<!fir.heap<!fir.char<1,?>>>}> 111! HLFIR: %[[VAL_1:.*]]:2 = hlfir.declare %[[VAL_0]] {uniq_name = "ctor.temp"} : (!fir.ref<!fir.type<_QMm_struct_ctorTt_alloc_char{a:!fir.box<!fir.heap<!fir.char<1,?>>>}>>) -> (!fir.ref<!fir.type<_QMm_struct_ctorTt_alloc_char{a:!fir.box<!fir.heap<!fir.char<1,?>>>}>>, !fir.ref<!fir.type<_QMm_struct_ctorTt_alloc_char{a:!fir.box<!fir.heap<!fir.char<1,?>>>}>>) 112! HLFIR: %[[VAL_2:.*]] = fir.embox %[[VAL_1]]#0 : (!fir.ref<!fir.type<_QMm_struct_ctorTt_alloc_char{a:!fir.box<!fir.heap<!fir.char<1,?>>>}>>) -> !fir.box<!fir.type<_QMm_struct_ctorTt_alloc_char{a:!fir.box<!fir.heap<!fir.char<1,?>>>}>> 113! HLFIR: %[[VAL_5:.*]] = fir.convert %[[VAL_2]] : (!fir.box<!fir.type<_QMm_struct_ctorTt_alloc_char{a:!fir.box<!fir.heap<!fir.char<1,?>>>}>>) -> !fir.box<none> 114! HLFIR: fir.call @_FortranAInitialize(%[[VAL_5]], 115! HLFIR: %[[VAL_8:.*]] = hlfir.designate %[[VAL_1]]#0{"a"} {fortran_attrs = #fir.var_attrs<allocatable>} : (!fir.ref<!fir.type<_QMm_struct_ctorTt_alloc_char{a:!fir.box<!fir.heap<!fir.char<1,?>>>}>>) -> !fir.ref<!fir.box<!fir.heap<!fir.char<1,?>>>> 116! HLFIR: %[[VAL_9:.*]] = fir.address_of(@_QQclX68656C6C6F) : !fir.ref<!fir.char<1,5>> 117! HLFIR: %[[VAL_10:.*]] = arith.constant 5 : index 118! HLFIR: %[[VAL_11:.*]]:2 = hlfir.declare %[[VAL_9]] typeparams %[[VAL_10]] {fortran_attrs = #fir.var_attrs<parameter>, uniq_name = "_QQclX68656C6C6F"} : (!fir.ref<!fir.char<1,5>>, index) -> (!fir.ref<!fir.char<1,5>>, !fir.ref<!fir.char<1,5>>) 119! HLFIR: hlfir.assign %[[VAL_11]]#0 to %[[VAL_8]] realloc temporary_lhs : !fir.ref<!fir.char<1,5>>, !fir.ref<!fir.box<!fir.heap<!fir.char<1,?>>>> 120! HLFIR: fir.call @_QPtakes_ta_alloc_char(%[[VAL_1]]#1) fastmath<contract> : (!fir.ref<!fir.type<_QMm_struct_ctorTt_alloc_char{a:!fir.box<!fir.heap<!fir.char<1,?>>>}>>) -> () 121 122subroutine test_character_2() 123 use m_struct_ctor, only : t_alloc_char_cst_len 124 interface 125 subroutine takes_ta_alloc_char_cst_len(x) 126 import t_alloc_char_cst_len 127 type(t_alloc_char_cst_len) :: x 128 end subroutine 129 end interface 130 call takes_ta_alloc_char_cst_len(t_alloc_char_cst_len("hello")) 131end subroutine 132! HLFIR-LABEL: func.func @_QPtest_character_2() { 133! HLFIR: %[[VAL_0:.*]] = fir.alloca !fir.type<_QMm_struct_ctorTt_alloc_char_cst_len{a:!fir.box<!fir.heap<!fir.char<1,2>>>}> 134! HLFIR: %[[VAL_1:.*]]:2 = hlfir.declare %[[VAL_0]] {uniq_name = "ctor.temp"} : (!fir.ref<!fir.type<_QMm_struct_ctorTt_alloc_char_cst_len{a:!fir.box<!fir.heap<!fir.char<1,2>>>}>>) -> (!fir.ref<!fir.type<_QMm_struct_ctorTt_alloc_char_cst_len{a:!fir.box<!fir.heap<!fir.char<1,2>>>}>>, !fir.ref<!fir.type<_QMm_struct_ctorTt_alloc_char_cst_len{a:!fir.box<!fir.heap<!fir.char<1,2>>>}>>) 135! HLFIR: %[[VAL_2:.*]] = fir.embox %[[VAL_1]]#0 : (!fir.ref<!fir.type<_QMm_struct_ctorTt_alloc_char_cst_len{a:!fir.box<!fir.heap<!fir.char<1,2>>>}>>) -> !fir.box<!fir.type<_QMm_struct_ctorTt_alloc_char_cst_len{a:!fir.box<!fir.heap<!fir.char<1,2>>>}>> 136! HLFIR: %[[VAL_5:.*]] = fir.convert %[[VAL_2]] : (!fir.box<!fir.type<_QMm_struct_ctorTt_alloc_char_cst_len{a:!fir.box<!fir.heap<!fir.char<1,2>>>}>>) -> !fir.box<none> 137! HLFIR: fir.call @_FortranAInitialize(%[[VAL_5]], 138! HLFIR: %[[VAL_8:.*]] = arith.constant 2 : index 139! HLFIR: %[[VAL_9:.*]] = hlfir.designate %[[VAL_1]]#0{"a"} typeparams %[[VAL_8]] {fortran_attrs = #fir.var_attrs<allocatable>} : (!fir.ref<!fir.type<_QMm_struct_ctorTt_alloc_char_cst_len{a:!fir.box<!fir.heap<!fir.char<1,2>>>}>>, index) -> !fir.ref<!fir.box<!fir.heap<!fir.char<1,2>>>> 140! HLFIR: %[[VAL_10:.*]] = fir.address_of(@_QQclX68656C6C6F) : !fir.ref<!fir.char<1,5>> 141! HLFIR: %[[VAL_11:.*]] = arith.constant 5 : index 142! HLFIR: %[[VAL_12:.*]]:2 = hlfir.declare %[[VAL_10]] typeparams %[[VAL_11]] {fortran_attrs = #fir.var_attrs<parameter>, uniq_name = "_QQclX68656C6C6F"} : (!fir.ref<!fir.char<1,5>>, index) -> (!fir.ref<!fir.char<1,5>>, !fir.ref<!fir.char<1,5>>) 143! HLFIR: hlfir.assign %[[VAL_12]]#0 to %[[VAL_9]] realloc keep_lhs_len temporary_lhs : !fir.ref<!fir.char<1,5>>, !fir.ref<!fir.box<!fir.heap<!fir.char<1,2>>>> 144! HLFIR: fir.call @_QPtakes_ta_alloc_char_cst_len(%[[VAL_1]]#1) fastmath<contract> : (!fir.ref<!fir.type<_QMm_struct_ctorTt_alloc_char_cst_len{a:!fir.box<!fir.heap<!fir.char<1,2>>>}>>) -> () 145