1! { dg-do run }
2!
3! PR 41022: [F03] procedure pointer components as actual arguments
4!
5! Contributed by Juergen Reuter <reuter@physik.uni-freiburg.de>
6
7program foo
8
9   type :: container_t
10      procedure(proc), nopass, pointer :: proc => null ()
11   end type container_t
12
13   type(container_t), target :: obj1
14   type(container_t) :: obj2
15
16   obj1%proc => proc
17   call transfer_proc_ptr (obj2, obj1)
18
19   if (obj2%proc()/=7) STOP 1
20
21contains
22
23   subroutine transfer_proc_ptr (obj2, obj1)
24     type(container_t), intent(out) :: obj2
25     type(container_t), intent(in), target :: obj1
26     call assign_proc_ptr (obj2%proc, obj1)
27   end subroutine transfer_proc_ptr
28
29   subroutine assign_proc_ptr (ptr, obj1)
30     procedure(proc), pointer :: ptr
31     type(container_t), intent(in), target :: obj1
32     ptr => obj1%proc
33   end subroutine assign_proc_ptr
34
35   integer function proc ()
36      proc = 7
37   end function
38
39end program foo
40
41