|
111
|
1 ! { dg-do run }
|
|
|
2 ! { dg-options "-fcray-pointer -ffloat-store" }
|
|
|
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)
|
|
131
|
62 if (abs (y - z) .gt. 1e-6) STOP 1
|
|
111
|
63 end
|
