OpenCores
URL https://opencores.org/ocsvn/openrisc/openrisc/trunk

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-old/] [gcc-4.2.2/] [gcc/] [testsuite/] [gfortran.fortran-torture/] [execute/] [specifics.f90] - Blame information for rev 816

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 149 jeremybenn
! Program to test intrinsic functions as actual arguments
2
!
3
! Please keep the content of this file in sync with gfortran.dg/specifics_1.f90
4
subroutine test_c(fn, val, res)
5
  complex fn
6
  complex val, res
7
 
8
  if (diff(fn(val),res)) call abort
9
contains
10
function diff(a,b)
11
  complex a,b
12
  logical diff
13
  diff = (abs(a - b) .gt. 0.00001)
14
end function
15
end subroutine
16
 
17
subroutine test_z(fn, val, res)
18
  double complex fn
19
  double complex val, res
20
 
21
  if (diff(fn(val),res)) call abort
22
contains
23
function diff(a,b)
24
  double complex a,b
25
  logical diff
26
  diff = (abs(a - b) .gt. 0.00001)
27
end function
28
end subroutine
29
 
30
subroutine test_cabs(fn, val, res)
31
  real fn, res
32
  complex val
33
 
34
  if (diff(fn(val),res)) call abort
35
contains
36
function diff(a,b)
37
  real a,b
38
  logical diff
39
  diff = (abs(a - b) .gt. 0.00001)
40
end function
41
end subroutine
42
 
43
subroutine test_cdabs(fn, val, res)
44
  double precision fn, res
45
  double complex val
46
 
47
  if (diff(fn(val),res)) call abort
48
contains
49
function diff(a,b)
50
  double precision a,b
51
  logical diff
52
  diff = (abs(a - b) .gt. 0.00001)
53
end function
54
end subroutine
55
 
56
subroutine test_r(fn, val, res)
57
  real fn
58
  real val, res
59
 
60
  if (diff(fn(val), res)) call abort
61
contains
62
function diff(a, b)
63
  real a, b
64
  logical diff
65
  diff = (abs(a - b) .gt. 0.00001)
66
end function
67
end subroutine
68
 
69
subroutine test_d(fn, val, res)
70
  double precision fn
71
  double precision val, res
72
 
73
  if (diff(fn(val), res)) call abort
74
contains
75
function diff(a, b)
76
  double precision a, b
77
  logical diff
78
  diff = (abs(a - b) .gt. 0.00001d0)
79
end function
80
end subroutine
81
 
82
subroutine test_r2(fn, val1, val2, res)
83
  real fn
84
  real val1, val2, res
85
 
86
  if (diff(fn(val1, val2), res)) call abort
87
contains
88
function diff(a, b)
89
  real a, b
90
  logical diff
91
  diff = (abs(a - b) .gt. 0.00001)
92
end function
93
end subroutine
94
 
95
subroutine test_d2(fn, val1, val2, res)
96
  double precision fn
97
  double precision val1, val2, res
98
 
99
  if (diff(fn(val1, val2), res)) call abort
100
contains
101
function diff(a, b)
102
  double precision a, b
103
  logical diff
104
  diff = (abs(a - b) .gt. 0.00001d0)
105
end function
106
end subroutine
107
 
108
subroutine test_dprod(fn)
109
  double precision fn
110
  if (abs (fn (2.0, 3.0) - 6d0) .gt. 0.00001) call abort
111
end subroutine
112
 
113
subroutine test_nint(fn,val,res)
114
  integer fn, res
115
  real val
116
  if (res .ne. fn(val)) call abort
117
end subroutine
118
 
119
subroutine test_idnint(fn,val,res)
120
  integer fn, res
121
  double precision val
122
  if (res .ne. fn(val)) call abort
123
end subroutine
124
 
125
subroutine test_idim(fn,val1,val2,res)
126
  integer fn, res, val1, val2
127
  if (res .ne. fn(val1,val2)) call abort
128
end subroutine
129
 
130
subroutine test_iabs(fn,val,res)
131
  integer fn, res, val
132
  if (res .ne. fn(val)) call abort
133
end subroutine
134
 
135
subroutine test_len(fn,val,res)
136
  integer fn, res
137
  character(len=*) val
138
  if (res .ne. fn(val)) call abort
139
end subroutine
140
 
141
subroutine test_index(fn,val1,val2,res)
142
  integer fn, res
143
  character(len=*) val1, val2
144
  if (fn(val1,val2) .ne. res) call abort
145
end subroutine
146
 
147
program specifics
148
  intrinsic abs
149
  intrinsic aint
150
  intrinsic anint
151
  intrinsic acos
152
  intrinsic acosh
153
  intrinsic asin
154
  intrinsic asinh
155
  intrinsic atan
156
  intrinsic atanh
157
  intrinsic cos
158
  intrinsic sin
159
  intrinsic tan
160
  intrinsic cosh
161
  intrinsic sinh
162
  intrinsic tanh
163
  intrinsic alog
164
  intrinsic alog10
165
  intrinsic exp
166
  intrinsic sign
167
  intrinsic isign
168
  intrinsic amod
169
 
170
  intrinsic dabs
171
  intrinsic dint
172
  intrinsic dnint
173
  intrinsic dacos
174
  intrinsic dacosh
175
  intrinsic dasin
176
  intrinsic dasinh
177
  intrinsic datan
178
  intrinsic datanh
179
  intrinsic dcos
180
  intrinsic dsin
181
  intrinsic dtan
182
  intrinsic dcosh
183
  intrinsic dsinh
184
  intrinsic dtanh
185
  intrinsic dlog
186
  intrinsic dlog10
187
  intrinsic dexp
188
  intrinsic dsign
189
  intrinsic dmod
190
 
191
  intrinsic conjg
192
  intrinsic ccos
193
  intrinsic cexp
194
  intrinsic clog
195
  intrinsic csin
196
  intrinsic csqrt
197
 
198
  intrinsic dconjg
199
  intrinsic cdcos
200
  intrinsic cdexp
201
  intrinsic cdlog
202
  intrinsic cdsin
203
  intrinsic cdsqrt
204
  intrinsic zcos
205
  intrinsic zexp
206
  intrinsic zlog
207
  intrinsic zsin
208
  intrinsic zsqrt
209
 
210
  intrinsic cabs
211
  intrinsic cdabs
212
  intrinsic zabs
213
 
214
  intrinsic dprod
215
 
216
  intrinsic nint
217
  intrinsic idnint
218
  intrinsic dim
219
  intrinsic ddim
220
  intrinsic idim
221
  intrinsic iabs
222
  intrinsic mod
223
  intrinsic len
224
  intrinsic index
225
 
226
  intrinsic aimag
227
  intrinsic dimag
228
 
229
  call test_r (abs, -1.0, abs(-1.0))
230
  call test_r (aint, 1.7, aint(1.7))
231
  call test_r (anint, 1.7, anint(1.7))
232
  call test_r (acos, 0.5, acos(0.5))
233
  call test_r (acosh, 1.5, acosh(1.5))
234
  call test_r (asin, 0.5, asin(0.5))
235
  call test_r (asinh, 0.5, asinh(0.5))
236
  call test_r (atan, 0.5, atan(0.5))
237
  call test_r (atanh, 0.5, atanh(0.5))
238
  call test_r (cos, 1.0, cos(1.0))
239
  call test_r (sin, 1.0, sin(1.0))
240
  call test_r (tan, 1.0, tan(1.0))
241
  call test_r (cosh, 1.0, cosh(1.0))
242
  call test_r (sinh, 1.0, sinh(1.0))
243
  call test_r (tanh, 1.0, tanh(1.0))
244
  call test_r (alog, 2.0, alog(2.0))
245
  call test_r (alog10, 2.0, alog10(2.0))
246
  call test_r (exp, 1.0, exp(1.0))
247
  call test_r2 (sign, 1.0, -2.0, sign(1.0, -2.0))
248
  call test_r2 (amod, 3.5, 2.0, amod(3.5, 2.0))
249
 
250
  call test_d (dabs, -1d0, abs(-1d0))
251
  call test_d (dint, 1.7d0, 1d0)
252
  call test_d (dnint, 1.7d0, 2d0)
253
  call test_d (dacos, 0.5d0, dacos(0.5d0))
254
  call test_d (dacosh, 1.5d0, dacosh(1.5d0))
255
  call test_d (dasin, 0.5d0, dasin(0.5d0))
256
  call test_d (dasinh, 0.5d0, dasinh(0.5d0))
257
  call test_d (datan, 0.5d0, datan(0.5d0))
258
  call test_d (datanh, 0.5d0, datanh(0.5d0))
259
  call test_d (dcos, 1d0, dcos(1d0))
260
  call test_d (dsin, 1d0, dsin(1d0))
261
  call test_d (dtan, 1d0, dtan(1d0))
262
  call test_d (dcosh, 1d0, dcosh(1d0))
263
  call test_d (dsinh, 1d0, dsinh(1d0))
264
  call test_d (dtanh, 1d0, dtanh(1d0))
265
  call test_d (dlog, 2d0, dlog(2d0))
266
  call test_d (dlog10, 2d0, dlog10(2d0))
267
  call test_d (dexp, 1d0, dexp(1d0))
268
  call test_d2 (dsign, 1d0, -2d0, sign(1d0, -2d0))
269
  call test_d2 (dmod, 3.5d0, 2d0, dmod(3.5d0, 2d0))
270
 
271
  call test_dprod (dprod)
272
 
273
  call test_c (conjg, (1.2,-4.), conjg((1.2,-4.)))
274
  call test_c (ccos, (1.2,-4.), ccos((1.2,-4.)))
275
  call test_c (cexp, (1.2,-4.), cexp((1.2,-4.)))
276
  call test_c (clog, (1.2,-4.), clog((1.2,-4.)))
277
  call test_c (csin, (1.2,-4.), csin((1.2,-4.)))
278
  call test_c (csqrt, (1.2,-4.), csqrt((1.2,-4.)))
279
 
280
  call test_z (dconjg, (1.2d0,-4.d0), dconjg((1.2d0,-4.d0)))
281
  call test_z (cdcos, (1.2d0,-4.d0), cdcos((1.2d0,-4.d0)))
282
  call test_z (zcos, (1.2d0,-4.d0), zcos((1.2d0,-4.d0)))
283
  call test_z (cdexp, (1.2d0,-4.d0), cdexp((1.2d0,-4.d0)))
284
  call test_z (zexp, (1.2d0,-4.d0), zexp((1.2d0,-4.d0)))
285
  call test_z (cdlog, (1.2d0,-4.d0), cdlog((1.2d0,-4.d0)))
286
  call test_z (zlog, (1.2d0,-4.d0), zlog((1.2d0,-4.d0)))
287
  call test_z (cdsin, (1.2d0,-4.d0), cdsin((1.2d0,-4.d0)))
288
  call test_z (zsin, (1.2d0,-4.d0), zsin((1.2d0,-4.d0)))
289
  call test_z (cdsqrt, (1.2d0,-4.d0), cdsqrt((1.2d0,-4.d0)))
290
  call test_z (zsqrt, (1.2d0,-4.d0), zsqrt((1.2d0,-4.d0)))
291
 
292
  call test_cabs (cabs, (1.2,-4.), cabs((1.2,-4.)))
293
  call test_cdabs (cdabs, (1.2d0,-4.d0), cdabs((1.2d0,-4.d0)))
294
  call test_cdabs (zabs, (1.2d0,-4.d0), zabs((1.2d0,-4.d0)))
295
  call test_cabs (aimag, (1.2,-4.), aimag((1.2,-4.)))
296
  call test_cdabs (dimag, (1.2d0,-4.d0), dimag((1.2d0,-4.d0)))
297
 
298
  call test_nint (nint, -1.2, nint(-1.2))
299
  call test_idnint (idnint, -1.2d0, idnint(-1.2d0))
300
  call test_idim (isign, -42, 17, isign(-42, 17))
301
  call test_idim (idim, -42, 17, idim(-42,17))
302
  call test_idim (idim, 42, 17, idim(42,17))
303
  call test_r2 (dim, 1.2, -4., dim(1.2, -4.))
304
  call test_d2 (ddim, 1.2d0, -4.d0, ddim(1.2d0, -4.d0))
305
  call test_iabs (iabs, -7, iabs(-7))
306
  call test_idim (mod, 5, 2, mod(5,2))
307
  call test_len (len, "foobar", len("foobar"))
308
  call test_index (index, "foobarfoobar", "bar", index("foobarfoobar","bar"))
309
 
310
end program
311
 

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.