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