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