flang/test/Lower/structure-constructors-alloc-comp.f90

   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
   4 module 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
  20 contains
  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
  97 end module m_struct_ctor
  98
  99 subroutine 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"))
 108 end 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
 122 subroutine 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"))
 131 end 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>>>}>>) -> ()