1! { dg-do run } 2! 3! PR 40593: Proc-pointer returning function as actual argument 4! 5! Original test case by Tobias Burnus <burnus@gcc.gnu.org> 6! Modified by Janus Weil 7 8module m 9contains 10 subroutine sub(a) 11 integer :: a 12 a = 42 13 end subroutine 14 integer function func() 15 func = 42 16 end function 17end module m 18 19program test 20 use m 21 implicit none 22 call caller1(getPtr1()) 23 call caller2(getPtr2()) 24 call caller3(getPtr2()) 25contains 26 subroutine caller1(s) 27 procedure(sub) :: s 28 integer :: b 29 call s(b) 30 if (b /= 42) call abort() 31 end subroutine 32 subroutine caller2(f) 33 procedure(integer) :: f 34 if (f() /= 42) call abort() 35 end subroutine 36 subroutine caller3(f) 37 procedure(func),pointer :: f 38 if (f() /= 42) call abort() 39 end subroutine 40 function getPtr1() 41 procedure(sub), pointer :: getPtr1 42 getPtr1 => sub 43 end function 44 function getPtr2() 45 procedure(func), pointer :: getPtr2 46 getPtr2 => func 47 end function 48end program test 49