1! { dg-do run } 2! { dg-options "-fcray-pointer" } 3 4! Test the implementation of Cray pointers to procedures. 5program cray_pointers_7 6 implicit none 7 integer tmp 8 integer, external :: fn 9 external sub 10 11 ! We can't mix function and subroutine pointers. 12 pointer (subptr,subpte) 13 pointer (fnptr,fnpte) 14 15 ! Declare pointee types. 16 external subpte 17 integer, external :: fnpte 18 19 tmp = 0 20 21 ! Check pointers to subroutines. 22 subptr = loc(sub) 23 call subpte(tmp) 24 if (tmp .ne. 17) call abort() 25 26 ! Check pointers to functions. 27 fnptr = loc(fn) 28 tmp = fnpte(7) 29 if (tmp .ne. 14) call abort() 30 31end program cray_pointers_7 32 33! Trivial subroutine to be called through a Cray pointer. 34subroutine sub(i) 35 integer i 36 i = 17 37end subroutine sub 38 39! Trivial function to be called through a Cray pointer. 40function fn(i) 41 integer fn,i 42 fn = 2*i 43end function fn 44