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