OSDN Git Service

93957a571c3d276226927a16e721577c3e2a0e86
[pf3gnuchains/gcc-fork.git] / gcc / testsuite / gfortran.fortran-torture / execute / specifics.f90
1 ! Program to test intrinsic functions as actual arguments
2 subroutine test_r(fn, val, res)
3   real fn
4   real val, res
5
6   if (diff(fn(val), res)) call abort
7 contains
8 function diff(a, b)
9   real a, b
10   logical diff
11   diff = (abs(a - b) .gt. 0.00001)
12 end function
13 end subroutine
14
15 subroutine test_d(fn, val, res)
16   double precision fn
17   double precision val, res
18
19   if (diff(fn(val), res)) call abort
20 contains
21 function diff(a, b)
22   double precision a, b
23   logical diff
24   diff = (abs(a - b) .gt. 0.00001d0)
25 end function
26 end subroutine
27
28 subroutine test_r2(fn, val1, val2, res)
29   real fn
30   real val1, val2, res
31
32   if (diff(fn(val1, val2), res)) call abort
33 contains
34 function diff(a, b)
35   real a, b
36   logical diff
37   diff = (abs(a - b) .gt. 0.00001)
38 end function
39 end subroutine
40
41 subroutine test_d2(fn, val1, val2, res)
42   double precision fn
43   double precision val1, val2, res
44
45   if (diff(fn(val1, val2), res)) call abort
46 contains
47 function diff(a, b)
48   double precision a, b
49   logical diff
50   diff = (abs(a - b) .gt. 0.00001d0)
51 end function
52 end subroutine
53
54 subroutine test_dprod(fn)
55   double precision fn
56   if (abs (fn (2.0, 3.0) - 6d0) .gt. 0.00001) call abort
57 end subroutine
58
59 program specifics
60   intrinsic abs
61   intrinsic aint
62   intrinsic anint
63   intrinsic acos
64   intrinsic asin
65   intrinsic atan
66   intrinsic cos
67   intrinsic sin
68   intrinsic tan
69   intrinsic cosh
70   intrinsic sinh
71   intrinsic tanh
72   intrinsic alog
73   intrinsic exp
74   intrinsic sign
75   intrinsic amod
76
77   intrinsic dabs
78   intrinsic dint
79   intrinsic dnint
80   intrinsic dacos
81   intrinsic dasin
82   intrinsic datan
83   intrinsic dcos
84   intrinsic dsin
85   intrinsic dtan
86   intrinsic dcosh
87   intrinsic dsinh
88   intrinsic dtanh
89   intrinsic dlog
90   intrinsic dexp
91   intrinsic dsign
92   intrinsic dmod
93
94   intrinsic dprod
95
96   !TODO: Also test complex variants
97
98   call test_r (abs, -1.0, abs(-1.0))
99   call test_r (aint, 1.7, 1.0)
100   call test_r (anint, 1.7, 2.0)
101   call test_r (acos, 0.5, acos(0.5))
102   call test_r (asin, 0.5, asin(0.5))
103   call test_r (atan, 0.5, atan(0.5))
104   call test_r (cos, 1.0, cos(1.0))
105   call test_r (sin, 1.0, sin(1.0))
106   call test_r (tan, 1.0, tan(1.0))
107   call test_r (cosh, 1.0, cosh(1.0))
108   call test_r (sinh, 1.0, sinh(1.0))
109   call test_r (tanh, 1.0, tanh(1.0))
110   call test_r (alog, 2.0, alog(2.0))
111   call test_r (exp, 1.0, exp(1.0))
112   call test_r2 (sign, 1.0, -2.0, sign(1.0, -2.0))
113   call test_r2 (amod, 3.5, 2.0, amod(3.5, 2.0))
114   
115   call test_d (dabs, -1d0, abs(-1d0))
116   call test_d (dint, 1.7d0, 1d0)
117   call test_d (dnint, 1.7d0, 2d0)
118   call test_d (dacos, 0.5d0, dacos(0.5d0))
119   call test_d (dasin, 0.5d0, dasin(0.5d0))
120   call test_d (datan, 0.5d0, datan(0.5d0))
121   call test_d (dcos, 1d0, dcos(1d0))
122   call test_d (dsin, 1d0, dsin(1d0))
123   call test_d (dtan, 1d0, dtan(1d0))
124   call test_d (dcosh, 1d0, dcosh(1d0))
125   call test_d (dsinh, 1d0, dsinh(1d0))
126   call test_d (dtanh, 1d0, dtanh(1d0))
127   call test_d (dlog, 2d0, dlog(2d0))
128   call test_d (dexp, 1d0, dexp(1d0))
129   call test_d2 (dsign, 1d0, -2d0, sign(1d0, -2d0))
130   call test_d2 (dmod, 3.5d0, 2d0, dmod(3.5d0, 2d0))
131
132   call test_dprod(dprod)
133 end program
134