source: project/release/4/mathh/trunk/tests/mathh-test.scm @ 34558

Last change on this file since 34558 was 34558, checked in by Kon Lovett, 2 years ago

"fix" 1340

File size: 4.6 KB
Line 
1;;;; mathh-test
2;;;; Kon Lovett, May '17
3
4;;;; Issues
5;;;;
6
7(require-extension test)
8
9;;;
10
11(require-extension mathh)
12
13;;
14
15(test-group "ISO C Functions"
16
17        (test 1.0 (bessel-j0 0.0))
18        (test 0.0 (bessel-j1 0.0))
19        (test 1.0 (bessel-jn 0 0.0))
20        (test 0.0 (bessel-jn 1 0.0))
21
22        (test 0.088256964215677 (bessel-y0 1.0))
23        (test -0.781212821300289 (bessel-y1 1.0))
24        (test 0.088256964215677 (bessel-yn 0 1.0))
25        (test -0.781212821300289 (bessel-yn 1 1.0))
26
27        (test 1.0 (cosh 0.0))
28        (test 0.0 (sinh 0.0))
29        (test 0.0 (tanh 0.0))
30
31        (test 5.0 (hypot -5.0 0))
32
33        (test 1.0 (tgamma 1.0))
34        (test 0.0 (lgamma 1.0))
35
36        (test 2.0 (log10 100.0))
37        (test 3.0 (log2 8.0))
38        (test 0.0 (log1p 0.0))
39
40        (test 0.0 (fpmod 0.0 1.0))
41
42        (test (values 5.0 0.5) (modf 5.5))
43
44        (test 20.0 (ldexp 5.0 2))
45
46        (test 20.0 (scalbn 5.0 2))
47
48        (test (values 0.536870912 -30) (frexp 5.0e-10))
49)
50
51;;
52
53(test-group "BSD Functions"
54
55        (test-assert (signbit -1.0))
56        (test-assert (not (signbit 1.0)))
57        (test-assert (signbit -0.0))
58
59        (test -1.0 (copysign 1.0 -1.0))
60        (test 1.0 (copysign -1.0 1.0))
61
62        (test 1.0 (nextafter 1.0 -1.0))
63        (test -1.0 (nextafter -1.0 1.0))
64
65        (test 2.4662 (cbrt 15.0))
66)
67
68;;
69
70(test-group "Function fpclass"
71
72        (test 'negative-infinite (fpclass -inf.0))
73        (test 'signaling-nan (fpclass -nan.0))
74        (test 'negative-zero (fpclass -0.0))
75        (test 'positive-normal (fpclass 0.741573033707865))
76        (test 'positive-normal (fpclass (fp/ 33.0 44.5)))
77)
78
79;;
80
81(test-group "Function fpclassify"
82
83        (test 'infinite (fpclassify -inf.0))
84        (test 'nan (fpclassify -nan.0))
85        (test 'zero (fpclassify -0.0))
86        (test 'normal (fpclassify 0.741573033707865))
87        (test 'normal (fpclassify (fp/ 33.0 44.5)))
88)
89
90;;;
91
92(require-extension fp-utils)
93
94(define-constant 5eps (fp/ 9.0 1e06))
95(define-constant 4eps (fp/ 9.0 1e05))
96
97(test-group "FP Utils"
98
99  (test-assert (fpzero? 0.0))
100  (test-assert (not (fpzero? 1.0)))
101  (test-assert (not (fpzero? maximum-flonum)))
102  (test-assert (not (fpzero? minimum-flonum)))
103
104  (test-assert (not (fppositive? 0.0)))
105  (test-assert (not (fppositive? (fpneg minimum-flonum))))
106  (test-assert (fppositive? maximum-flonum))
107
108  (test-assert (fpcardinal? 0.0))
109  (test-assert (not (fpcardinal? (fpneg minimum-flonum))))
110  (test-assert (fpcardinal? maximum-flonum))
111
112  (test-assert (not (fpnegative? 0.0)))
113  (test-assert (fpnegative? (fpneg minimum-flonum)))
114  (test-assert (not (fpnegative? maximum-flonum)))
115
116        (test-assert (not (fpeven? 7.0)))
117        (test-assert (fpeven? 6.0))
118        (test-assert (not (fpodd? 6.0)))
119        (test-assert (fpodd? 7.0))
120
121        (test-assert (flonum? (fprandom)))
122        (test-assert (flonum? (fprandom 2456)))
123
124        (test 4.0 (fpadd1 3.0))
125        (test 2.0 (fpsub1 3.0))
126
127        (test 27.0 (fpcub 3.0))
128
129        (test 1.0 (fpmodulo 5.0 2.0))
130        (test 0.0 (fpmodulo 0.0 1.0))
131
132        (test 2.0 (fpquotient 5.0 2.0))
133        (test 1.0 (fpremainder 5.0 2.0))
134
135        (test-assert (fp~= 0.123456 0.123457 5eps))
136        (test-assert (fp~<= 0.123456 0.123457 5eps))
137        (test-assert (fp~>= 0.123456 0.123457 5eps))
138        (test-assert (fp~<= 0.123456 0.12346 5eps))
139        (test-assert (fp~>= 0.123456 0.12344 5eps))
140
141  (parameterize ((current-test-epsilon 4eps))
142          (test 5.6568 (fpdistance 1.0 1.0 5.0 5.0)) )
143
144        (receive (mx mn) (fpmax-and-min 1.0 -1.0 -16.0 13.0 2.0 16.0 7.0 -8.0)
145          (test "fpmax-and-min max" 16.0 mx)
146          (test "fpmax-and-min min" -16.0 mn) )
147)
148
149;;;
150
151(require-extension fx-utils)
152
153(test-group "FX Utils"
154
155  (test-assert (fxzero? 0))
156  (test-assert (not (fxzero? 1)))
157  (test-assert (not (fxzero? most-positive-fixnum)))
158  (test-assert (not (fxzero? most-negative-fixnum)))
159
160  (test-assert (not (fxpositive? 0)))
161  (test-assert (not (fxpositive? most-negative-fixnum)))
162  (test-assert (fxpositive? most-positive-fixnum))
163
164  (test-assert (fxcardinal? 0))
165  (test-assert (not (fxcardinal? most-negative-fixnum)))
166  (test-assert (fxcardinal? most-positive-fixnum))
167
168  (test-assert (not (fxnegative? 0)))
169  (test-assert (fxnegative? most-negative-fixnum))
170  (test-assert (not (fxnegative? most-positive-fixnum)))
171
172        (test-assert (fixnum? (fxrandom)))
173        (test-assert (fixnum? (fxrandom 2456)))
174
175        (test 4 (fxadd1 3))
176        (test 2 (fxsub1 3))
177
178        (test 27 (fxcub 3))
179
180        (test 8 (fxpow2log2 3))
181
182        (test 16 (fxdistance 1 1 5 5))
183
184        (receive (mx mn) (fxmax-and-min 1 -1 -16 13 2 16 7 -8)
185          (test "fxmax-and-min max" 16 mx)
186          (test "fxmax-and-min min" -16 mn) )
187)
188
189;;;
190
191;(import (prefix mathh-consts C:))
192;(require-library mathh-consts)
193;=> C:sqrt2 C:degree C:ln2 C:log2e C:e
194(require-extension mathh-consts)
195
196(test-group "Math Constants"
197
198        ; Well, some
199        (test sqrt2 (sqrt 2.0))
200        (test degree (/ pi 180.0))
201        (test ln2 (log 2.0))
202        (test log2e (log2 e))
203)
204
205;;;
206
207(test-group "Inline failure #1340"
208  (define (factorial x)
209    (gamma (+ 1 x)) )
210  (test 362880.0 (factorial 9))
211)
212
213;;;
214
215(test-exit)
Note: See TracBrowser for help on using the repository browser.