Subversion Repositories openrisc

! { dg-do run }

!

! PR 41022: [F03] procedure pointer components as actual arguments

!

! Contributed by Juergen Reuter 

program foo

   type :: container_t

      procedure(proc), nopass, pointer :: proc => null ()

   end type container_t

   type(container_t), target :: obj1

   type(container_t) :: obj2

   obj1%proc => proc

   call transfer_proc_ptr (obj2, obj1)

   if (obj2%proc()/=7) call abort()

contains

   subroutine transfer_proc_ptr (obj2, obj1)

     type(container_t), intent(out) :: obj2

     type(container_t), intent(in), target :: obj1

     call assign_proc_ptr (obj2%proc, obj1)

   end subroutine transfer_proc_ptr

   subroutine assign_proc_ptr (ptr, obj1)

     procedure(proc), pointer :: ptr

     type(container_t), intent(in), target :: obj1

     ptr => obj1%proc

   end subroutine assign_proc_ptr

   integer function proc ()

      proc = 7

   end function

end program foo