Files
clang-p2996/flang/test/Lower/pointer-default-init.f90
jeanPerier f35f863a88 [flang][NFC] Use hlfir=false and flang-deprecated-no-hlfir in legacy tests (#71957)
Patch 2/3 of the transition step 1 described in

https://discourse.llvm.org/t/rfc-enabling-the-hlfir-lowering-by-default/72778/7.

All the modified tests are still here since coverage for the direct
lowering to FIR was still needed while it was default. Some already have
an HLFIR version, some have not and will need to be ported in step 2
described in the RFC.

Note that another 147 lit tests use -emit-fir/-emit-llvm outputs but do
not need a flag since the HLFIR/no HLFIR output is the same for what is
being tested.
2023-11-13 09:14:05 +01: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 -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: 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>>>