1! { dg-do run } 2! 3! PR39630: Fortran 2003: Procedure pointer components. 4! 5! Basic test for PPCs with FUNCTION interface and NOPASS. 6! 7! Contributed by Janus Weil <janus@gcc.gnu.org> 8 9 type t 10 procedure(fcn), pointer, nopass :: ppc 11 procedure(abstr), pointer, nopass :: ppc1 12 integer :: i 13 end type 14 15 abstract interface 16 integer function abstr(x) 17 integer, intent(in) :: x 18 end function 19 end interface 20 21 type(t) :: obj 22 procedure(fcn), pointer :: f 23 integer :: base 24 25 intrinsic :: iabs 26 27! Check with interface from contained function 28 obj%ppc => fcn 29 base=obj%ppc(2) 30 if (base/=4) call abort 31 call foo (obj%ppc,3) 32 33! Check with abstract interface 34 obj%ppc1 => obj%ppc 35 base=obj%ppc1(4) 36 if (base/=8) call abort 37 call foo (obj%ppc1,5) 38 39! Check compatibility components with non-components 40 f => obj%ppc 41 base=f(6) 42 if (base/=12) call abort 43 call foo (f,7) 44 45contains 46 47 integer function fcn(x) 48 integer, intent(in) :: x 49 fcn = 2 * x 50 end function 51 52 subroutine foo (arg, i) 53 procedure (fcn), pointer :: arg 54 integer :: i 55 if (arg(i)/=2*i) call abort 56 end subroutine 57 58end 59