0ae1f0a310
Currently, all derived types are initialized through `_FortranAInitialize`, which is functionally correct, but bears poor runtime performance. This patch falls back on global initialization for "simpler" derived types to speed up the initialization.
120 lines
5.6 KiB
Fortran
120 lines
5.6 KiB
Fortran
! Test that pointer and pointer components are always initialized to a
|
|
! clean NULL() status. This is required by f18 runtime to do pointer
|
|
! association with a RHS with an undefined association status from a
|
|
! Fortran point of view.
|
|
! RUN: bbc -emit-fir -hlfir=false -I nw %s -o - | FileCheck %s
|
|
|
|
module test
|
|
type t
|
|
integer :: i
|
|
real, pointer :: x(:)
|
|
end type
|
|
|
|
real, pointer :: test_module_pointer(:)
|
|
! CHECK-LABEL: fir.global @_QMtestEtest_module_pointer : !fir.box<!fir.ptr<!fir.array<?xf32>>> {
|
|
! CHECK: %[[VAL_0:.*]] = fir.zero_bits !fir.ptr<!fir.array<?xf32>>
|
|
! CHECK: %[[VAL_1:.*]] = arith.constant 0 : index
|
|
! CHECK: %[[VAL_2:.*]] = fir.shape %[[VAL_1]] : (index) -> !fir.shape<1>
|
|
! CHECK: %[[VAL_3:.*]] = fir.embox %[[VAL_0]](%[[VAL_2]]) : (!fir.ptr<!fir.array<?xf32>>, !fir.shape<1>) -> !fir.box<!fir.ptr<!fir.array<?xf32>>>
|
|
! CHECK: fir.has_value %[[VAL_3]] : !fir.box<!fir.ptr<!fir.array<?xf32>>>
|
|
|
|
type(t) :: test_module_var
|
|
! CHECK-LABEL: fir.global @_QMtestEtest_module_var : !fir.type<_QMtestTt{i:i32,x:!fir.box<!fir.ptr<!fir.array<?xf32>>>}> {
|
|
! CHECK: %[[VAL_0:.*]] = fir.undefined !fir.type<_QMtestTt{i:i32,x:!fir.box<!fir.ptr<!fir.array<?xf32>>>}>
|
|
! CHECK: %[[VAL_1:.*]] = fir.zero_bits i32
|
|
! CHECK: %[[VAL_2:.*]] = fir.field_index i
|
|
! CHECK: %[[VAL_3:.*]] = fir.insert_value %[[VAL_0]], %[[VAL_1]]
|
|
! CHECK: %[[VAL_4:.*]] = fir.zero_bits !fir.ptr<!fir.array<?xf32>>
|
|
! CHECK: %[[VAL_5:.*]] = arith.constant 0 : index
|
|
! CHECK: %[[VAL_6:.*]] = fir.shape %[[VAL_5]] : (index) -> !fir.shape<1>
|
|
! CHECK: %[[VAL_7:.*]] = fir.embox %[[VAL_4]](%[[VAL_6]]) : (!fir.ptr<!fir.array<?xf32>>, !fir.shape<1>) -> !fir.box<!fir.ptr<!fir.array<?xf32>>>
|
|
! CHECK: %[[VAL_8:.*]] = fir.field_index x
|
|
! CHECK: %[[VAL_9:.*]] = fir.insert_value %[[VAL_3]], %[[VAL_7]]
|
|
! CHECK: fir.has_value %[[VAL_9]]
|
|
end module
|
|
|
|
subroutine test_local()
|
|
use test, only : t
|
|
type(t) :: x
|
|
end subroutine
|
|
! CHECK-LABEL: func.func @_QPtest_local() {
|
|
! CHECK: %[[x:.*]] = fir.alloca !fir.type<_QMtestTt{i:i32,x:!fir.box<!fir.ptr<!fir.array<?xf32>>>}> {bindc_name = "x", uniq_name = "_QFtest_localEx"}
|
|
! CHECK: %[[ADDR:.*]] = fir.address_of(@_QQ_QMtestTt.DerivedInit) : !fir.ref<!fir.type<_QMtestTt{i:i32,x:!fir.box<!fir.ptr<!fir.array<?xf32>>>}>>
|
|
! CHECK: %[[LOAD:.*]] = fir.load %[[ADDR]] : !fir.ref<!fir.type<_QMtestTt{i:i32,x:!fir.box<!fir.ptr<!fir.array<?xf32>>>}>>
|
|
! CHECK: fir.store %[[LOAD]] to %[[x]] : !fir.ref<!fir.type<_QMtestTt{i:i32,x:!fir.box<!fir.ptr<!fir.array<?xf32>>>}>>
|
|
|
|
subroutine test_saved()
|
|
use test, only : t
|
|
type(t), save :: x
|
|
end subroutine
|
|
! See check for fir.global internal @_QFtest_savedEx below.
|
|
|
|
subroutine test_alloc(x)
|
|
use test, only : t
|
|
type(t), allocatable :: x
|
|
allocate(x)
|
|
end subroutine
|
|
! CHECK-LABEL: func.func @_QPtest_alloc(
|
|
! CHECK: fir.call @_FortranAAllocatableAllocate
|
|
|
|
subroutine test_intentout(x)
|
|
use test, only : t
|
|
type(t), intent(out):: x
|
|
end subroutine
|
|
! CHECK-LABEL: func.func @_QPtest_intentout(
|
|
! CHECK-NOT: fir.call @_FortranAInitialize(
|
|
! CHECK: return
|
|
|
|
subroutine test_struct_ctor_cst(x)
|
|
use test, only : t
|
|
type(t):: x
|
|
x = t(42)
|
|
end subroutine
|
|
! CHECK-LABEL: func.func @_QPtest_struct_ctor_cst(
|
|
! CHECK: fir.call @_FortranAInitialize(
|
|
|
|
subroutine test_struct_ctor_dyn(x, i)
|
|
use test, only : t
|
|
type(t):: x
|
|
integer :: i
|
|
x = t(i)
|
|
end subroutine
|
|
! CHECK-LABEL: func.func @_QPtest_struct_ctor_dyn(
|
|
! CHECK: fir.call @_FortranAInitialize(
|
|
|
|
subroutine test_local_pointer()
|
|
real, pointer :: x(:)
|
|
end subroutine
|
|
! CHECK-LABEL: func.func @_QPtest_local_pointer() {
|
|
! CHECK: %[[VAL_0:.*]] = fir.alloca !fir.box<!fir.ptr<!fir.array<?xf32>>> {bindc_name = "x", uniq_name = "_QFtest_local_pointerEx"}
|
|
! CHECK: %[[VAL_1:.*]] = fir.zero_bits !fir.ptr<!fir.array<?xf32>>
|
|
! CHECK: %[[VAL_2:.*]] = arith.constant 0 : index
|
|
! CHECK: %[[VAL_3:.*]] = fir.shape %[[VAL_2]] : (index) -> !fir.shape<1>
|
|
! CHECK: %[[VAL_4:.*]] = fir.embox %[[VAL_1]](%[[VAL_3]]) : (!fir.ptr<!fir.array<?xf32>>, !fir.shape<1>) -> !fir.box<!fir.ptr<!fir.array<?xf32>>>
|
|
! CHECK: fir.store %[[VAL_4]] to %[[VAL_0]] : !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>
|
|
|
|
subroutine test_saved_pointer()
|
|
real, pointer, save :: x(:)
|
|
end subroutine
|
|
! See check for fir.global internal @_QFtest_saved_pointerEx below.
|
|
|
|
! CHECK-LABEL: fir.global internal @_QFtest_savedEx : !fir.type<_QMtestTt{i:i32,x:!fir.box<!fir.ptr<!fir.array<?xf32>>>}> {
|
|
! CHECK: %[[VAL_0:.*]] = fir.undefined !fir.type<_QMtestTt{i:i32,x:!fir.box<!fir.ptr<!fir.array<?xf32>>>}>
|
|
! CHECK: %[[VAL_1:.*]] = fir.zero_bits i32
|
|
! CHECK: %[[VAL_2:.*]] = fir.field_index i
|
|
! CHECK: %[[VAL_3:.*]] = fir.insert_value %[[VAL_0]], %[[VAL_1]]
|
|
! CHECK: %[[VAL_4:.*]] = fir.zero_bits !fir.ptr<!fir.array<?xf32>>
|
|
! CHECK: %[[VAL_5:.*]] = arith.constant 0 : index
|
|
! CHECK: %[[VAL_6:.*]] = fir.shape %[[VAL_5]] : (index) -> !fir.shape<1>
|
|
! CHECK: %[[VAL_7:.*]] = fir.embox %[[VAL_4]](%[[VAL_6]]) : (!fir.ptr<!fir.array<?xf32>>, !fir.shape<1>) -> !fir.box<!fir.ptr<!fir.array<?xf32>>>
|
|
! CHECK: %[[VAL_8:.*]] = fir.field_index x
|
|
! CHECK: %[[VAL_9:.*]] = fir.insert_value %[[VAL_3]], %[[VAL_7]]
|
|
! CHECK: fir.has_value %[[VAL_9]]
|
|
|
|
! CHECK-LABEL: fir.global internal @_QFtest_saved_pointerEx : !fir.box<!fir.ptr<!fir.array<?xf32>>> {
|
|
! CHECK: %[[VAL_0:.*]] = fir.zero_bits !fir.ptr<!fir.array<?xf32>>
|
|
! CHECK: %[[VAL_1:.*]] = arith.constant 0 : index
|
|
! CHECK: %[[VAL_2:.*]] = fir.shape %[[VAL_1]] : (index) -> !fir.shape<1>
|
|
! CHECK: %[[VAL_3:.*]] = fir.embox %[[VAL_0]](%[[VAL_2]]) : (!fir.ptr<!fir.array<?xf32>>, !fir.shape<1>) -> !fir.box<!fir.ptr<!fir.array<?xf32>>>
|
|
! CHECK: fir.has_value %[[VAL_3]] : !fir.box<!fir.ptr<!fir.array<?xf32>>>
|