119 lines · plain
1! Test that pointer and pointer components are always initialized to a2! clean NULL() status. This is required by f18 runtime to do pointer3! association with a RHS with an undefined association status from a4! Fortran point of view.5! RUN: bbc -emit-fir -hlfir=false -I nw %s -o - | FileCheck %s6 7module test8 type t9 integer :: i10 real, pointer :: x(:)11 end type12 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 : index17! 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_var22! 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 i3225! CHECK: %[[VAL_2:.*]] = fir.field_index i26! 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 : index29! 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 x32! CHECK: %[[VAL_9:.*]] = fir.insert_value %[[VAL_3]], %[[VAL_7]]33! CHECK: fir.has_value %[[VAL_9]]34end module35 36subroutine test_local()37 use test, only : t38 type(t) :: x39end subroutine40! CHECK-LABEL: func.func @_QPtest_local() {41! CHECK: %[[x:.*]] = fir.alloca !fir.type<_QMtestTt{i:i32,x:!fir.box<!fir.ptr<!fir.array<?xf32>>>}> {bindc_name = "x", uniq_name = "_QFtest_localEx"}42! CHECK: %[[ADDR:.*]] = fir.address_of(@_QQ_QMtestTt.DerivedInit) : !fir.ref<!fir.type<_QMtestTt{i:i32,x:!fir.box<!fir.ptr<!fir.array<?xf32>>>}>>43! CHECK: fir.copy %[[ADDR]] to %[[x]] no_overlap : !fir.ref<!fir.type<_QMtestTt{i:i32,x:!fir.box<!fir.ptr<!fir.array<?xf32>>>}>>, !fir.ref<!fir.type<_QMtestTt{i:i32,x:!fir.box<!fir.ptr<!fir.array<?xf32>>>}>>44 45subroutine test_saved()46 use test, only : t47 type(t), save :: x48end subroutine49! See check for fir.global internal @_QFtest_savedEx below.50 51subroutine test_alloc(x)52 use test, only : t53 type(t), allocatable :: x54 allocate(x)55end subroutine56! CHECK-LABEL: func.func @_QPtest_alloc(57! CHECK: fir.call @_FortranAAllocatableAllocate58 59subroutine test_intentout(x)60 use test, only : t61 type(t), intent(out):: x62end subroutine63! CHECK-LABEL: func.func @_QPtest_intentout(64! CHECK-NOT: fir.call @_FortranAInitialize(65! CHECK: return66 67subroutine test_struct_ctor_cst(x)68 use test, only : t69 type(t):: x70 x = t(42)71end subroutine72! CHECK-LABEL: func.func @_QPtest_struct_ctor_cst(73! CHECK: fir.call @_FortranAInitialize(74 75subroutine test_struct_ctor_dyn(x, i)76 use test, only : t77 type(t):: x78 integer :: i79 x = t(i)80end subroutine81! CHECK-LABEL: func.func @_QPtest_struct_ctor_dyn(82! CHECK: fir.call @_FortranAInitialize(83 84subroutine test_local_pointer()85 real, pointer :: x(:)86end subroutine87! CHECK-LABEL: func.func @_QPtest_local_pointer() {88! CHECK: %[[VAL_0:.*]] = fir.alloca !fir.box<!fir.ptr<!fir.array<?xf32>>> {bindc_name = "x", uniq_name = "_QFtest_local_pointerEx"}89! CHECK: %[[VAL_1:.*]] = fir.zero_bits !fir.ptr<!fir.array<?xf32>>90! CHECK: %[[VAL_2:.*]] = arith.constant 0 : index91! CHECK: %[[VAL_3:.*]] = fir.shape %[[VAL_2]] : (index) -> !fir.shape<1>92! CHECK: %[[VAL_4:.*]] = fir.embox %[[VAL_1]](%[[VAL_3]]) : (!fir.ptr<!fir.array<?xf32>>, !fir.shape<1>) -> !fir.box<!fir.ptr<!fir.array<?xf32>>>93! CHECK: fir.store %[[VAL_4]] to %[[VAL_0]] : !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>94 95subroutine test_saved_pointer()96 real, pointer, save :: x(:)97end subroutine98! See check for fir.global internal @_QFtest_saved_pointerEx below.99 100! CHECK-LABEL: fir.global internal @_QFtest_savedEx : !fir.type<_QMtestTt{i:i32,x:!fir.box<!fir.ptr<!fir.array<?xf32>>>}> {101! CHECK: %[[VAL_0:.*]] = fir.undefined !fir.type<_QMtestTt{i:i32,x:!fir.box<!fir.ptr<!fir.array<?xf32>>>}>102! CHECK: %[[VAL_1:.*]] = fir.zero_bits i32103! CHECK: %[[VAL_2:.*]] = fir.field_index i104! CHECK: %[[VAL_3:.*]] = fir.insert_value %[[VAL_0]], %[[VAL_1]]105! CHECK: %[[VAL_4:.*]] = fir.zero_bits !fir.ptr<!fir.array<?xf32>>106! CHECK: %[[VAL_5:.*]] = arith.constant 0 : index107! CHECK: %[[VAL_6:.*]] = fir.shape %[[VAL_5]] : (index) -> !fir.shape<1>108! CHECK: %[[VAL_7:.*]] = fir.embox %[[VAL_4]](%[[VAL_6]]) : (!fir.ptr<!fir.array<?xf32>>, !fir.shape<1>) -> !fir.box<!fir.ptr<!fir.array<?xf32>>>109! CHECK: %[[VAL_8:.*]] = fir.field_index x110! CHECK: %[[VAL_9:.*]] = fir.insert_value %[[VAL_3]], %[[VAL_7]]111! CHECK: fir.has_value %[[VAL_9]]112 113! CHECK-LABEL: fir.global internal @_QFtest_saved_pointerEx : !fir.box<!fir.ptr<!fir.array<?xf32>>> {114! CHECK: %[[VAL_0:.*]] = fir.zero_bits !fir.ptr<!fir.array<?xf32>>115! CHECK: %[[VAL_1:.*]] = arith.constant 0 : index116! CHECK: %[[VAL_2:.*]] = fir.shape %[[VAL_1]] : (index) -> !fir.shape<1>117! CHECK: %[[VAL_3:.*]] = fir.embox %[[VAL_0]](%[[VAL_2]]) : (!fir.ptr<!fir.array<?xf32>>, !fir.shape<1>) -> !fir.box<!fir.ptr<!fir.array<?xf32>>>118! CHECK: fir.has_value %[[VAL_3]] : !fir.box<!fir.ptr<!fir.array<?xf32>>>119