1! Test that pointer and pointer components are always initialized to a 2! clean NULL() status. This is required by f18 runtime to do pointer 3! association with a RHS with an undefined association status from a 4! Fortran point of view. 5! RUN: bbc -emit-fir -hlfir=false -I nw %s -o - | FileCheck %s 6 7module test 8 type t 9 integer :: i 10 real, pointer :: x(:) 11 end type 12 13 real, pointer :: test_module_pointer(:) 14! CHECK-LABEL: fir.global @_QMtestEtest_module_pointer : !fir.box<!fir.ptr<!fir.array<?xf32>>> { 15! CHECK: %[[VAL_0:.*]] = fir.zero_bits !fir.ptr<!fir.array<?xf32>> 16! CHECK: %[[VAL_1:.*]] = arith.constant 0 : index 17! CHECK: %[[VAL_2:.*]] = fir.shape %[[VAL_1]] : (index) -> !fir.shape<1> 18! CHECK: %[[VAL_3:.*]] = fir.embox %[[VAL_0]](%[[VAL_2]]) : (!fir.ptr<!fir.array<?xf32>>, !fir.shape<1>) -> !fir.box<!fir.ptr<!fir.array<?xf32>>> 19! CHECK: fir.has_value %[[VAL_3]] : !fir.box<!fir.ptr<!fir.array<?xf32>>> 20 21 type(t) :: test_module_var 22! CHECK-LABEL: fir.global @_QMtestEtest_module_var : !fir.type<_QMtestTt{i:i32,x:!fir.box<!fir.ptr<!fir.array<?xf32>>>}> { 23! CHECK: %[[VAL_0:.*]] = fir.undefined !fir.type<_QMtestTt{i:i32,x:!fir.box<!fir.ptr<!fir.array<?xf32>>>}> 24! CHECK: %[[VAL_1:.*]] = fir.zero_bits i32 25! CHECK: %[[VAL_2:.*]] = fir.field_index i 26! CHECK: %[[VAL_3:.*]] = fir.insert_value %[[VAL_0]], %[[VAL_1]] 27! CHECK: %[[VAL_4:.*]] = fir.zero_bits !fir.ptr<!fir.array<?xf32>> 28! CHECK: %[[VAL_5:.*]] = arith.constant 0 : index 29! CHECK: %[[VAL_6:.*]] = fir.shape %[[VAL_5]] : (index) -> !fir.shape<1> 30! CHECK: %[[VAL_7:.*]] = fir.embox %[[VAL_4]](%[[VAL_6]]) : (!fir.ptr<!fir.array<?xf32>>, !fir.shape<1>) -> !fir.box<!fir.ptr<!fir.array<?xf32>>> 31! CHECK: %[[VAL_8:.*]] = fir.field_index x 32! CHECK: %[[VAL_9:.*]] = fir.insert_value %[[VAL_3]], %[[VAL_7]] 33! CHECK: fir.has_value %[[VAL_9]] 34end module 35 36subroutine test_local() 37 use test, only : t 38 type(t) :: x 39end subroutine 40! CHECK-LABEL: func.func @_QPtest_local() { 41! CHECK: fir.call @_FortranAInitialize( 42 43subroutine test_saved() 44 use test, only : t 45 type(t), save :: x 46end subroutine 47! See check for fir.global internal @_QFtest_savedEx below. 48 49subroutine test_alloc(x) 50 use test, only : t 51 type(t), allocatable :: x 52 allocate(x) 53end subroutine 54! CHECK-LABEL: func.func @_QPtest_alloc( 55! CHECK: fir.call @_FortranAAllocatableAllocate 56 57subroutine test_intentout(x) 58 use test, only : t 59 type(t), intent(out):: x 60end subroutine 61! CHECK-LABEL: func.func @_QPtest_intentout( 62! CHECK-NOT: fir.call @_FortranAInitialize( 63! CHECK: return 64 65subroutine test_struct_ctor_cst(x) 66 use test, only : t 67 type(t):: x 68 x = t(42) 69end subroutine 70! CHECK-LABEL: func.func @_QPtest_struct_ctor_cst( 71! CHECK: fir.call @_FortranAInitialize( 72 73subroutine test_struct_ctor_dyn(x, i) 74 use test, only : t 75 type(t):: x 76 integer :: i 77 x = t(i) 78end subroutine 79! CHECK-LABEL: func.func @_QPtest_struct_ctor_dyn( 80! CHECK: fir.call @_FortranAInitialize( 81 82subroutine test_local_pointer() 83 real, pointer :: x(:) 84end subroutine 85! CHECK-LABEL: func.func @_QPtest_local_pointer() { 86! CHECK: %[[VAL_0:.*]] = fir.alloca !fir.box<!fir.ptr<!fir.array<?xf32>>> {bindc_name = "x", uniq_name = "_QFtest_local_pointerEx"} 87! CHECK: %[[VAL_1:.*]] = fir.zero_bits !fir.ptr<!fir.array<?xf32>> 88! CHECK: %[[VAL_2:.*]] = arith.constant 0 : index 89! CHECK: %[[VAL_3:.*]] = fir.shape %[[VAL_2]] : (index) -> !fir.shape<1> 90! CHECK: %[[VAL_4:.*]] = fir.embox %[[VAL_1]](%[[VAL_3]]) : (!fir.ptr<!fir.array<?xf32>>, !fir.shape<1>) -> !fir.box<!fir.ptr<!fir.array<?xf32>>> 91! CHECK: fir.store %[[VAL_4]] to %[[VAL_0]] : !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>> 92 93subroutine test_saved_pointer() 94 real, pointer, save :: x(:) 95end subroutine 96! See check for fir.global internal @_QFtest_saved_pointerEx below. 97 98! CHECK-LABEL: fir.global internal @_QFtest_savedEx : !fir.type<_QMtestTt{i:i32,x:!fir.box<!fir.ptr<!fir.array<?xf32>>>}> { 99! CHECK: %[[VAL_0:.*]] = fir.undefined !fir.type<_QMtestTt{i:i32,x:!fir.box<!fir.ptr<!fir.array<?xf32>>>}> 100! CHECK: %[[VAL_1:.*]] = fir.zero_bits i32 101! CHECK: %[[VAL_2:.*]] = fir.field_index i 102! CHECK: %[[VAL_3:.*]] = fir.insert_value %[[VAL_0]], %[[VAL_1]] 103! CHECK: %[[VAL_4:.*]] = fir.zero_bits !fir.ptr<!fir.array<?xf32>> 104! CHECK: %[[VAL_5:.*]] = arith.constant 0 : index 105! CHECK: %[[VAL_6:.*]] = fir.shape %[[VAL_5]] : (index) -> !fir.shape<1> 106! CHECK: %[[VAL_7:.*]] = fir.embox %[[VAL_4]](%[[VAL_6]]) : (!fir.ptr<!fir.array<?xf32>>, !fir.shape<1>) -> !fir.box<!fir.ptr<!fir.array<?xf32>>> 107! CHECK: %[[VAL_8:.*]] = fir.field_index x 108! CHECK: %[[VAL_9:.*]] = fir.insert_value %[[VAL_3]], %[[VAL_7]] 109! CHECK: fir.has_value %[[VAL_9]] 110 111! CHECK-LABEL: fir.global internal @_QFtest_saved_pointerEx : !fir.box<!fir.ptr<!fir.array<?xf32>>> { 112! CHECK: %[[VAL_0:.*]] = fir.zero_bits !fir.ptr<!fir.array<?xf32>> 113! CHECK: %[[VAL_1:.*]] = arith.constant 0 : index 114! CHECK: %[[VAL_2:.*]] = fir.shape %[[VAL_1]] : (index) -> !fir.shape<1> 115! CHECK: %[[VAL_3:.*]] = fir.embox %[[VAL_0]](%[[VAL_2]]) : (!fir.ptr<!fir.array<?xf32>>, !fir.shape<1>) -> !fir.box<!fir.ptr<!fir.array<?xf32>>> 116! CHECK: fir.has_value %[[VAL_3]] : !fir.box<!fir.ptr<!fir.array<?xf32>>> 117