gcc/testsuite/gfortran.dg/cray_pointers_8.f90

   1 ! { dg-do run }
   2 ! { dg-options "-fcray-pointer" }
   3 !
   4 ! Test the fix for PR36528 in which the Cray pointer was not passed
   5 ! correctly to 'euler' so that an undefined reference to fcn was
   6 ! generated by the linker.
   7 !
   8 ! Reported by Tobias Burnus  <burnus@gcc.gnu.org>
   9 ! from http://groups.google.com/group/comp.lang.fortran/msg/86b65bad78e6af78
  10 !
  11 real function p1(x)
  12   real, intent(in) :: x
  13   p1 = x
  14 end
  15
  16 real function euler(xp,xk,dx,f)
  17   real, intent(in) :: xp, xk, dx
  18   interface
  19     real function f(x)
  20       real, intent(in) :: x
  21     end function
  22   end interface
  23   real x, y
  24   y = 0.0
  25   x = xp
  26   do while (x .le. xk)
  27     y = y + f(x)*dx
  28     x = x + dx
  29   end do
  30   euler = y
  31 end
  32 program main
  33   interface
  34     real function p1 (x)
  35       real, intent(in) :: x
  36     end function
  37     real function fcn (x)
  38       real, intent(in) :: x
  39     end function
  40     real function euler (xp,xk,dx,f)
  41       real, intent(in) :: xp, xk ,dx
  42       interface
  43         real function f(x)
  44           real, intent(in) :: x
  45         end function
  46       end interface
  47     end function
  48   end interface
  49   real x, xp, xk, dx, y, z
  50   pointer (pfcn, fcn)
  51   pfcn = loc(p1)
  52   xp = 0.0
  53   xk = 1.0
  54   dx = 0.0005
  55   y = 0.0
  56   x = xp
  57   do while (x .le. xk)
  58     y = y + fcn(x)*dx
  59     x = x + dx
  60   end do
  61   z = euler(0.0,1.0,0.0005,fcn)
  62   if (abs (y - z) .gt. 1e-6) call abort
  63 end