2 ! { dg-options "-fcheck=pointer" }
3 ! { dg-shouldfail "Unassociated/unallocated actual argument" }
5 ! { dg-output ".*At line 46 .*Pointer actual argument 'getptr' is not associated" }
9 ! Run-time check of passing deallocated/nonassociated actuals
10 ! to nonallocatable/nonpointer dummies.
12 ! Check for function actuals
33 external :: test1
, test2
, ppTest
34 procedure(), pointer :: pptr
37 call test1(getPtr(.true
.))
38 call test2(getPtrArray(.true
.))
39 call test2(getAlloc(.true
.))
41 ! OK but fails due to PR 40593
42 ! call ppTest(getProcPtr(.true.))
43 ! call ppTest2(getProcPtr(.true.))
46 call test1(getPtr(.false
.))
47 ! call test2(getAlloc(.false.)) - fails because the check is inserted after
48 ! _gfortran_internal_pack, which fails with out of memory
49 ! call ppTest(getProcPtr(.false.)) - fails due to PR 40593
50 ! call ppTest2(getProcPtr(.false.)) - fails due to PR 40593
53 function getPtr(alloc
)
54 integer, pointer :: getPtr
55 logical, intent(in
) :: alloc
63 function getPtrArray(alloc
)
64 integer, pointer :: getPtrArray(:)
65 logical, intent(in
) :: alloc
67 allocate (getPtrArray(2))
72 end function getPtrArray
73 function getAlloc(alloc
)
74 integer, allocatable
:: getAlloc(:)
75 logical, intent(in
) :: alloc
77 allocate (getAlloc(2))
79 else if (allocated(getAlloc
)) then
84 print *, 'Hello World'
86 function getProcPtr(alloc
)
87 procedure(sub
), pointer :: getProcPtr
88 logical, intent(in
) :: alloc
94 end function getProcPtr
99 end subroutine ppTest2
100 end Program RunTimeCheck