1\ Copyright (c) 2006-2019 Michael Scholz <mi-scholz@users.sourceforge.net>
2\ All rights reserved.
3\
4\ Redistribution and use in source and binary forms, with or without
5\ modification, are permitted provided that the following conditions
6\ are met:
7\ 1. Redistributions of source code must retain the above copyright
8\    notice, this list of conditions and the following disclaimer.
9\ 2. Redistributions in binary form must reproduce the above copyright
10\    notice, this list of conditions and the following disclaimer in the
11\    documentation and/or other materials provided with the distribution.
12\
13\ THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND
14\ ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
15\ IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
16\ ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE
17\ FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
18\ DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
19\ OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
20\ HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
21\ LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
22\ OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
23\ SUCH DAMAGE.
24\
25\ @(#)numbers-test.fs	1.32 11/27/19
26
27require test-utils.fs
28
29: fneq-err ( r1 r2 err -- f )
30	-rot f- fabs f<=
31;
32
33: cneq-err { c1 c2 err -- f }
34	c1 real-ref c2 real-ref err fneq-err
35	c1 imag-ref c2 imag-ref err fneq-err or
36;
37
38: fneq ( a b -- f )
39	0.001 fneq-err
40;
41
42: cneq ( a b -- f )
43	0.001 cneq-err
44;
45
46'complex provided? [if]
47	: complex-test ( -- )
48		1.0+1.0i complex?  not "complex? (complex)?"    test-expr
49		1.0+1.0i inexact?  not "inexact? (complex)?"    test-expr
50		1.0+1.0i number?   not "number? (complex)?"     test-expr
51		1.0+1.0i bignum?       "bignum? (complex)?"     test-expr
52		1.0+1.0i exact?        "exact? (complex)?"      test-expr
53		1.0+1.0i fixnum?       "fixnum? (complex)?"     test-expr
54		1.0+1.0i float?        "float? (complex)?"      test-expr
55		1.0+1.0i integer?      "integer? (complex)?"    test-expr
56		1.0+1.0i long-long?    "long-long? (complex)?"  test-expr
57		1.0+1.0i rational?     "rational? (complex)?"   test-expr
58		1.0+1.0i ulong-long?   "ulong-long? (complex)?" test-expr
59		1.0+1.0i unsigned?     "unsigned? (complex)?"   test-expr
60		\ real-ref
61		1+1i real-ref 1.0 f<> "1+1i real-ref 1.0 f<>?" test-expr
62		1    real-ref 1.0 f<> "1 real-ref 1.0 f<>?" test-expr
63		\ imag-ref
64		1+1i imag-ref 1.0 f<> "1+1i imag-ref 1.0 f<>?" test-expr
65		1    imag-ref 0.0 f<> "1 imag-ref 0.0 f<>?" test-expr
66		\ make-rectangular (alias >complex)
67		0.5 0.5 make-rectangular 0.5+0.5i c<>
68		"0.5 0.5 make-rectangular 0.5+0.5i c<>?" test-expr
69		3 1 >complex 3+1i c<> "3 1 >complex 3+1i c<>?" test-expr
70		\ make-polar
71		0.5 0.5 make-polar 0.438791+0.239713i cneq
72		"0.5 0.5 make-polar 0.438791+0.239713i cneq?" test-expr
73		3 1 make-polar 1.620906+2.524413i cneq
74		"3 1 make-polar 1.620906+2.524413i cneq?" test-expr
75		\ s>c (aliases: >c f>c q>c)
76		1   s>c 1+0i c<> "1 s>c 1+0i c<>?" test-expr
77		1.0 f>c 1+0i c<> "1.0 f>c 1+0i c<>?" test-expr
78		\ c>s
79		1+1i c>s 1 <> "1+1i c>s 1 <>?" test-expr
80		1+1i c>s fixnum? not "1+1i c>s (fixnum?)" test-expr
81		\ c>f
82		1+1i c>f 1.0 f<> "1+1i c>f 1.0 f<>?" test-expr
83		1+1i c>f float? not "1+1i c>f (float?)" test-expr
84		\ c0=
85		0+0i c0= not "0+0i c0= not?" test-expr
86		0    c0= not "0 c0= not?" test-expr
87		0.0  c0= not "0.0 c0= not?" test-expr
88		\ c0<>
89		0+0i c0<> "0+0i c0<>?" test-expr
90		0    c0<> "0 c0<>?" test-expr
91		0.0  c0<> "0.0 c0<>?" test-expr
92		\ c=
93		1+1i 1.0+1.0i c= not "1+1i 1.0+1.0i c= not?" test-expr
94		1    1+0i     c= not "1 1+0i c= not?" test-expr
95		1.0  1+0i     c= not "1.0 1+0i c= not?" test-expr
96		\ c<>
97		1+1i 1.0+1.0i c<> "1+1i 1.0+1.0i c<>?" test-expr
98		1    1+0i     c<> "1 1+0i c<>?" test-expr
99		1.0  1+0i     c<> "1.0 1+0i c<>?" test-expr
100		\ c+
101		1i 1i c+ 2+2i c<> "1i 1i c+ 2+2i c<>?" test-expr
102		1  1  c+ 2+0i c<> "1 1 c+ 2+0i c<>?" test-expr
103		1e 1e c+ 2+0i c<> "1e 1e c+ 2+0i c<>?" test-expr
104		\ c-
105		1i 1i c- c0<> "1i 1i c- c0<>?" test-expr
106		1  1  c- c0<> "1 1 c- c0<>?" test-expr
107		1e 1e c- c0<> "1e 1e c- c0<>?" test-expr
108		\ c*
109		1i 1i c* 0+2i c<> "1i 1i c* 0+2i c<>?" test-expr
110		1  1  c* 1+0i c<> "1 1 c* 1+0i c<>?" test-expr
111		1e 1e c* 1+0i c<> "1e 1e c* 1+0i c<>?" test-expr
112		\ c/
113		1i 1i c/ 1+0i c<> "1i 1i c/ 1+0i c<>?" test-expr
114		1  1  c/ 1+0i c<> "1 1 c/ 1+0i c<>?" test-expr
115		1e 1e c/ 1+0i c<> "1e 1e c/ 1+0i c<>?" test-expr
116		\ 1/c
117		1i 1/c 0.5-0.5i c<> "1i 1/c 0.5-0.5i c<>?" test-expr
118		1  1/c 1+0i     c<> "1 1/c 1+0i c<>?" test-expr
119		1e 1/c 1+0i     c<> "1e 1/c 1+0i c<>?" test-expr
120		\ math.h/fth.h complex functions
121		1+1i carg       0.785398 fneq "carg?" test-expr
122		1+1i cabs       1.41421  fneq "cabs?" test-expr
123		1-1i cabs2      2.0      f<>  "cabs2?" test-expr
124		1+1i 2+0.5i c+  3.0+1.5i cneq "c+?" test-expr
125		1+1i 2+0.5i c- -1.0+0.5i cneq "c-?" test-expr
126		1+1i 2+0.5i c*  1.5+2.5i cneq "c*?" test-expr
127		1+1i 2+0.5i c/  0.588235+0.352941i cneq "c/?" test-expr
128		1.5+2.5i   1/c  0.176471-0.294118i cneq "1/c?" test-expr
129		1+1i 2+0.5i c** -0.232848+1.33024i cneq "c**?" test-expr
130		1+1i conjugate  1-1i               cneq "conjugate?" test-expr
131		1+1i csqrt      1.09868+0.45509i   cneq "csqrt?" test-expr
132		1+1i cexp       1.46869+2.28736i   cneq "cexp?" test-expr
133		1+1i clog       0.34657+0.7854i    cneq "clog?" test-expr
134		1+1i clog10     0.150515+0.341094i cneq "clog10?" test-expr
135		1+1i csin       1.29846+0.634964i  cneq "csin?" test-expr
136		1+1i ccos       0.83373-0.988898i  cneq "ccos?" test-expr
137		1+1i ctan       0.271753+1.08392i  cneq "ctan?" test-expr
138		1+1i casin      0.666239+1.06128i  cneq "casin?" test-expr
139		1+1i cacos      0.904557-1.06128i  cneq "cacos?" test-expr
140		1+1i catan      1.01722+0.402359i  cneq "catan?" test-expr
141		1+1i 1+1i catan2 0.785398+0i       cneq "catan2?" test-expr
142		1+1i csinh      0.634964+1.29846i  cneq "csinh?" test-expr
143		1+1i ccosh      0.83373+0.988898i  cneq "ccosh?" test-expr
144		1+1i ctanh      1.08392+0.271753i  cneq "ctanh?" test-expr
145		1+1i casinh     1.06128+0.666239i  cneq "casinh?" test-expr
146		1+1i cacosh     1.06128+0.904557i  cneq "cacosh?" test-expr
147		1+1i catanh     0.402359+1.01722i  cneq "catanh?" test-expr
148	;
149[else]
150	<'> noop alias complex-test ( -- )
151[then]
152
153'bignum provided? [if]
154	: bignum-test ( -- )
155		12 s>d { d12 }
156		12 s>b { b12 }
157		123456789012345678901234567890 { bn1 }
158		-123456789012345678901234567890 { bn1-neg }
159		123456789012345678901234567891 { bn1+1 }
160		246913578024691357802469135780 { bn1+bn1 }
161		123456789012345678901234567889 { bn1-1 }
162		-123456789012345678901234567889 { bn1-1-neg }
163		1234567890123456789012345678900 { bn1*10 }	\ big * 10
164		15241578753238836750495351562536198787501905199875019052100
165		    { bn1*bn1 }
166		12345678901234567890123456789 { bn1/10 }
167		61728394506172839450617283945 { bn1/2 }
168		\ bignum?
169		bn1 bignum? not "bignum? (bignum)?" test-expr
170		bn1 exact? not "exact? (bignum)?" test-expr
171		bn1 integer? not "integer? (bignum)?" test-expr
172		bn1 number? not "number? (bignum)?" test-expr
173		bn1 unsigned? not "unsigned? (bignum)?" test-expr
174		bn1 complex? "complex? (bignum)?" test-expr
175		bn1 fixnum? "fixnum? (bignum)?" test-expr
176		bn1 float? "float? (bignum)?" test-expr
177		bn1 inexact? "inexact? (bignum)?" test-expr
178		bn1 long-long? "long-long? (big)?" test-expr
179		bn1 rational? "rational? (bignum)?" test-expr
180		bn1 ulong-long? "ulong-long? (big)?" test-expr
181		\ >bignum
182		123 >bignum bignum? not "123 >bignum (bignum)?" test-expr
183		12e >bignum bignum? not "12e >bignum (bignum)?" test-expr
184		d12 >bignum bignum? not "12d >bignum (bignum)?" test-expr
185		1/2 >bignum bignum? not "1/2 >bignum (bignum)?" test-expr
186		\ s>b f>b
187		123 s>b bignum? not "123 s>b (bignum)?" test-expr
188		12e f>b bignum? not "12e f>b (bignum)?" test-expr
189		\ b>s b>f
190		b12 b>s 12   <> "b12 b>s 12 <>?" test-expr
191		b12 b>f 12e f<> "b12 f>s 12e f<>?" test-expr
192		\ b0=
193		0 b0= not "0 b0=" test-expr
194		bn1 b0= "big b0=" test-expr
195		\ b0<>
196		0 b0<> "0 b0<>" test-expr
197		bn1 b0<> not "big b0<>" test-expr
198		\ b0<
199		-1 b0< not "-1 b0<" test-expr
200		bn1-neg b0< not "-big b0<" test-expr
201		bn1 b0< "big b0<" test-expr
202		\ b0>
203		1 b0> not "1 b0>" test-expr
204		bn1 b0> not "big b0>" test-expr
205		bn1-neg b0> "-big b0>" test-expr
206		\ b0<=
207		0 b0<= not "0 b0<=" test-expr
208		bn1-neg b0<= not "-big b0<=" test-expr
209		bn1 b0<= "big b0<=" test-expr
210		\ b0>=
211		0 b0>= not "0 b0>=" test-expr
212		bn1 b0>= not "big b0>=" test-expr
213		bn1-neg b0>= "-big b0>=" test-expr
214		\ b=
215		1 1 b= not "1 1 b=?" test-expr
216		bn1 1 b= "big 1 b=?" test-expr
217		bn1 bn1 b= not "big big b=?" test-expr
218		\ b<>
219		1 1 b<> "1 1 b<>?" test-expr
220		bn1 1 b<> not "big 1 b<>?" test-expr
221		bn1 bn1 b<> "big big b<>?" test-expr
222		\ b<
223		1 1 b< "1 1 b<?" test-expr
224		bn1 1 b< "big 1 b<?" test-expr
225		bn1 bn1 b< "big big b<?" test-expr
226		\ b>
227		1 1 b> "1 1 b>?" test-expr
228		bn1 1 b> not "big 1 b>?" test-expr
229		bn1 bn1 b> "big big b>?" test-expr
230		\ b<=
231		1 1 b<= not "1 1 b<=?" test-expr
232		bn1 1 b<= "big 1 b<=?" test-expr
233		bn1 bn1 b<= not "big big b<=?" test-expr
234		\ b>=
235		1 1 b>= not "1 1 b>=?" test-expr
236		bn1 1 b>= not "big 1 b>=?" test-expr
237		bn1 bn1 b>= not "big big b>=?" test-expr
238		\ b+
239		1 1 b+ 2 b= not "1 1 b+ 2 b=?" test-expr
240		1 1 b+ bignum? not "1 1 b+ (bignum)?" test-expr
241		bn1 1 b+ bn1+1 b= not "big 1 b+ big+1 b=?" test-expr
242		1 bn1 b+ bn1+1 b= not "1 big b+ 1+big b=?" test-expr
243		bn1 1 b+ bignum? not "big 1 b+ (bignum)?" test-expr
244		1 bn1 b+ bignum? not "1 big b+ (bignum)?" test-expr
245		bn1 bn1 b+ bn1+bn1 b= not "big big b+ big+big b=?" test-expr
246		bn1 bn1 b+ bignum? not "big big b+ (bignum)?" test-expr
247		\ b-
248		1 1 b- 0 b= not "1 1 b- 0 b=?" test-expr
249		1 1 b- bignum? not "1 1 b- (bignum)?" test-expr
250		bn1 1 b- bn1-1 b= not "big 1 b- big-1 b=?" test-expr
251		1 bn1 b- bn1-1-neg b= not "1 big b- 1-big b=?" test-expr
252		bn1 1 b- bignum? not "big 1 b- (bignum)?" test-expr
253		1 bn1 b- bignum? not "1 big b- (bignum)?" test-expr
254		bn1 bn1	b- 0 b= not "big big b- big-big b=?" test-expr
255		bn1 bn1 b- bignum? not "big big b- (bignum)?" test-expr
256		\ b*
257		1 -1 b* -1 b= not "1 -1 b* -1 b=?" test-expr
258		1 -1 b* bignum? not "1 -1 b* (bignum)?" test-expr
259		bn1 10 b* bn1*10 b= not "big 10 b* big*10 b=?" test-expr
260		10 bn1 b* bn1*10 b= not "10 big b* 10*big b=?" test-expr
261		bn1 10 b* bignum? not "big 10 b* (bignum)?" test-expr
262		10 bn1 b* bignum? not "10 big b* (bignum)?" test-expr
263		bn1 bn1 b* bn1*bn1 b= not "big big b* big*big b=?" test-expr
264		bn1 bn1 b* bignum? not "big big b* (bignum)?" test-expr
265		\ b/
266		1 -1 b/ -1 b= not "1 -1 b/ -1 b=?" test-expr
267		1 -1 b/ bignum? not "1 -1 b/ (bignum)?" test-expr
268		bn1 10 b/ bn1/10 b= not "big 10 b/ big/10 b=?" test-expr
269		10 bn1 b/ 0 b= not "10 big b/ 0 b=?" test-expr
270		bn1 10 b/ bignum? not "big 10 b/ (bignum)?" test-expr
271		10 bn1 b/ bignum? not "10 big b/ (bignum)?" test-expr
272		bn1+bn1 bn1 b/ 2 b= not "big big b/ 2 b=?" test-expr
273		bn1+bn1 bn1 b/ bignum? not "big big b/ (bignum)?" test-expr
274		\ bgcd, blcm
275		1769 551 bgcd 29 b<> "1769 551 bgcd 29 b<>?" test-expr
276		31408 2718 bgcd 302 b<> "31408 2718 bgcd 302 b<>?" test-expr
277		40902 24140 bgcd 34 b<> "40902 24140 bgcd 34 b<>?" test-expr
278		7000 { u }
279		4400 { v }
280		u v bgcd 200 b<> "u v bgcd 200 b<>?" test-expr
281		u v blcm 154000 b<> "u v blcm 154000 b<>?" test-expr
282		u v bgcd u v blcm b*  u v b*  b<>
283		    "u v bgcd u v blcm b*  u v b*  b<>?" test-expr
284		40902 to u
285		24140 to v
286		u v blcm 29040420 b<> "u v blcm 29040420 b<>?" test-expr
287		u v b*  u v bgcd b/  u v blcm b<>
288		    "u v b*  u v bgcd b/  u v blcm b<>?" test-expr
289		\ b**
290		123456789012345678901234567890 10 b**
291		    822526259969628839104253165869933624624768975718986341753117113191672345101686635234711078432787527087114699126238380568851450669625883238384735536304145587136095844229774592556217075848515269880288897142287955821529180675549369033497201746908666410370342866279796500763077997366010000000000 b<>
292		    "big 10 b** big^10 b=?" test-expr
293		10 10 b** 10000000000 b<> "10 10 b** 10^10 b<>?" test-expr
294		1024 10 b** 1267650600228229401496703205376 b<>
295		    "1024 10 b** 1024^10 b<>?" test-expr
296		\ broot
297		123456788986481564509689970688 3 broot
298		    1 <> swap 4979338592 b<> ||
299		    "big 3 broot 1 big?" test-expr
300		123456788986481564509689970689 3 broot
301		    0<> swap 4979338592 b<> ||
302		    "big 3 broot 0 big?" test-expr
303		\ bsqrt
304		123456789012345380023044696196 bsqrt
305		    1 <> swap 351364182882014 b<> ||
306		    "big bsqrt 1 big?" test-expr
307		123456789012345678901234567890 bsqrt
308		    0 <> swap 351364182882014 b<> ||
309		    "big bsqrt 0 big?" test-expr
310		\ bnegate
311		1 bnegate -1 b<> "1 bnegate -1 b<>?" test-expr
312		-1 bnegate 1 b<> "-1 bnegate 1 b<>?" test-expr
313		10 bnegate -10 b<> "10 bnegate -10 b<>?" test-expr
314		-10 bnegate 10 b<> "-10 bnegate 10 b<>?" test-expr
315		10 bnegate bignum? not "10 bnegate (bignum)?" test-expr
316		-10 bnegate bignum? not "-10 bnegate (bignum)?" test-expr
317		\ babs
318		1234567890 babs 1234567890 b<> "big babs big b<>?" test-expr
319		-1234567890 babs 1234567890 b<> "-big babs big b<>?" test-expr
320		10 babs 10 b<> "10 babs 10 b<>?" test-expr
321		-10 babs 10 b<> "-10 babs 10 b<>?" test-expr
322		10 babs bignum? not "10 babs (bignum)?" test-expr
323		-10 babs bignum? not "-10 babs (bignum)?" test-expr
324		\ bmin
325		1 2 bmin 1 b<> "1 2 bmin 1 b<>?" test-expr
326		2 1 bmin 1 b<> "2 1 bmin 1 b<>?" test-expr
327		1 2 bmin bignum? not "1 2 bmin (bignum)?" test-expr
328		\ bmax
329		1 2 bmax 2 b<> "1 2 bmax 2 b<>?" test-expr
330		2 1 bmax 2 b<> "2 1 bmax 2 b<>?" test-expr
331		1 2 bmax bignum? not "1 2 bmax (bignum)?" test-expr
332		\ b2*
333		10 b2* 20 b<> "10 b2* 20 b<>?" test-expr
334		10 b2* bignum? not "10 b2* (bignum)?" test-expr
335		\ b2/
336		10 b2/ 5 b<> "10 b2/ 5 b<>?" test-expr
337		10 b2/ bignum? not "10 b2/ (bignum)?" test-expr
338		\ bmod
339		bn1 2 bmod b0<> "big 2 bmod 0?" test-expr
340		bn1+1 2 bmod 1 b<> "big 2 bmod 1?" test-expr
341		\ b/mod
342		bn1 2 b/mod bn1/2 b<> swap b0<> ||
343		    "big 2 b/mod 0 big?" test-expr
344		bn1+1 2 b/mod bn1/2 b<> swap 1 b<> ||
345		    "big 2 b/mod 1 big?" test-expr
346		\ blshift
347		1234 4 blshift 19744 b<> "1234 4 blshift 19744 b<>?" test-expr
348		1234 4 blshift bignum? not "1234 4 blshift (bignum)?" test-expr
349		\ brshift
350		1232 4 brshift 77 b<> "1232 4 brshift 77 b<>?" test-expr
351		1232 4 brshift bignum? not "1232 4 brshift (bignum)?" test-expr
352		\ random => 0 .. amp
353		0.0 { rnd }
354		512 0 do
355			3.2 random to rnd
356			rnd    f0< "3.2 random f0<?"    test-expr
357			rnd 3.2 f> "3.2 random 3.2 f>?" test-expr
358		loop
359		\ frandom => -amp ... amp
360		0.0 to rnd
361		512 0 do
362			3.2 frandom to rnd
363			rnd -3.2 f< "3.2 frandom -3.2 f<?" test-expr
364			rnd  3.2 f> "3.2 frandom 3.2 f>?"  test-expr
365		loop
366	;
367[else]
368	<'> noop alias bignum-test ( -- )
369[then]
370
371'ratio provided? [if]
372	: ratio-test ( -- )
373		123456789012345678901234567890 { bn1 }
374		-123456789012345678901234567890 { bn1-neg }
375		\ ratio?
376		12345/6789 exact?    not "exact? (ratio)?"      test-expr
377		12345/6789 number?   not "number? (ratio)?"     test-expr
378		12345/6789 rational? not "rational? (ratio)?"   test-expr
379		12345/6789 bignum?       "bignum? (ratio)?"     test-expr
380		12345/6789 complex?      "complex? (ratio)?"    test-expr
381		12345/6789 fixnum?       "fixnum? (ratio)?"     test-expr
382		12345/6789 float?        "float? (ratio)?"      test-expr
383		12345/6789 inexact?      "inexact? (ratio)?"    test-expr
384		12345/6789 integer?      "integer? (ratio)?"    test-expr
385		12345/6789 long-long?    "long-long? (ratio)?"  test-expr
386		12345/6789 ulong-long?   "ulong-long? (ratio)?" test-expr
387		12345/6789 unsigned?     "unsigned? (ratio)?"   test-expr
388		\ make-ratio
389		123 456 make-ratio  41/152 q<>
390		    "123 456 make-ratio 41/152 q<>?" test-expr
391		355 113 make-ratio 355/113 q<>
392		    "355 113 make-ratio 355/113 q<>?" test-expr
393		\ >ratio
394		123/456 >ratio 123/456 q<>
395		    "123/456 >ratio 123/456 q<>?" test-expr
396		2 >ratio 2/1 q<> "2 >ratio 2/1 q<>?" test-expr
397		0.25 >ratio 1/4 q<> "0.25 >ratio 1/4 q<>?" test-expr
398		10 >llong >ratio  10/1 q<> "10d >ratio 10/1 q<>?" test-expr
399		10 >bignum >ratio 10/1 q<> "10b >ratio 10/1 q<>?" test-expr
400		\ q>s q>f
401		2/1 q>s 2    <> "2/1 q>s 2 <>?" test-expr
402		2/1 q>f 2.0 f<> "2/1 q>f 2.0 f<>?" test-expr
403		\ s>q f>q c>q
404		10  s>q 10/1 q<> "10 s>q 10/1 q<>?" test-expr
405		10e f>q 10/1 q<> "10e f>q 10/1 q<>?" test-expr
406		\ q0=
407		0/1 q0= not "0/1 q0= not?" test-expr
408		bn1 q0= "big q0=?" test-expr
409		bn1-neg q0= "-big q0=?" test-expr
410		10  q0=     "10 q0=?" test-expr
411		-10 q0=     "-10 q0=?" test-expr
412		\ q0<>
413		0/1 q0<>     "0/1 q0<>?" test-expr
414		bn1 q0<> not "big q0<> not?" test-expr
415		bn1-neg q0<> not "-big q0<> not?" test-expr
416		10  q0<> not "10 q0<> not?" test-expr
417		-10 q0<> not "-10 q0<> not?" test-expr
418		\ q0<
419		0/1 q0<     "0/1 q0<?" test-expr
420		bn1 q0< "big q0<?" test-expr
421		bn1-neg q0< not "-big q0< not?" test-expr
422		10  q0<     "10 q0<?" test-expr
423		-10 q0< not "-10 q0< not?" test-expr
424		\ q0>
425		0/1 q0>     "0/1 q0>?" test-expr
426		bn1 q0> not "big q0> not?" test-expr
427		bn1-neg q0> "-big q0>?" test-expr
428		10  q0> not "10 q0> not?" test-expr
429		-10 q0>     "-10 q0>?" test-expr
430		\ q0<=
431		0/1 q0<= not "0/1 q0<= not?" test-expr
432		bn1 q0<= "big q0<=?" test-expr
433		bn1-neg q0<= not "-big q0<= not?" test-expr
434		10  q0<=     "10 q0<=?" test-expr
435		-10 q0<= not "-10 q0<= not?" test-expr
436		\ q0>=
437		0/1 q0>= not "0/1 q0>= not?" test-expr
438		bn1 q0>= not "big q0>= not?" test-expr
439		bn1-neg q0>= "-big q0>=?" test-expr
440		10  q0>= not "10 q0>= not?" test-expr
441		-10 q0>=     "-10 q0>=?" test-expr
442		\ q=
443		1 1 b+ { bn2 }
444		1/2 2/1 q= "1/2 2/1 q=?" test-expr
445		1/2 2.0 q= "1/2 2.0 q=?" test-expr
446		0.5 2/1 q= "0.5 2/1 q=?" test-expr
447		1/2 bn2 q= "1/2 bn2 q=?" test-expr
448		bn2 1/2 q= "bn2 1/2 q=?" test-expr
449		1/2 2   q= "1/2 2 q=?" test-expr
450		2 1/2   q= "2 1/2 q=?" test-expr
451		\ q<>
452		1/2 2/1 q<> not "1/2 2/1 q<> not?" test-expr
453		1/2 2.0 q<> not "1/2 2.0 q<> not?" test-expr
454		0.5 2/1 q<> not "0.5 2/1 q<> not?" test-expr
455		1/2 bn2 q<> not "1/2 bn2 q<> not?" test-expr
456		bn2 1/2 q<> not "bn2 1/2 q<> not?" test-expr
457		1/2 2   q<> not "1/2 2 q<> not?" test-expr
458		2 1/2   q<> not "2 1/2 q<> not?" test-expr
459		\ q<
460		1/2 2/1 q< not "1/2 2/1 q< not?" test-expr
461		1/2 2.0 q< not "1/2 2.0 q< not?" test-expr
462		0.5 2/1 q< not "0.5 2/1 q< not?" test-expr
463		1/2 bn2 q< not "1/2 bn2 q< not?" test-expr
464		bn2 1/2 q<     "bn2 1/2 q<?" test-expr
465		1/2 2   q< not "1/2 2 q< not?" test-expr
466		2 1/2   q<     "2 1/2 q<?" test-expr
467		\ q>
468		1/2 2/1 q>     "1/2 2/1 q>?" test-expr
469		1/2 2.0 q>     "1/2 2.0 q>?" test-expr
470		0.5 2/1 q>     "0.5 2/1 q>?" test-expr
471		1/2 bn2 q>     "1/2 bn2 q>?" test-expr
472		bn2 1/2 q> not "bn2 1/2 q> not?" test-expr
473		1/2 2   q>     "1/2 2 q>?" test-expr
474		2 1/2   q> not "2 1/2 q> not?" test-expr
475		\ q<=
476		1/2 2/1 q<= not "1/2 2/1 q<= not?" test-expr
477		1/2 2.0 q<= not "1/2 2.0 q<= not?" test-expr
478		0.5 2/1 q<= not "0.5 2/1 q<= not?" test-expr
479		1/2 bn2 q<= not "1/2 bn2 q<= not?" test-expr
480		bn2 1/2 q<=     "bn2 1/2 q<=?" test-expr
481		1/2 2   q<= not "1/2 2 q<= not?" test-expr
482		2 1/2   q<=     "2 1/2 q<=?" test-expr
483		\ q>=
484		1/2 2/1 q>=     "1/2 2/1 q>=?" test-expr
485		1/2 2.0 q>=     "1/2 2.0 q>=?" test-expr
486		0.5 2/1 q>=     "0.5 2/1 q>=?" test-expr
487		1/2 bn2 q>=     "1/2 bn2 q>=?" test-expr
488		bn2 1/2 q>= not "bn2 1/2 q>= not?" test-expr
489		1/2 2   q>=     "1/2 2 q>=?" test-expr
490		2 1/2   q>= not "2 1/2 q>= not?" test-expr
491		\ q+
492		1/2 2/1 q+ 5/2 q<> "1/2 2/1 q+ 5/2 q<>?" test-expr
493		1/2 2.0 q+ 5/2 q<> "1/2 2.0 q+ 5/2 q<>?" test-expr
494		0.5 2/1 q+ 5/2 q<> "0.5 2/1 q+ 5/2 q<>?" test-expr
495		1/2 bn2 q+ 5/2 q<> "1/2 bn2 q+ 5/2 q<>?" test-expr
496		bn2 1/2 q+ 5/2 q<> "bn2 1/2 q+ 5/2 q<>?" test-expr
497		1/2 2   q+ 5/2 q<> "1/2 2 q+ 5/2 q<>?" test-expr
498		2 1/2   q+ 5/2 q<> "2 1/2 q+ 5/2 q<>?" test-expr
499		\ q-
500		1/2 2/1 q- -3/2 q<> "1/2 2/1 q- -3/2 q<>?" test-expr
501		1/2 2.0 q- -3/2 q<> "1/2 2.0 q- -3/2 q<>?" test-expr
502		0.5 2/1 q- -3/2 q<> "0.5 2/1 q- -3/2 q<>?" test-expr
503		1/2 bn2 q- -3/2 q<> "1/2 bn2 q- -3/2 q<>?" test-expr
504		bn2 1/2 q-  3/2 q<> "bn2 1/2 q- 3/2 q<>?" test-expr
505		1/2 2   q- -3/2 q<> "1/2 2 q- -3/2 q<>?" test-expr
506		2 1/2   q-  3/2 q<> "2 1/2 q- 3/2 q<>?" test-expr
507		\ q*
508		1/2 2/1 q* 1/1 q<> "1/2 2/1 q* 1/1 q<>?" test-expr
509		1/2 2.0 q* 1/1 q<> "1/2 2.0 q* 1/1 q<>?" test-expr
510		0.5 2/1 q* 1/1 q<> "0.5 2/1 q* 1/1 q<>?" test-expr
511		1/2 bn2 q* 1/1 q<> "1/2 bn2 q* 1/1 q<>?" test-expr
512		bn2 1/2 q* 1/1 q<> "bn2 1/2 q* 1/1 q<>?" test-expr
513		1/2 2   q* 1/1 q<> "1/2 2 q* 1/1 q<>?" test-expr
514		2 1/2   q* 1/1 q<> "2 1/2 q* 1/1 q<>?" test-expr
515		\ q/
516		1/2 2/1 q/ 1/4 q<> "1/2 2/1 q/ 1/4 q<>?" test-expr
517		1/2 2.0 q/ 1/4 q<> "1/2 2.0 q/ 1/4 q<>?" test-expr
518		0.5 2/1 q/ 1/4 q<> "0.5 2/1 q/ 1/4 q<>?" test-expr
519		1/2 bn2 q/ 1/4 q<> "1/2 bn2 q/ 1/4 q<>?" test-expr
520		bn2 1/2 q/ 4/1 q<> "bn2 1/2 q/ 4/1 q<>?" test-expr
521		1/2 2   q/ 1/4 q<> "1/2 2 q/ 1/4 q<>?" test-expr
522		2 1/2   q/ 4/1 q<> "2 1/2 q/ 4/1 q<>?" test-expr
523		\ q**
524		1/2 2/1 q** 1/4 q<> "1/2 2/1 q** 1/4 q<>?" test-expr
525		\ qnegate
526		-1/2 qnegate 1/2 q<> "-1/2 qnegate 1/2 q<>?" test-expr
527		1/2 qnegate -1/2 q<> "1/2 qnegate -1/2 q<>?" test-expr
528		\ qfloor
529		1/2 qfloor   0<>     "1/2 qfloor 0<>?" test-expr
530		\ qceil
531		1/2 qceil    1 <>    "1/2 qceil 1 <>?" test-expr
532		\ qabs
533		-1/2 qabs    1/2 q<> "-1/2 qabs 1/2 q<>" test-expr
534		1/2 qabs    1/2 q<> "1/2 qabs 1/2 q<>" test-expr
535		\ 1/q
536		1/2 1/q     2/1 q<> "1/2 1/q 2/1 q<>" test-expr
537		-1/2 1/q    -2/1 q<> "-1/2 1/q -2/1 q<>" test-expr
538		\ exact->inexact
539		3/2 exact->inexact 1.5 f<>
540		    "3/2 exact->inexact 1.5 f<>?" test-expr
541		\ inexact->exact
542		1.5 inexact->exact 3/2 q<>
543		    "1.5 inexact->exact 3/2 q<>?" test-expr
544		\ numerator
545		3/4 numerator 3 <> "3/4 numerator 3 <>?" test-expr
546		5   numerator 5 <> "5 numerator 5 <>?" test-expr
547		1.5 numerator  0<> "1.5 numerator 0<>?" test-expr
548		\ denominator
549		3/4 denominator 4 <> "3/4 denominator 4 <>?" test-expr
550		5   denominator 1 <> "5 denominator 1 <>?" test-expr
551		1.5 denominator 1 <> "1.5 denominator 1 <>?" test-expr
552	;
553[else]
554	<'> noop alias ratio-test ( -- )
555[then]
556
557: number-test ( -- )
558	\ number?
559	10        number?   not "number? (fixnum)?"		test-expr
560	3.3       number?   not "number? (float)?"		test-expr
561	3e        number?   not "number? (float)?"		test-expr
562	make-hash number?       "number? (make-hash)?"		test-expr
563	\ fixnum?
564	10        fixnum?   not "fixnum? (fixnum)?"		test-expr
565	3.3       fixnum?       "fixnum? (float)?"		test-expr
566	3e        fixnum?       "fixnum? (float)?"		test-expr
567	make-hash fixnum?       "fixnum? (make-hash)?"		test-expr
568	\ unsigned?
569	10        unsigned? not "unsigned? (fixnum)?"		test-expr
570	3.3       unsigned?     "unsigned? (float)?"		test-expr
571	3e        unsigned?     "unsigned? (float)?"		test-expr
572	make-hash unsigned?     "unsigned? (make-hash)?"	test-expr
573	\ long-long?
574	10        long-long?    "long-long? (fixnum)?"		test-expr
575	3.3       long-long?    "long-long? (float)?"		test-expr
576	3e        long-long?    "long-long? (float)?"		test-expr
577	make-hash long-long?    "long-long? (make-hash)?"	test-expr
578	\ ulong-long?
579	10        ulong-long?   "ulong-long? (fixnum)?"		test-expr
580	3.3       ulong-long?   "ulong-long? (float)?"		test-expr
581	3e        ulong-long?   "ulong-long? (float)?"		test-expr
582	make-hash ulong-long?   "ulong-long? (make-hash)?"	test-expr
583	\ integer?
584	10        integer?  not "integer? (fixnum)?"		test-expr
585	3.3       integer?      "integer? (float)?"		test-expr
586	3e        integer?      "integer? (float)?"		test-expr
587	make-hash integer?      "integer? (make-hash)?"		test-expr
588	\ exact?
589	10        exact?    not "exact? (fixnum)?" 		test-expr
590	3.3       exact?        "exact? (float)?"		test-expr
591	3e        exact?        "exact? (float)?"		test-expr
592	make-hash exact?        "exact? (make-hash)?"		test-expr
593	\ inexact?
594	10        inexact?      "inexact? (fixnum)?"		test-expr
595	3.3       inexact?  not "inexact? (float)?"		test-expr
596	3e        inexact?  not "inexact? (float)?"		test-expr
597	make-hash inexact?      "inexact? (make-hash)?"		test-expr
598	\ bignum?
599	10        bignum?       "bignum? (fixnum)?"		test-expr
600	3.3       bignum?       "bignum? (float)?"		test-expr
601	3e        bignum?       "bignum? (float)?"		test-expr
602	make-hash bignum?       "bignum? (make-hash)?"		test-expr
603	\ ratio?
604	10        rational?     "rational? (fixnum)?"		test-expr
605	3.3       rational?     "rational? (float)?"		test-expr
606	3e        rational?     "rational? (float)?"		test-expr
607	make-hash rational?     "rational? (make-hash)?"	test-expr
608	\ float?
609	10        float?        "float? (fixnum)?"		test-expr
610	3.3       float?    not "float? (float)?"		test-expr
611	3e        float?    not "float? (float)?"		test-expr
612	make-hash float?        "float? (make-hash)?"		test-expr
613	\ inf?, inf
614	10        inf?          "inf? (fixnum)?"		test-expr
615	inf       inf?      not "inf? (inf)?"			test-expr
616	3e        inf?          "inf? (float)?"			test-expr
617	make-hash inf?          "inf? (make-hash)?"		test-expr
618	\ nan?, nan
619	10        nan?          "nan? (fixnum)?"		test-expr
620	nan       nan?      not "nan? (nan)?"			test-expr
621	3e        nan?          "nan? (float)?"			test-expr
622	make-hash nan?          "nan? (make-hash)?"		test-expr
623	\ complex?
624	10        complex?      "complex? (fixnum)?"		test-expr
625	3.3       complex?      "complex? (float)?"		test-expr
626	3e        complex?      "complex? (float)?"		test-expr
627	make-hash complex?      "complex? (make-hash)?"		test-expr
628	10 make-long-long { dval10 }
629	dval10  long-long? not "make-long-long" test-expr
630	10 make-ulong-long { udval10 }
631	udval10 ulong-long? not "make-ulong-long" test-expr
632	\ exact->inexact, inexact->exact
633	3 exact->inexact 3.0   f<> "exact->inexact (3.0)" test-expr
634	3.3 exact->inexact 3.3 f<> "exact->inexact (3.3)" test-expr
635	\ math.h float functions
636	-1.0 	  fabs         1.0  f<> "fabs?"        test-expr
637	-1.0 2.0  fmod        -1.0  f<> "fmod?"        test-expr
638	3.2  	  floor        3.0  f<> "floor?"       test-expr
639	3.2  	  fceil        4.0  f<> "fceil?"       test-expr
640	3.2  	  ftrunc       3.0  f<> "ftrunc?"      test-expr
641	3.49 	  fround       3.0  f<> "fround (1)?"  test-expr
642	2.51 	  fround       3.0  f<> "fround (2)?"  test-expr
643	2.0 3.0   f**          8.0 fneq "f**?"         test-expr
644	9.0  	  fsqrt        3.0  f<> "fsqrt?"       test-expr
645	3.0  	  fexp     20.0855 fneq "fexp?"        test-expr
646	3.0  	  fexpm1   19.0855 fneq "fexpm1?"      test-expr
647	3.0  	  flog     1.09861 fneq "flog?"        test-expr
648	3.0  	  flogp1   1.38629 fneq "flogp1?"      test-expr
649	3.0  	  flog2    1.58496 fneq "flog2?"       test-expr
650	3.0  	  flog10   0.47712 fneq "flog10?"      test-expr
651	3.0  	  falog     1000.0 fneq "falog?"       test-expr
652	3.0  	  fsin     0.14112 fneq "fsin?"        test-expr
653	3.0  	  fcos   -0.989992 fneq "fcos?"        test-expr
654	3.0 fsincos { si cs }
655	3.0       fsin si          fneq "fsincos sin?" test-expr
656	3.0       fcos cs          fneq "fsincos cos?" test-expr
657	3.0  	  ftan   -0.142547 fneq "ftan?"        test-expr
658	1.0  	  fasin     1.5708 fneq "fasin?"       test-expr
659	1.0  	  facos            f0<> "facos?"       test-expr
660	3.0  	  fatan    1.24905 fneq "fatan?"       test-expr
661	3.0 1.0   fatan2 3.0 fatan fneq "fatan2?"      test-expr
662	3.0  	  fsinh    10.0179 fneq "fsinh?"       test-expr
663	3.0  	  fcosh    10.0677 fneq "fcosh?"       test-expr
664	3.0  	  ftanh   0.995055 fneq "ftanh?"       test-expr
665	3.0  	  fasinh   1.81845 fneq "fasinh?"      test-expr
666	3.0  	  facosh   1.76275 fneq "facosh?"      test-expr
667	0.5  	  fatanh   0.54931 fneq "fatanh?"      test-expr
668	complex-test
669	bignum-test
670	ratio-test
671;
672
673*fth-test-count* 0 [do] number-test [loop]
674
675\ numbers-test.fs ends here
676