Mercurial > hg > CbC > CbC_gcc
view gcc/testsuite/gfortran.dg/proc_ptr_result_6.f90 @ 158:494b0b89df80 default tip
...
author | Shinji KONO <kono@ie.u-ryukyu.ac.jp> |
---|---|
date | Mon, 25 May 2020 18:13:55 +0900 |
parents | 84e7813d76e9 |
children |
line wrap: on
line source
! { dg-do run } ! ! PR 40593: Proc-pointer returning function as actual argument ! ! Original test case by Tobias Burnus <burnus@gcc.gnu.org> ! Modified by Janus Weil module m contains subroutine sub(a) integer :: a a = 42 end subroutine integer function func() func = 42 end function end module m program test use m implicit none call caller1(getPtr1()) call caller2(getPtr2()) call caller3(getPtr2()) contains subroutine caller1(s) procedure(sub) :: s integer :: b call s(b) if (b /= 42) STOP 1 end subroutine subroutine caller2(f) procedure(integer) :: f if (f() /= 42) STOP 2 end subroutine subroutine caller3(f) procedure(func),pointer :: f if (f() /= 42) STOP 3 end subroutine function getPtr1() procedure(sub), pointer :: getPtr1 getPtr1 => sub end function function getPtr2() procedure(func), pointer :: getPtr2 getPtr2 => func end function end program test