1! { dg-do run } 2! { dg-options "-fcheck=pointer" } 3! { dg-shouldfail "Unassociated/unallocated actual argument" } 4! 5! { dg-output ".*At line 53 .*Allocatable actual argument 'alloc2' is not allocated" } 6! 7! PR fortran/40580 8! 9! Run-time check of passing deallocated/nonassociated actuals 10! to nonallocatable/nonpointer dummies. 11! 12! Check for variable actuals 13! 14 15subroutine test1(a) 16 integer :: a 17 a = 4444 18end subroutine test1 19 20subroutine test2(a) 21 integer :: a(2) 22 a = 4444 23end subroutine test2 24 25subroutine ppTest(f) 26 implicit none 27 external f 28 call f() 29end subroutine ppTest 30 31Program RunTimeCheck 32 implicit none 33 external :: test1, test2, ppTest 34 integer, pointer :: ptr1, ptr2(:) 35 integer, allocatable :: alloc2(:) 36 procedure(), pointer :: pptr 37 38 allocate(ptr1,ptr2(2),alloc2(2)) 39 pptr => sub 40 ! OK 41 call test1(ptr1) 42 call test3(ptr1) 43 44 call test2(ptr2) 45 call test2(alloc2) 46 call test4(ptr2) 47 call test4(alloc2) 48 call ppTest(pptr) 49 call ppTest2(pptr) 50 51 ! Invalid 1: 52 deallocate(alloc2) 53 call test2(alloc2) 54! call test4(alloc2) 55 56 ! Invalid 2: 57 deallocate(ptr1,ptr2) 58 nullify(ptr1,ptr2) 59! call test1(ptr1) 60! call test3(ptr1) 61! call test2(ptr2) 62! call test4(ptr2) 63 64 ! Invalid 3: 65 nullify(pptr) 66! call ppTest(pptr) 67 call ppTest2(pptr) 68 69contains 70 subroutine test3(b) 71 integer :: b 72 b = 333 73 end subroutine test3 74 subroutine test4(b) 75 integer :: b(2) 76 b = 333 77 end subroutine test4 78 subroutine sub() 79 print *, 'Hello World' 80 end subroutine sub 81 subroutine ppTest2(f) 82 implicit none 83 procedure(sub) :: f 84 call f() 85 end subroutine ppTest2 86end Program RunTimeCheck 87