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

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [gcc/] [testsuite/] [gfortran.dg/] [specifics_1.f90] - Blame information for rev 694

Details | Compare with Previous | View Log

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

powered by: WebSVN 2.1.0

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