Commit | Line | Data |
---|---|---|
7f918cf1 CE |
1 | functor Test (structure Real: REAL |
2 | val size: int) = | |
3 | struct | |
4 | ||
5 | open Real | |
6 | open Math | |
7 | ||
8 | infix == != | |
9 | ||
10 | datatype z = datatype IEEEReal.float_class | |
11 | datatype z = datatype IEEEReal.rounding_mode | |
12 | datatype z = datatype General.order | |
13 | ||
14 | val b2s = Bool.toString | |
15 | val i2s = Int.toString | |
16 | val exact = fmt StringCvt.EXACT | |
17 | ||
18 | val s2r = valOf o fromString | |
19 | ||
20 | val zero = s2r "0.0" | |
21 | val one = s2r "1.0" | |
22 | val two = s2r "2.0" | |
23 | val nan = posInf + negInf | |
24 | ||
25 | val halfMaxFinite = maxFinite / two | |
26 | val halfMinNormalPos = minNormalPos / two | |
27 | ||
28 | val reals = | |
29 | [maxFinite, | |
30 | halfMaxFinite, | |
31 | s2r "1.23E3", | |
32 | s2r "1.23E1", | |
33 | Math.pi, | |
34 | Math.e, | |
35 | s2r "1.23E0", | |
36 | s2r "1.23E~1", | |
37 | s2r "1.23E~3", | |
38 | minNormalPos, | |
39 | halfMinNormalPos, | |
40 | minPos, | |
41 | zero] | |
42 | ||
43 | fun for f = (List.app f reals; List.app (f o ~) reals) | |
44 | ||
45 | val reals' = | |
46 | [posInf, | |
47 | negInf, | |
48 | posInf + negInf, | |
49 | maxFinite * s2r "2.0"] | |
50 | ||
51 | fun for' f = (for f; List.app f reals') | |
52 | ||
53 | val _ = print (concat ["\nTesting Real", Int.toString size, "\n"]) | |
54 | ||
55 | val _ = print "\nTesting fmt\n" | |
56 | ||
57 | val _ = | |
58 | for | |
59 | (fn r => | |
60 | List.app (fn spec => print (concat [fmt spec r, "\n"])) | |
61 | let | |
62 | open StringCvt | |
63 | in | |
64 | [EXACT, SCI NONE, FIX NONE, GEN NONE, | |
65 | SCI (SOME 0), FIX (SOME 0), GEN (SOME 1), | |
66 | SCI (SOME 10), FIX (SOME 10), GEN (SOME 10)] | |
67 | end) | |
68 | ||
69 | val _ = | |
70 | let | |
71 | fun doit (s,r, s0, s1, s2, s6) = | |
72 | if (fmt (StringCvt.FIX (SOME 0)) r = s0 | |
73 | andalso fmt (StringCvt.FIX (SOME 1)) r = s1 | |
74 | andalso fmt (StringCvt.FIX (SOME 2)) r = s2 | |
75 | andalso fmt (StringCvt.FIX (SOME 6)) r = s6 | |
76 | andalso fmt (StringCvt.FIX NONE) r = s6) | |
77 | then () | |
78 | else raise Fail (concat ["fmt bug: ", s, " ", exact r]) | |
79 | in | |
80 | List.app | |
81 | (fn (s,r, s0, s1, s2, s6) => | |
82 | (doit (s,r, s0, s1, s2, s6) | |
83 | ; if r == zero | |
84 | then () | |
85 | else doit (s^"~",~r, "~"^s0, "~"^s1, "~"^s2, "~"^s6))) | |
86 | [("a", s2r "0.0", "0", "0.0", "0.00", "0.000000"), | |
87 | ("b", s2r "1.0", "1", "1.0", "1.00", "1.000000"), | |
88 | ("c", s2r "1.4", "1", "1.4", "1.40", "1.400000"), | |
89 | ("d", s2r "1.5", "2", "1.5", "1.50", "1.500000"), | |
90 | ("e", s2r "2.5", "2", "2.5", "2.50", "2.500000"), | |
91 | ("f", s2r "1.6", "2", "1.6", "1.60", "1.600000"), | |
92 | ("h", s2r "3.141592653589", "3", "3.1", "3.14", "3.141593"), | |
93 | ("j", s2r "91827365478400.0", "91827365478400", "91827365478400.0", | |
94 | "91827365478400.00", "91827365478400.000000")] | |
95 | end | |
96 | ||
97 | val _ = | |
98 | let | |
99 | fun chkSCI (r, s0, s1, s2, s6) = | |
100 | fmt (StringCvt.SCI (SOME 0)) r = s0 | |
101 | andalso fmt (StringCvt.SCI (SOME 1)) r = s1 | |
102 | andalso fmt (StringCvt.SCI (SOME 2)) r = s2 | |
103 | andalso fmt (StringCvt.SCI (SOME 6)) r = s6 | |
104 | andalso fmt (StringCvt.SCI NONE) r = s6 | |
105 | in | |
106 | List.app | |
107 | (fn (r, s0, s1, s2, s6) => | |
108 | if chkSCI(r, s0, s1, s2, s6) | |
109 | andalso (r == zero orelse chkSCI(~r, "~"^s0, "~"^s1, "~"^s2, "~"^s6)) | |
110 | then () | |
111 | else raise Fail (concat ["fmt SCI bug: ", exact r])) | |
112 | [(s2r "0.0", "0E0", "0.0E0", "0.00E0", "0.000000E0"), | |
113 | (s2r "0.0012345678", "1E~3", "1.2E~3", "1.23E~3", "1.234568E~3"), | |
114 | (s2r "1.0", "1E0", "1.0E0", "1.00E0", "1.000000E0"), | |
115 | (s2r "1.4", "1E0", "1.4E0", "1.40E0", "1.400000E0"), | |
116 | (s2r "1.5", "2E0", "1.5E0", "1.50E0", "1.500000E0"), | |
117 | (s2r "1.6", "2E0", "1.6E0", "1.60E0", "1.600000E0"), | |
118 | (s2r "3.141592653589", "3E0", "3.1E0", "3.14E0", "3.141593E0"), | |
119 | (s2r "91827365478400.0", "9E13", "9.2E13", "9.18E13", "9.182737E13")] | |
120 | end | |
121 | ||
122 | val _ = | |
123 | let | |
124 | fun chkGEN (r, s1, s2, s6, s12) = | |
125 | fmt (StringCvt.GEN (SOME 1)) r = s1 | |
126 | andalso fmt (StringCvt.GEN (SOME 2)) r = s2 | |
127 | andalso fmt (StringCvt.GEN (SOME 6)) r = s6 | |
128 | andalso fmt (StringCvt.GEN (SOME 12)) r = s12 | |
129 | andalso fmt (StringCvt.GEN NONE) r = s12 | |
130 | andalso toString r = s12; | |
131 | in | |
132 | List.app | |
133 | (fn (r, s1, s2, s6, s12) => | |
134 | if chkGEN(r, s1, s2, s6, s12) | |
135 | andalso (r == zero orelse | |
136 | chkGEN(~r, "~"^s1, "~"^s2, "~"^s6, "~"^s12)) | |
137 | then () | |
138 | else raise Fail (concat ["fmt GEN bug: ", exact r])) | |
139 | [(s2r "0.0", "0", "0", "0", "0"), | |
140 | (s2r "1.0", "1", "1", "1", "1"), | |
141 | (s2r "1.5", "2", "1.5", "1.5", "1.5"), | |
142 | (s2r "91827365478400.0", "9E13", "9.2E13", "9.18274E13", | |
143 | "91827365478400")] | |
144 | end | |
145 | ||
146 | val _ = print "\nTesting scan\n" | |
147 | ||
148 | val _ = for' (fn r => | |
149 | let | |
150 | val r' = valOf (StringCvt.scanString scan (exact r)) | |
151 | val _ = print (concat [exact r, "\t", exact r', "\n"]) | |
152 | in | |
153 | if r == r' orelse unordered (r, r') | |
154 | then () | |
155 | else raise Fail "scan bug" | |
156 | end) | |
157 | ||
158 | val _ = print "\nTesting checkFloat\n" | |
159 | val _ = | |
160 | for' | |
161 | (fn r => | |
162 | if (case class r of | |
163 | INF => ((checkFloat r; false) handle Overflow => true | _ => false) | |
164 | | NAN => ((checkFloat r; false) handle Div => true | _ => false) | |
165 | | _ => (checkFloat r; true) handle _ => false) | |
166 | then () | |
167 | else raise Fail "checkFloat bug") | |
168 | ||
169 | val _ = print "\nTesting class, isFinite, isNan, isNormal\n" | |
170 | val _ = | |
171 | for' | |
172 | (fn r => | |
173 | let | |
174 | val c = | |
175 | case class r of | |
176 | INF => "inf" | |
177 | | NAN => "nan" | |
178 | | NORMAL => "normal" | |
179 | | SUBNORMAL => "subnormal" | |
180 | | ZERO => "zero" | |
181 | in | |
182 | print (concat [exact r, "\t", c, "\n", | |
183 | "\tisFinite = ", b2s (isFinite r), | |
184 | "\tisNan = ", b2s (isNan r), | |
185 | "\tisNormal = ", b2s (isNormal r), | |
186 | "\n"]) | |
187 | end) | |
188 | ||
189 | val _ = print "\nTesting maxFinite, minPos, minNormalPos\n" | |
190 | ||
191 | local | |
192 | val isNormal = Real.isNormal | |
193 | val isFinite = Real.isFinite | |
194 | val isPositive = fn r => | |
195 | case class r of | |
196 | NORMAL => r > zero | |
197 | | SUBNORMAL => r > zero | |
198 | | INF => r > zero | |
199 | | _ => false | |
200 | ||
201 | fun min (p: real -> bool): real = | |
202 | let | |
203 | fun loop (x: real): real = | |
204 | let | |
205 | val y = x / two | |
206 | in | |
207 | if p y | |
208 | then loop y | |
209 | else x | |
210 | end | |
211 | in | |
212 | loop one | |
213 | end | |
214 | in | |
215 | val minNormalPos = min isNormal | |
216 | val minPos = min isPositive | |
217 | ||
218 | val maxFinite = | |
219 | let | |
220 | fun up (x: real): real = | |
221 | let | |
222 | val y = x * two | |
223 | in | |
224 | if isFinite y | |
225 | then up y | |
226 | else x | |
227 | end | |
228 | fun down (x: real, y: real): real = | |
229 | let | |
230 | val y = y / two | |
231 | val z = x + y | |
232 | in | |
233 | if isFinite z | |
234 | then down (z, y) | |
235 | else x | |
236 | end | |
237 | val z = up one | |
238 | in | |
239 | down (z, z) | |
240 | end | |
241 | end | |
242 | ||
243 | val _ = print ((Real.toString maxFinite) ^ "\n") | |
244 | val _ = print ((Real.toString Real.maxFinite) ^ "\n") | |
245 | val _ = print ((Bool.toString (Real.==(Real.maxFinite, maxFinite))) ^ "\n") | |
246 | val _ = print ((Real.toString minPos) ^ "\n") | |
247 | val _ = print ((Real.toString Real.minPos) ^ "\n") | |
248 | val _ = print ((Bool.toString (Real.==(Real.minPos, minPos))) ^ "\n") | |
249 | val _ = print ((Real.toString minNormalPos) ^ "\n") | |
250 | val _ = print ((Real.toString Real.minNormalPos) ^ "\n") | |
251 | val _ = print ((Bool.toString (Real.==(Real.minNormalPos, minNormalPos))) ^ "\n") | |
252 | ||
253 | val _ = print "\nTestring fromString\n" | |
254 | ||
255 | val _ = | |
256 | List.app | |
257 | (fn (s1, s2) => | |
258 | if valOf (fromString s1) == valOf (fromString s2) | |
259 | then () | |
260 | else raise Fail "fromString bug") | |
261 | [("12.", "12.0"), | |
262 | ("12.E", "12.0"), | |
263 | ("12.E+", "12.0"), | |
264 | ("12.E-", "12.0"), | |
265 | ("12.E2", "12.0"), | |
266 | ("12.E+2", "12.0"), | |
267 | ("12.E-2", "12.0"), | |
268 | ("12E+", "12.0"), | |
269 | ("12E-", "12.0"), | |
270 | ("0", "0.0"), | |
271 | ("156", "156.0"), | |
272 | ("+156", "156.0"), | |
273 | ("~156", "~156.0"), | |
274 | ("-156", "~156.0"), | |
275 | ("156.25", "156.25"), | |
276 | ("+156.25", "156.25"), | |
277 | ("~156.25", "~156.25"), | |
278 | ("-156.25", "~156.25"), | |
279 | (".25", "0.25"), | |
280 | ("+.25", "0.25"), | |
281 | ("~.25", "~0.25"), | |
282 | ("-.25", "~0.25"), | |
283 | ("156E024", "156E024"), | |
284 | ("+156E024", "156E024"), | |
285 | ("~156E024", "~156E024"), | |
286 | ("-156E024", "~156E024"), | |
287 | ("156.25E024", "156.25E024"), | |
288 | ("+156.25E024", "156.25E024"), | |
289 | ("~156.25E024", "~156.25E024"), | |
290 | ("-156.25E024", "~156.25E024"), | |
291 | (".25E024", "0.25E024"), | |
292 | ("+.25E024", "0.25E024"), | |
293 | ("~.25E024", "~0.25E024"), | |
294 | ("-.25E024", "~0.25E024"), | |
295 | ("156E+024", "156E024"), | |
296 | ("+156E+024", "156E024"), | |
297 | ("~156E+024", "~156E024"), | |
298 | ("-156E+024", "~156E024"), | |
299 | ("156.25E+024", "156.25E024"), | |
300 | ("+156.25E+024", "156.25E024"), | |
301 | ("~156.25E+024", "~156.25E024"), | |
302 | ("-156.25E+024", "~156.25E024"), | |
303 | (".25E+024", "0.25E024"), | |
304 | ("+.25E+024", "0.25E024"), | |
305 | ("~.25E+024", "~0.25E024"), | |
306 | ("-.25E+024", "~0.25E024"), | |
307 | ("156E~024", "156E~024"), | |
308 | ("+156E~024", "156E~024"), | |
309 | ("~156E~024", "~156E~024"), | |
310 | ("-156E~024", "~156E~024"), | |
311 | ("156.25E~024", "156.25E~024"), | |
312 | ("+156.25E~024", "156.25E~024"), | |
313 | ("~156.25E~024", "~156.25E~024"), | |
314 | ("-156.25E~024", "~156.25E~024"), | |
315 | (".25E~024", "0.25E~024"), | |
316 | ("+.25E~024", "0.25E~024"), | |
317 | ("~.25E~024", "~0.25E~024"), | |
318 | ("-.25E~024", "~0.25E~024"), | |
319 | ("156E-024", "156E~024"), | |
320 | ("+156E-024", "156E~024"), | |
321 | ("~156E-024", "~156E~024"), | |
322 | ("-156E-024", "~156E~024"), | |
323 | ("156.25E-024", "156.25E~024"), | |
324 | ("+156.25E-024", "156.25E~024"), | |
325 | ("~156.25E-024", "~156.25E~024"), | |
326 | ("-156.25E-024", "~156.25E~024"), | |
327 | (".25E-024", "0.25E~024"), | |
328 | ("+.25E-024", "0.25E~024"), | |
329 | ("~.25E-024", "~0.25E~024"), | |
330 | ("-.25E-024", "~0.25E~024"), | |
331 | ("156e024", "156E024"), | |
332 | ("+156e024", "156E024"), | |
333 | ("~156e024", "~156E024"), | |
334 | ("-156e024", "~156E024"), | |
335 | ("156.25e024", "156.25E024"), | |
336 | ("+156.25e024", "156.25E024"), | |
337 | ("~156.25e024", "~156.25E024"), | |
338 | ("-156.25e024", "~156.25E024"), | |
339 | (".25e024", "0.25E024"), | |
340 | ("+.25e024", "0.25E024"), | |
341 | ("~.25e024", "~0.25E024"), | |
342 | ("-.25e024", "~0.25E024"), | |
343 | ("156e+024", "156E024"), | |
344 | ("+156e+024", "156E024"), | |
345 | ("~156e+024", "~156E024"), | |
346 | ("-156e+024", "~156E024"), | |
347 | ("156.25e+024", "156.25E024"), | |
348 | ("+156.25e+024", "156.25E024"), | |
349 | ("~156.25e+024", "~156.25E024"), | |
350 | ("-156.25e+024", "~156.25E024"), | |
351 | (".25e+024", "0.25E024"), | |
352 | ("+.25e+024", "0.25E024"), | |
353 | ("~.25e+024", "~0.25E024"), | |
354 | ("-.25e+024", "~0.25E024"), | |
355 | ("156e~024", "156E~024"), | |
356 | ("+156e~024", "156E~024"), | |
357 | ("~156e~024", "~156E~024"), | |
358 | ("-156e~024", "~156E~024"), | |
359 | ("156.25e~024", "156.25E~024"), | |
360 | ("+156.25e~024", "156.25E~024"), | |
361 | ("~156.25e~024", "~156.25E~024"), | |
362 | ("-156.25e~024", "~156.25E~024"), | |
363 | (".25e~024", "0.25E~024"), | |
364 | ("+.25e~024", "0.25E~024"), | |
365 | ("~.25e~024", "~0.25E~024"), | |
366 | ("-.25e~024", "~0.25E~024"), | |
367 | ("156e-024", "156E~024"), | |
368 | ("+156e-024", "156E~024"), | |
369 | ("~156e-024", "~156E~024"), | |
370 | ("-156e-024", "~156E~024"), | |
371 | ("156.25e-024", "156.25E~024"), | |
372 | ("+156.25e-024", "156.25E~024"), | |
373 | ("~156.25e-024", "~156.25E~024"), | |
374 | ("-156.25e-024", "~156.25E~024"), | |
375 | (".25e-024", "0.25E~024"), | |
376 | ("+.25e-024", "0.25E~024"), | |
377 | ("~.25e-024", "~0.25E~024"), | |
378 | ("-.25e-024", "~0.25E~024")] | |
379 | ||
380 | ||
381 | val _ = print "\nTesting {from,to}Decimal\n" | |
382 | ||
383 | val _ = | |
384 | List.app (fn r => | |
385 | let | |
386 | val da = valOf (IEEEReal.fromString r) | |
387 | val s1 = IEEEReal.toString da | |
388 | val x = valOf (fromDecimal da) | |
389 | val s2 = exact x | |
390 | val da' = toDecimal x | |
391 | val b = Bool.toString (da = da') | |
392 | in | |
393 | print (concat [s1, " ", s2, " ", b, "\n"]) | |
394 | end) | |
395 | ["inf", "+inF", "~iNf", "-Inf", | |
396 | "infinity", "+infinity", "~infinity", "-infinity", | |
397 | "nan", "+naN", "~nAn", "-Nan", | |
398 | "0", "0.0", "0.0E0", "~0", | |
399 | "15", | |
400 | "1.5", | |
401 | "~1.5e+1", | |
402 | "15.0", | |
403 | ".15e~2", | |
404 | ".15e-2", | |
405 | "000.0015e0", | |
406 | "1.2E999", | |
407 | "~1.2E999", | |
408 | "1E~999", | |
409 | "~1E~999", | |
410 | "1E12345678901234567890"] | |
411 | ||
412 | val _ = print "\nTesting {from,to}LargeInt\n" | |
413 | val _ = | |
414 | for | |
415 | (fn r => | |
416 | let | |
417 | val i = toLargeInt IEEEReal.TO_NEGINF r | |
418 | val r' = fromLargeInt i | |
419 | val _ = print (concat [exact r, | |
420 | "\t", LargeInt.toString i, | |
421 | "\t", exact r', | |
422 | "\n"]) | |
423 | in | |
424 | if r' == realFloor r | |
425 | then () | |
426 | else raise Fail "bug" | |
427 | end) | |
428 | ||
429 | val roundingModes = | |
430 | [(TO_NEAREST, "nearest"), | |
431 | (TO_NEGINF, "neginf"), | |
432 | (TO_POSINF, "posinf"), | |
433 | (TO_ZERO, "zero")] | |
434 | ||
435 | val _ = | |
436 | let | |
437 | fun doit (x, mode, name) = | |
438 | let | |
439 | val i = toLargeInt mode x | |
440 | in | |
441 | print (concat [name, "\t", exact x, "\t", LargeInt.toString i, "\n"]) | |
442 | end | |
443 | in | |
444 | List.app | |
445 | (fn (mode, name) => | |
446 | List.app (fn s => | |
447 | let | |
448 | val x = s2r s | |
449 | in | |
450 | doit (x, mode, name) | |
451 | ; doit (~ x, mode, name) | |
452 | ; doit (s2r "1E12" + x, mode, name) | |
453 | ; doit (s2r "~1E12" + x, mode, name) | |
454 | end) | |
455 | ["0.0", "0.25", "0.5", "0.75", "1.0", "1.25", "1.5", "1.75", "2.0", | |
456 | "2.5", "3.0"]) | |
457 | roundingModes | |
458 | end | |
459 | ||
460 | val _ = print "\nTesting fromInt\n" | |
461 | ||
462 | val _ = | |
463 | for | |
464 | (fn r => | |
465 | case SOME (round r) handle Overflow => NONE of | |
466 | NONE => () | |
467 | | SOME i => | |
468 | let | |
469 | val r = fromInt i | |
470 | in | |
471 | if r == fromInt (round r) | |
472 | then () | |
473 | else raise Fail "fromInt bug" | |
474 | end) | |
475 | ||
476 | val _ = print "\nTesting toInt\n" | |
477 | ||
478 | val _ = | |
479 | for | |
480 | (fn r => | |
481 | List.app | |
482 | (fn (mode, name) => | |
483 | case SOME (toInt mode r) handle Overflow => NONE of | |
484 | NONE => () | |
485 | | SOME i => if i = LargeInt.toInt (toLargeInt mode r) | |
486 | then () | |
487 | else raise Fail "bug") | |
488 | roundingModes) | |
489 | ||
490 | val _ = print "\nTesting ceil,floor,round,trunc\n" | |
491 | ||
492 | val _ = | |
493 | for | |
494 | (fn r => | |
495 | List.app | |
496 | (fn (mode, f) => | |
497 | case SOME (toInt mode r) handle Overflow => NONE of | |
498 | NONE => () | |
499 | | SOME i => if i = f r | |
500 | then () | |
501 | else raise Fail "bug") | |
502 | [(TO_NEAREST, round), | |
503 | (TO_NEGINF, floor), | |
504 | (TO_POSINF, ceil), | |
505 | (TO_ZERO, trunc)]) | |
506 | ||
507 | val _ = print "\nTesting copySign, sameSign, sign, signBit\n" | |
508 | val _ = | |
509 | for' | |
510 | (fn r1 => | |
511 | (for' | |
512 | (fn r2 => | |
513 | if unordered (r1, r2) | |
514 | orelse (if false | |
515 | then print (concat [b2s (signBit r1), "\t", | |
516 | b2s (signBit r2), "\t", | |
517 | i2s (sign r1), "\t", | |
518 | b2s (sameSign (r1, r2)), "\t", | |
519 | exact (copySign (r1, r2)), "\n"]) | |
520 | else () | |
521 | ; (signBit r1 = Int.< (sign r1, 0) | |
522 | orelse r1 == zero) | |
523 | andalso (sameSign (r1, r2)) = (signBit r1 = signBit r2) | |
524 | andalso sameSign (r2, copySign (r1, r2))) | |
525 | then () | |
526 | else raise Fail "bug"))) | |
527 | ||
528 | val _ = print "\nTesting max, min\n" | |
529 | ||
530 | val _ = | |
531 | for' | |
532 | (fn r1 => | |
533 | for' | |
534 | (fn r2 => | |
535 | let | |
536 | val max = max (r1, r2) | |
537 | val min = min (r1, r2) | |
538 | in | |
539 | if (isNan r1 orelse (r1 <= max andalso min <= r1)) | |
540 | andalso (isNan r2 orelse (r2 <= max andalso min <= r2)) | |
541 | andalso (r1 == max orelse r2 == max | |
542 | orelse (isNan r1 andalso isNan r2)) | |
543 | andalso (r1 == min orelse r2 == min | |
544 | orelse (isNan r1 andalso isNan r2)) | |
545 | then () | |
546 | else raise Fail "bug" | |
547 | end)) | |
548 | ||
549 | val _ = print "\nTesting Real.Math.{acos,asin,atan,cos,cosh,exp,ln,log10,sin,sinh,sqrt,tan,tanh}\n" | |
550 | ||
551 | val _ = | |
552 | for' (fn r => | |
553 | List.app | |
554 | (fn (name, f, except) => | |
555 | if List.exists (fn r' => r == r') except | |
556 | then () | |
557 | else | |
558 | print (concat [(*name, " ", exact r, " = ", *) | |
559 | fmt (StringCvt.GEN (SOME 10)) (f r), "\n"])) | |
560 | let | |
561 | open Real.Math | |
562 | in | |
563 | [("acos", acos, []), | |
564 | ("asin", asin, []), | |
565 | ("atan", atan, []), | |
566 | ("cos", cos, [maxFinite, halfMaxFinite, | |
567 | ~maxFinite, ~halfMaxFinite]), | |
568 | ("cosh", cosh, [s2r "12.3", s2r "~12.3", e, ~e]), | |
569 | ("exp", exp, [s2r "12.3", pi, s2r "1.23", | |
570 | s2r "~12.3", ~pi, s2r "~1.23"]), | |
571 | ("ln", ln, []), | |
572 | ("log10", log10, [s2r "1.23", pi]), | |
573 | ("sin", sin, [maxFinite, halfMaxFinite, | |
574 | ~maxFinite, ~halfMaxFinite, pi, ~pi]), | |
575 | ("sinh", sinh, [pi, ~pi, s2r "0.123", s2r "~0.123"]), | |
576 | ("sqrt", sqrt, [maxFinite]), | |
577 | ("tan", tan, [maxFinite, halfMaxFinite, | |
578 | ~maxFinite, ~halfMaxFinite, pi, ~pi]), | |
579 | ("tanh", tanh, [s2r "0.123", s2r "~0.123"])] | |
580 | end) | |
581 | ||
582 | val _ = print "\nTesting Real.{*,+,-,/,nextAfter,rem} Real.Math.{atan2,pow}\n" | |
583 | val _ = | |
584 | for' | |
585 | (fn r1 => | |
586 | for' | |
587 | (fn r2 => | |
588 | List.app | |
589 | (fn (name, f, except) => | |
590 | if List.exists (fn (r1', r2') => r1 == r1' andalso r2 == r2') except | |
591 | then () | |
592 | else | |
593 | print (concat [(*name, " (", exact r1, ", ", exact r2, ") = ", *) | |
594 | exact (f (r1, r2)), "\n"])) | |
595 | [("*", op *, []), | |
596 | ("+", op +, []), | |
597 | ("-", op -, []), | |
598 | ("/", op /, [(s2r "1.23", halfMaxFinite), | |
599 | (s2r "1.23", ~halfMaxFinite), | |
600 | (s2r "~1.23", halfMaxFinite), | |
601 | (s2r "~1.23", ~halfMaxFinite) | |
602 | ]), | |
603 | ("nextAfter", nextAfter, []) | |
604 | (* ("rem", rem, []), *) | |
605 | (* ("atan2", Math.atan2, []), *) | |
606 | (* ("pow", Math.pow, [(halfMaxFinite, s2r "0.123"), (pi, e)]) *) | |
607 | ])) | |
608 | ||
609 | val _ = | |
610 | if List.all (op ==) [(posInf + posInf, posInf), | |
611 | (negInf + negInf, negInf), | |
612 | (posInf - negInf, posInf), | |
613 | (negInf - posInf, negInf)] | |
614 | andalso List.all isNan [nan, nan + one, nan - one, nan * one, nan / one] | |
615 | andalso List.all isNan [posInf + negInf, negInf + posInf, posInf - posInf, | |
616 | negInf - negInf] | |
617 | then () | |
618 | else raise Fail "bug" | |
619 | ||
620 | val _ = print "\nTesting *+, *-\n" | |
621 | val _ = | |
622 | for | |
623 | (fn r1 => | |
624 | for | |
625 | (fn r2 => | |
626 | for | |
627 | (fn r3 => | |
628 | if *+ (r1, r2, r3) == r1 * r2 + r3 | |
629 | then () | |
630 | else raise Fail "*+ bug"))) | |
631 | ||
632 | val _ = print "\nTesting Real.{realCeil,realFloor,realTrunc}\n" | |
633 | val _ = | |
634 | for | |
635 | (fn r => | |
636 | let | |
637 | val ceil = realCeil r | |
638 | val floor = realFloor r | |
639 | val trunc = realTrunc r | |
640 | val _ = print (concat [exact r, " ", | |
641 | exact ceil, " ", | |
642 | exact floor, " ", | |
643 | exact trunc, "\n"]) | |
644 | in | |
645 | if floor <= r | |
646 | andalso r <= ceil | |
647 | andalso abs trunc <= abs r | |
648 | then () | |
649 | else raise Fail "bug" | |
650 | end) | |
651 | ||
652 | val _ = print "\nTesting Real.{<,<=,>,>=,==,!=,?=,unordered}\n" | |
653 | ||
654 | val _ = | |
655 | for | |
656 | (fn r1 => | |
657 | for | |
658 | (fn r2 => | |
659 | let | |
660 | val _ = | |
661 | List.app | |
662 | (fn (f, name) => | |
663 | print (concat [(* name, " (", exact r1, ", ", exact r2, ") = ", *) | |
664 | b2s (f (r1, r2)), "\n"])) | |
665 | [(Real.<, "<"), | |
666 | (Real.>, ">"), | |
667 | (Real.==, "=="), | |
668 | (Real.?=, "?=")] | |
669 | in | |
670 | if unordered (r1, r2) = (isNan r1 orelse isNan r2) | |
671 | andalso (r1 != r2) = not (r1 == r2) | |
672 | andalso if unordered (r1, r2) | |
673 | then (false = (r1 <= r2) | |
674 | andalso false = (r1 < r2) | |
675 | andalso false = (r1 >= r2) | |
676 | andalso false = (r1 > r2) | |
677 | andalso false = (r1 == r2) | |
678 | andalso if isNan r1 andalso isNan r2 | |
679 | then true = ?= (r1, r2) | |
680 | else true) | |
681 | else ((r1 < r2) = not (r1 >= r2) | |
682 | andalso (r1 > r2) = not (r1 <= r2)) | |
683 | then () | |
684 | else raise Fail "bug" | |
685 | end)) | |
686 | ||
687 | val _ = print "\nTesting compare, compareReal\n" | |
688 | ||
689 | val _ = | |
690 | for | |
691 | (fn r => | |
692 | for | |
693 | (fn r' => | |
694 | let | |
695 | val c = | |
696 | case SOME (compare (r, r')) handle IEEEReal.Unordered => NONE of | |
697 | NONE => "Unordered" | |
698 | | SOME z => | |
699 | case z of | |
700 | EQUAL => "EQUAL" | |
701 | | GREATER => "GREATER" | |
702 | | LESS => "LESS" | |
703 | datatype z = datatype IEEEReal.real_order | |
704 | val cr = | |
705 | case compareReal (r, r') of | |
706 | EQUAL => "EQUAL" | |
707 | | GREATER => "GREATER" | |
708 | | LESS => "LESS" | |
709 | | UNORDERED => "UNORDERED" | |
710 | val _ = | |
711 | print (concat [(* exact r, " ", exact r', "\t", *) | |
712 | c, "\t", cr, "\n"]) | |
713 | in | |
714 | if compareReal (r, r') = (case compareReal (r', r) of | |
715 | EQUAL => EQUAL | |
716 | | GREATER => LESS | |
717 | | LESS => GREATER | |
718 | | UNORDERED => UNORDERED) | |
719 | then () | |
720 | else raise Fail "compareReal bug" | |
721 | end)) | |
722 | ||
723 | val _ = print "\nTesting abs\n" | |
724 | ||
725 | val _ = for (fn r => | |
726 | if abs r == abs (~ r) | |
727 | then () | |
728 | else raise Fail "abs bug") | |
729 | ||
730 | val _ = print "\nTesting {from,to}ManExp\n" | |
731 | ||
732 | val _ = | |
733 | for | |
734 | (fn x => | |
735 | if List.exists (fn y => x == y) [halfMinNormalPos, minPos, | |
736 | ~halfMinNormalPos, ~minPos] | |
737 | then () | |
738 | else | |
739 | let | |
740 | val {exp, man} = toManExp x | |
741 | val _ = | |
742 | if true | |
743 | then | |
744 | print (concat [exact x, " = ", exact man, " * 2^", i2s exp, | |
745 | "\n"]) | |
746 | else () | |
747 | val x' = fromManExp {exp = exp, man = man} | |
748 | val _ = | |
749 | if true | |
750 | then | |
751 | print (concat ["\t = ", exact x', "\n"]) | |
752 | else () | |
753 | in | |
754 | if x == x' | |
755 | then () | |
756 | else raise Fail "bug" | |
757 | end) | |
758 | ||
759 | val _ = print "\nTesting split\n" | |
760 | ||
761 | val _ = | |
762 | for (fn r => | |
763 | let | |
764 | val {whole, frac} = split r | |
765 | val _ = | |
766 | if false | |
767 | then | |
768 | print (concat ["split ", exact r, " = {whole = ", | |
769 | exact whole, ", frac = ", exact frac, "}\n", | |
770 | "realMod ", exact whole, " = ", | |
771 | exact (realMod whole), "\t", | |
772 | b2s (sameSign (r, whole)), "\t", | |
773 | b2s (sameSign (r, frac)), "\n"]) | |
774 | else () | |
775 | in | |
776 | if realMod r == frac | |
777 | andalso realMod whole == zero | |
778 | andalso abs frac < one | |
779 | andalso sameSign (r, whole) | |
780 | andalso sameSign (r, frac) | |
781 | andalso (case class r of | |
782 | INF => whole == r andalso frac == zero | |
783 | | NAN => isNan whole andalso isNan frac | |
784 | | _ => r == whole + frac) | |
785 | then () | |
786 | else raise Fail "bug" | |
787 | end) | |
788 | ||
789 | val _ = print "\nTesting {from,to}Large\n" | |
790 | ||
791 | val _ = | |
792 | for | |
793 | (fn r => | |
794 | if r == fromLarge TO_NEAREST (toLarge r) | |
795 | then () | |
796 | else raise Fail "{from,to}Large bug") | |
797 | ||
798 | end | |
799 | ||
800 | structure Z = Test (structure Real = Real32 | |
801 | val size = 32) | |
802 | structure Z = Test (structure Real = Real64 | |
803 | val size = 64) |