!{ dg-do run } ! ! PR 36704: Procedure pointer as function result ! ! Original test case from James Van Buskirk. ! ! Adapted by Janus Weil module store_subroutine implicit none abstract interface subroutine sub(i) integer, intent(inout) :: i end subroutine sub end interface procedure(sub), pointer, private :: psub => NULL() contains subroutine set_sub(x) procedure(sub) x psub => x end subroutine set_sub function get_sub() procedure(sub), pointer :: get_sub get_sub => psub end function get_sub end module store_subroutine program test use store_subroutine implicit none procedure(sub), pointer :: qsub integer :: k = 1 call my_sub(k) if (k/=3) call abort qsub => get_sub() call qsub(k) if (k/=9) call abort end program test recursive subroutine my_sub(j) use store_subroutine implicit none integer, intent(inout) :: j j = j*3 call set_sub(my_sub) end subroutine my_sub