llvm-project/flang/test/Lower/pointer-default-init.f90
jeanPerier 87e2521022
[flang] Zero initialize uninitialized components in saved default init (#67777)
Follow up up of https://github.com/llvm/llvm-project/pull/67693

- Zero initialize uninitialized components of saved derived type entity
with a default initial value.
- Zero initialize uninitialized storage of common blocks with a member
with an initial value.
- Zero initialized uninitialized saved equivalence

This removes all the cases where fir.global are created with an initial
value that results in an undef in LLVM for part of the global, leading
in surprising LLVM optimizations at -O2 for Fortran folks that expects
there saved variables to be zero initialized if there is no explicit or
default initial value.
2023-10-02 09:53:09 +02:00

117 lines
5.1 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 -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: fir.call @_FortranAInitialize(
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>>>