gcc/testsuite/gfortran.dg/cray_pointers_7.f90

   1 ! { dg-do run }
   2 ! { dg-options "-fcray-pointer" }
   3
   4 ! Test the implementation of Cray pointers to procedures.
   5 program 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) STOP 1
  25
  26   ! Check pointers to functions.
  27   fnptr = loc(fn)
  28   tmp = fnpte(7)
  29   if (tmp .ne. 14) STOP 2
  30
  31 end program cray_pointers_7
  32
  33 ! Trivial subroutine to be called through a Cray pointer.
  34 subroutine sub(i)
  35   integer i
  36   i = 17
  37 end subroutine sub
  38
  39 ! Trivial function to be called through a Cray pointer.
  40 function fn(i)
  41   integer fn,i
  42   fn = 2*i
  43 end function fn