PageRenderTime 55ms CodeModel.GetById 27ms RepoModel.GetById 1ms app.codeStats 0ms

/pkgs/math-pkgs/math-lib/math/private/utils/flonum-tests.rkt

http://github.com/plt/racket
Racket | 535 lines | 433 code | 62 blank | 40 comment | 37 complexity | edc6f1386ecfd50f7405a6a33d359bb2 MD5 | raw file
Possible License(s): LGPL-3.0, GPL-3.0, BSD-3-Clause, CC-BY-SA-3.0
  1. #lang typed/racket/base
  2. (require racket/math
  3. racket/list
  4. "../base/base-random.rkt"
  5. "../flonum/expansion/expansion-base.rkt"
  6. "../flonum/expansion/expansion-exp.rkt"
  7. "../flonum/expansion/expansion-log.rkt"
  8. "../flonum/flonum-functions.rkt"
  9. "../flonum/flonum-constants.rkt"
  10. "../flonum/flonum-bits.rkt"
  11. "../flonum/flonum-error.rkt"
  12. "../flonum/flonum-log.rkt"
  13. "../bigfloat/bigfloat-log-arithmetic.rkt"
  14. "../distributions/dist-struct.rkt"
  15. "../distributions/geometric-dist.rkt"
  16. "../../bigfloat.rkt")
  17. (provide
  18. print-fp-test-progress?
  19. ;; Unary flonum tests
  20. test-flabs
  21. test-flsqrt
  22. test-fllog
  23. test-flexp
  24. test-flsin
  25. test-flcos
  26. test-fltan
  27. test-flasin
  28. test-flacos
  29. test-flatan
  30. test-fllog2
  31. ;; Binary flonum tests
  32. test-fl+
  33. test-fl*
  34. test-fl-
  35. test-fl/
  36. test-flexpt
  37. test-fllogb
  38. ;; Unary flop/error tests
  39. test-flsqr/error
  40. test-flsqrt/error
  41. test-flexp/error
  42. ;; Binary flop/error tests
  43. test-fl+/error
  44. test-fl-/error
  45. test-fl*/error
  46. test-fl//error
  47. ;; fl2 conversion test
  48. test-fl2
  49. ;; Unary fl2 tests
  50. test-fl2abs
  51. test-fl2sqr
  52. test-fl2sqrt
  53. test-fl2exp
  54. test-fl2expm1
  55. test-fl2log
  56. test-fl2log1p
  57. ;; Binary fl2 tests
  58. test-fl2+
  59. test-fl2-
  60. test-fl2*
  61. test-fl2/
  62. ;; Comprehensive test
  63. test-floating-point)
  64. ;; Allowable error for different kinds of functions, in ulps
  65. (define flonum-fun-ulps 0.5)
  66. (define fllog2-ulps 1.0)
  67. (define fllogb-ulps 2.5)
  68. (define flonum/error-fun-ulps 0.5)
  69. (define flexp/error-fun-ulps 3.0)
  70. (define fl2-conversion-ulps 0.5)
  71. (define unary-fl2-fun-ulps 1.0)
  72. (define binary-fl2-fun-ulps 8.0)
  73. (define fl2exp-fun-ulps 3.0)
  74. (define fl2log-fun-ulps 2.0)
  75. (: current-max-ulp-error (Parameterof Nonnegative-Flonum))
  76. (define current-max-ulp-error (make-parameter 0.0))
  77. ;; ===================================================================================================
  78. ;; Helpers
  79. (: different-zero? (Real Real -> Boolean))
  80. (define (different-zero? x y)
  81. (or (and (eqv? x -0.0) (eqv? y 0.0))
  82. (and (eqv? x 0.0) (eqv? y -0.0))))
  83. (: fl2->real* (Flonum Flonum -> Real))
  84. ;; Like `fl2->real', but returns signed flonum zeros
  85. (define (fl2->real* x2 x1)
  86. (define x.0 (fl+ x2 x1))
  87. (cond [(zero? x.0) x2]
  88. [else (fl2->real x2 x1)]))
  89. (: bigfloat->real* (Bigfloat -> Real))
  90. ;; Like `bigfloat->real*', but returns a signed infinity or a signed flonum zero if conversion would
  91. ;; overflow or underflow a flonum
  92. (define (bigfloat->real* x)
  93. (define x.0 (bigfloat->flonum x))
  94. (cond [(fl= x.0 0.0) x.0]
  95. [(flrational? x.0) (bigfloat->real x)]
  96. [else x.0]))
  97. (: filter/ulp-error (All (A B) ((Listof (List A (U B Flonum)))
  98. Flonum -> (Listof (List A (U B Flonum))))))
  99. (define (filter/ulp-error xes ulps)
  100. (filter (?: ([xe : (List A (U B Flonum))])
  101. (define e (second xe))
  102. (or (not (flonum? e)) (e . fl> . ulps)))
  103. xes))
  104. (: print-fp-test-progress? (Parameterof Boolean))
  105. (define print-fp-test-progress? (make-parameter #t))
  106. (define progress-chunk-size 200)
  107. (define progress-superchunk-chunks 5)
  108. (: maybe-print-progress (Symbol Integer Natural -> Void))
  109. (define (maybe-print-progress name i m)
  110. (when (and (print-fp-test-progress?) (i . > . 0) (i . <= . m))
  111. (let* ([flush? (cond [(= i 1) (printf "~a: " name)]
  112. [else #f])]
  113. [flush? (cond [(= 0 (modulo i progress-chunk-size))
  114. (cond [(= 0 (modulo i (* progress-superchunk-chunks
  115. progress-chunk-size)))
  116. (printf "* ~a " i)]
  117. [else (printf "*")])]
  118. [else flush?])]
  119. [flush? (cond [(= i m) (printf "* ~a~n" m)]
  120. [else flush?])])
  121. (when flush? (flush-output)))))
  122. ;; ===================================================================================================
  123. ;; Test case generation
  124. ;; Deteriministic test cases
  125. (define standard-xs
  126. (list
  127. ;; Test the sign of the return value of `flexpt'
  128. -1001.0 -10.0 -0.1 +0.1 +10.0 +1001.0
  129. ;; Test squaring
  130. (- (flsqrt +min.0)) (flsqrt +min.0)
  131. (- (flsqrt +max-subnormal.0)) (flsqrt +max-subnormal.0)
  132. (- (flsqrt +max-subnormal.hi)) (flsqrt +max-subnormal.hi)
  133. (- (flsqrt +max.0)) (flsqrt +max.0)
  134. ;; Test exp limits
  135. (fllog +min.0) (fllog +max-subnormal.0) (fllog +max-subnormal.hi) (fllog +max.0)
  136. ;; Standard special values
  137. -inf.0 -max.0 -1.0 -max-subnormal.hi -max-subnormal.0 -min.0 -0.0
  138. +inf.0 +max.0 +1.0 +max-subnormal.hi +max-subnormal.0 +min.0 +0.0
  139. +nan.0))
  140. (define standard-rs
  141. (append standard-xs
  142. (list +10 +1 +1/7 +1/10 +1/13
  143. -10 -1 -1/7 -1/10 -1/13
  144. 0)))
  145. (: product (All (A B) ((Listof A) (Listof B) -> (Values (Listof A) (Listof B)))))
  146. (define (product as bs)
  147. (define abs
  148. (append*
  149. (for/list: : (Listof (Listof (Pair A B))) ([a (in-list as)])
  150. (for/list: : (Listof (Pair A B)) ([b (in-list bs)])
  151. (cons a b)))))
  152. (values (map (inst car A B) abs) (map (inst cdr A B) abs)))
  153. ;; Random test cases
  154. (define min-subnormal-ord (flonum->ordinal -max-subnormal.0))
  155. (define max-subnormal-ord (+ 1 (flonum->ordinal +max-subnormal.0)))
  156. (define min-fl2-subnormal-ord (flonum->ordinal -max-subnormal.hi))
  157. (define max-fl2-subnormal-ord (+ 1 (flonum->ordinal +max-subnormal.hi)))
  158. (: sample-flonum (case-> (Integer -> (Listof Flonum))
  159. (Integer Flonum Flonum -> (Listof Flonum))))
  160. (define (sample-flonum n [mn -inf.0] [mx +inf.0])
  161. (define min-ord (flonum->ordinal mn))
  162. (define max-ord (+ 1 (flonum->ordinal mx)))
  163. (let ([min-subnormal-ord (max min-ord min-subnormal-ord)]
  164. [max-subnormal-ord (min max-ord max-subnormal-ord)]
  165. [min-fl2-subnormal-ord (max min-ord min-fl2-subnormal-ord)]
  166. [max-fl2-subnormal-ord (min max-ord max-fl2-subnormal-ord)])
  167. (build-list
  168. n (? (_)
  169. (define r (random))
  170. (ordinal->flonum
  171. (cond [(and (min-subnormal-ord . < . max-subnormal-ord) (r . < . 0.1))
  172. (random-integer min-subnormal-ord max-subnormal-ord)]
  173. [(and (min-fl2-subnormal-ord . < . max-fl2-subnormal-ord) (r . < . 0.2))
  174. (random-integer min-subnormal-ord max-subnormal-ord)]
  175. [else
  176. (random-integer min-ord max-ord)]))))))
  177. (define denom-dist (geometric-dist 1e-32))
  178. (: sample-rational (Integer -> (Listof Exact-Rational)))
  179. (define (sample-rational n)
  180. (map (?: ([f1 : Flonum] [d : Integer])
  181. (+ (inexact->exact f1)
  182. (* (if ((random) . > . 0.5) -1 1)
  183. (/ (random-natural (+ 1 d)) d)
  184. (expt 2 (- (exact-round (/ (fllog (flabs f1)) (fllog 2.0))) 52)))))
  185. (sample-flonum n)
  186. (map (?: ([x : Flonum]) (+ 1 (exact-floor x))) (sample denom-dist n))))
  187. ;; ===================================================================================================
  188. ;; Flonum functions
  189. (define-type Flonum-Error (U Flonum (List Symbol Flonum Real)))
  190. (define-type Unary-Flonum-Failure (List (List Symbol Flonum) Flonum-Error))
  191. (define-type Binary-Flonum-Failure (List (List Symbol Flonum Flonum) Flonum-Error))
  192. (: flonum-error (Flonum Bigfloat -> Flonum-Error))
  193. (define (flonum-error z z0.bf)
  194. (define z0 (bigfloat->real* z0.bf))
  195. (cond [(different-zero? z z0) (list 'different-zero? z z0)]
  196. [else (flulp-error z z0)]))
  197. (: unary-flonum-fun-error ((Flonum -> Flonum) (Bigfloat -> Bigfloat) Flonum -> Flonum-Error))
  198. (define (unary-flonum-fun-error f g x)
  199. (flonum-error (f x) (parameterize ([bf-precision 53])
  200. (g (bf x)))))
  201. (: test-unary-flonum-fun
  202. (Symbol (Flonum -> Flonum) (Bigfloat -> Bigfloat) Integer Flonum Flonum
  203. -> (Listof Unary-Flonum-Failure)))
  204. (define (test-unary-flonum-fun name f g n mn mx)
  205. (define xs (append standard-xs (sample-flonum n mn mx)))
  206. (define m (length xs))
  207. (filter/ulp-error
  208. (for/list: : (Listof Unary-Flonum-Failure) ([x (in-list xs)]
  209. [i (in-naturals 1)])
  210. (maybe-print-progress name i m)
  211. (list (list name x) (unary-flonum-fun-error f g x)))
  212. (current-max-ulp-error)))
  213. (: binary-flonum-fun-error
  214. ((Flonum Flonum -> Flonum) (Bigfloat Bigfloat -> Bigfloat) Flonum Flonum -> Flonum-Error))
  215. (define (binary-flonum-fun-error f g x y)
  216. (flonum-error (f x y) (parameterize ([bf-precision 53])
  217. (g (bf x) (bf y)))))
  218. (: test-binary-flonum-fun
  219. (Symbol (Flonum Flonum -> Flonum) (Bigfloat Bigfloat -> Bigfloat) Integer
  220. -> (Listof Binary-Flonum-Failure)))
  221. (define (test-binary-flonum-fun name f g n)
  222. (define-values (pre-xs pre-ys) (product standard-xs standard-xs))
  223. (define xs (append pre-xs (sample-flonum n)))
  224. (define ys (append pre-ys (sample-flonum n)))
  225. (define m (length xs))
  226. (filter/ulp-error
  227. (for/list: : (Listof Binary-Flonum-Failure) ([x (in-list xs)]
  228. [y (in-list ys)]
  229. [i (in-naturals 1)])
  230. (maybe-print-progress name i m)
  231. (list (list name x y) (binary-flonum-fun-error f g x y)))
  232. (current-max-ulp-error)))
  233. ;; ===================================================================================================
  234. ;; fl2 conversion
  235. (define-type Fl2-Error (U Flonum (List Symbol Flonum Real)))
  236. (define-type Fl2-Failure (List (List 'fl2 Real) Fl2-Error))
  237. (: fl2-error (Flonum Flonum Real -> Fl2-Error))
  238. (define (fl2-error x2 x1 x)
  239. (cond [(not (fl2? x2 x1)) (list 'not-fl2? x2 x1)]
  240. [(different-zero? x2 x) (list 'different-zero? x2 x)]
  241. [else (fl2ulp-error x2 x1 x)]))
  242. (: fl2-conversion-error (Real -> Fl2-Error))
  243. (define (fl2-conversion-error x)
  244. (define-values (x2 x1) (fl2 x))
  245. (fl2-error x2 x1 x))
  246. (: test-fl2-conversion (Integer -> (Listof Fl2-Failure)))
  247. (define (test-fl2-conversion n)
  248. (define xs (append standard-rs (sample-rational n)))
  249. (define m (length xs))
  250. (filter/ulp-error
  251. (for/list: : (Listof Fl2-Failure) ([x (in-list xs)]
  252. [i (in-naturals 1)])
  253. (maybe-print-progress 'fl2 i m)
  254. (list (list 'fl2 x) (fl2-conversion-error x)))
  255. (current-max-ulp-error)))
  256. ;; ===================================================================================================
  257. ;; Flonum arithmetic with error
  258. (define-type Unary-Fl/Error-Failure (List (List Symbol Flonum) Fl2-Error))
  259. (define-type Binary-Fl/Error-Failure (List (List Symbol Flonum Flonum) Fl2-Error))
  260. (: unary-flonum/error-fun-error ((Flonum -> (Values Flonum Flonum)) (Bigfloat -> Bigfloat) Flonum
  261. -> Fl2-Error))
  262. (define (unary-flonum/error-fun-error f g x)
  263. (define-values (z2 z1) (f x))
  264. (fl2-error z2 z1 (parameterize ([bf-precision 256])
  265. (bigfloat->real* (g (bf x))))))
  266. (: binary-flonum/error-fun-error ((Flonum Flonum -> (Values Flonum Flonum))
  267. (Bigfloat Bigfloat -> Bigfloat)
  268. Flonum Flonum
  269. -> Fl2-Error))
  270. (define (binary-flonum/error-fun-error f g x y)
  271. (define-values (z2 z1) (f x y))
  272. (fl2-error z2 z1 (parameterize ([bf-precision 256])
  273. (bigfloat->real* (g (bf x) (bf y))))))
  274. (: test-unary-flonum/error-fun
  275. (Symbol (Flonum -> (Values Flonum Flonum)) (Bigfloat -> Bigfloat) Integer
  276. -> (Listof Unary-Fl/Error-Failure)))
  277. (define (test-unary-flonum/error-fun name f g n)
  278. (define xs (append standard-xs (sample-flonum n)))
  279. (define m (length xs))
  280. (filter/ulp-error
  281. (for/list: : (Listof Unary-Fl/Error-Failure) ([x (in-list xs)]
  282. [i (in-naturals 1)])
  283. (maybe-print-progress name i m)
  284. (list (list name x) (unary-flonum/error-fun-error f g x)))
  285. (current-max-ulp-error)))
  286. (: test-binary-flonum/error-fun
  287. (Symbol (Flonum Flonum -> (Values Flonum Flonum)) (Bigfloat Bigfloat -> Bigfloat) Integer
  288. -> (Listof Binary-Fl/Error-Failure)))
  289. (define (test-binary-flonum/error-fun name f g n)
  290. (define-values (pre-xs pre-ys) (product standard-xs standard-xs))
  291. (define xs (append pre-xs (sample-flonum n)))
  292. (define ys (append pre-ys (sample-flonum n)))
  293. (define m (length xs))
  294. (filter/ulp-error
  295. (for/list: : (Listof Binary-Fl/Error-Failure) ([x (in-list xs)]
  296. [y (in-list ys)]
  297. [i (in-naturals 1)])
  298. (maybe-print-progress name i m)
  299. (list (list name x y) (binary-flonum/error-fun-error f g x y)))
  300. (current-max-ulp-error)))
  301. ;; ===================================================================================================
  302. ;; Flonum expansions
  303. (define-type Unary-Fl2-Failure (List (List Symbol Flonum Flonum) Fl2-Error))
  304. (define-type Binary-Fl2-Failure (List (List Symbol Flonum Flonum Flonum Flonum) Fl2-Error))
  305. (: unary-fl2-fun-error ((Flonum Flonum -> (Values Flonum Flonum)) (Bigfloat -> Bigfloat)
  306. Flonum Flonum -> Fl2-Error))
  307. (define (unary-fl2-fun-error f g x2 x1)
  308. (define-values (z2 z1) (f x2 x1))
  309. (fl2-error z2 z1 (parameterize ([bf-precision 256])
  310. (bigfloat->real* (g (bf (fl2->real* x2 x1)))))))
  311. (: test-unary-fl2-fun
  312. (Symbol (Flonum Flonum -> (Values Flonum Flonum)) (Bigfloat -> Bigfloat) Integer
  313. -> (Listof Unary-Fl2-Failure)))
  314. (define (test-unary-fl2-fun name f g n)
  315. (define xs (append standard-rs (sample-rational n)))
  316. (define m (length xs))
  317. (filter/ulp-error
  318. (for/list: : (Listof Unary-Fl2-Failure) ([x (in-list xs)]
  319. [i (in-naturals 1)])
  320. (maybe-print-progress name i m)
  321. (define-values (x2 x1) (fl2 x))
  322. (list (list name x2 x1) (unary-fl2-fun-error f g x2 x1)))
  323. (current-max-ulp-error)))
  324. (: binary-fl2-fun-error ((Flonum Flonum Flonum Flonum -> (Values Flonum Flonum))
  325. (Bigfloat Bigfloat -> Bigfloat)
  326. Flonum Flonum Flonum Flonum
  327. -> Fl2-Error))
  328. (define (binary-fl2-fun-error f g x2 x1 y2 y1)
  329. (define-values (z2 z1) (f x2 x1 y2 y1))
  330. (fl2-error z2 z1 (parameterize ([bf-precision 256])
  331. (bigfloat->real* (g (bf (fl2->real* x2 x1)) (bf (fl2->real* y2 y1)))))))
  332. (: test-binary-fl2-fun
  333. (Symbol (Flonum Flonum Flonum Flonum -> (Values Flonum Flonum)) (Bigfloat Bigfloat -> Bigfloat)
  334. Integer -> (Listof Binary-Fl2-Failure)))
  335. (define (test-binary-fl2-fun name f g n)
  336. (define-values (pre-xs pre-ys) (product standard-rs standard-rs))
  337. (define xs (append pre-xs (sample-rational n)))
  338. (define ys (append pre-ys (sample-rational n)))
  339. (define m (length xs))
  340. (filter/ulp-error
  341. (for/list: : (Listof Binary-Fl2-Failure) ([x (in-list xs)]
  342. [y (in-list ys)]
  343. [i (in-naturals 1)])
  344. (maybe-print-progress name i m)
  345. (define-values (x2 x1) (fl2 x))
  346. (define-values (y2 y1) (fl2 y))
  347. (list (list name x2 x1 y2 y1) (binary-fl2-fun-error f g x2 x1 y2 y1)))
  348. (current-max-ulp-error)))
  349. ;; ===================================================================================================
  350. ;; Flonum tests
  351. (define-syntax-rule (define-unary-flonum-test test-name flop bfop mn mx ulps)
  352. (begin (: test-name (Natural -> (Listof Unary-Flonum-Failure)))
  353. (define (test-name n)
  354. (parameterize ([current-max-ulp-error ulps])
  355. (test-unary-flonum-fun 'flop flop bfop n mn mx)))))
  356. (define-syntax-rule (define-binary-flonum-test test-name flop bfop ulps)
  357. (begin (: test-name (Natural -> (Listof Binary-Flonum-Failure)))
  358. (define (test-name n)
  359. (parameterize ([current-max-ulp-error ulps])
  360. (test-binary-flonum-fun 'flop flop bfop n)))))
  361. (define-unary-flonum-test test-flabs flabs bfabs -inf.0 +inf.0 flonum-fun-ulps)
  362. (define-unary-flonum-test test-flsqrt flsqrt bfsqrt 0.0 +inf.0 flonum-fun-ulps)
  363. (define-unary-flonum-test test-fllog fllog bflog 0.0 +inf.0 flonum-fun-ulps)
  364. (define-unary-flonum-test test-flexp flexp bfexp -746.0 710.0 flonum-fun-ulps)
  365. (define-unary-flonum-test test-flsin flsin bfsin -inf.0 +inf.0 flonum-fun-ulps)
  366. (define-unary-flonum-test test-flcos flcos bfcos -inf.0 +inf.0 flonum-fun-ulps)
  367. (define-unary-flonum-test test-fltan fltan bftan -inf.0 +inf.0 flonum-fun-ulps)
  368. (define-unary-flonum-test test-flasin flasin bfasin -1.0 1.0 flonum-fun-ulps)
  369. (define-unary-flonum-test test-flacos flacos bfacos -1.0 1.0 flonum-fun-ulps)
  370. (define-unary-flonum-test test-flatan flatan bfatan -inf.0 +inf.0 flonum-fun-ulps)
  371. (define-unary-flonum-test test-fllog2 fllog2 bflog2 0.0 +inf.0 fllog2-ulps)
  372. (define-binary-flonum-test test-fl+ fl+ bf+ flonum-fun-ulps)
  373. (define-binary-flonum-test test-fl- fl- bf- flonum-fun-ulps)
  374. (define-binary-flonum-test test-fl* fl* bf* flonum-fun-ulps)
  375. (define-binary-flonum-test test-fl/ fl/ bf/ flonum-fun-ulps)
  376. (define-binary-flonum-test test-flexpt flexpt bfexpt flonum-fun-ulps)
  377. (define-binary-flonum-test test-fllogb fllogb bflogb fllogb-ulps)
  378. ;; ===================================================================================================
  379. ;; Flonum/error tests
  380. (define-syntax-rule (define-unary-flop/error-test test-name flop bfop ulps)
  381. (begin (: test-name (Natural -> (Listof Unary-Fl/Error-Failure)))
  382. (define (test-name n)
  383. (parameterize ([current-max-ulp-error ulps])
  384. (test-unary-flonum/error-fun 'flop flop bfop n)))))
  385. (define-syntax-rule (define-binary-flop/error-test test-name flop bfop ulps)
  386. (begin (: test-name (Natural -> (Listof Binary-Fl/Error-Failure)))
  387. (define (test-name n)
  388. (parameterize ([current-max-ulp-error ulps])
  389. (test-binary-flonum/error-fun 'flop flop bfop n)))))
  390. (define-unary-flop/error-test test-flsqr/error flsqr/error bfsqr flonum/error-fun-ulps)
  391. (define-unary-flop/error-test test-flsqrt/error flsqrt/error bfsqrt flonum/error-fun-ulps)
  392. (define-unary-flop/error-test test-flexp/error flexp/error bfexp flexp/error-fun-ulps)
  393. (define-binary-flop/error-test test-fl+/error fl+/error bf+ flonum/error-fun-ulps)
  394. (define-binary-flop/error-test test-fl-/error fl-/error bf- flonum/error-fun-ulps)
  395. (define-binary-flop/error-test test-fl*/error fl*/error bf* flonum/error-fun-ulps)
  396. (define-binary-flop/error-test test-fl//error fl//error bf/ flonum/error-fun-ulps)
  397. ;; ===================================================================================================
  398. ;; fl2 tests
  399. (: test-fl2 (Natural -> (Listof Fl2-Failure)))
  400. (define (test-fl2 n)
  401. (parameterize ([current-max-ulp-error fl2-conversion-ulps])
  402. (test-fl2-conversion n)))
  403. (define-syntax-rule (define-unary-fl2-test test-name fl2op bfop ulps)
  404. (begin (: test-name (Natural -> (Listof Unary-Fl2-Failure)))
  405. (define (test-name n)
  406. (parameterize ([current-max-ulp-error ulps])
  407. (test-unary-fl2-fun 'fl2op fl2op bfop n)))))
  408. (define-syntax-rule (define-binary-fl2-test test-name fl2op bfop ulps)
  409. (begin (: test-name (Natural -> (Listof Binary-Fl2-Failure)))
  410. (define (test-name n)
  411. (parameterize ([current-max-ulp-error ulps])
  412. (test-binary-fl2-fun 'fl2op fl2op bfop n)))))
  413. (define-unary-fl2-test test-fl2abs fl2abs bfabs unary-fl2-fun-ulps)
  414. (define-unary-fl2-test test-fl2sqr fl2sqr bfsqr unary-fl2-fun-ulps)
  415. (define-unary-fl2-test test-fl2sqrt fl2sqrt bfsqrt unary-fl2-fun-ulps)
  416. (define-unary-fl2-test test-fl2exp fl2exp bfexp fl2exp-fun-ulps)
  417. (define-unary-fl2-test test-fl2expm1 fl2expm1 bfexpm1 fl2exp-fun-ulps)
  418. (define-unary-fl2-test test-fl2log fl2log bflog fl2log-fun-ulps)
  419. (define-unary-fl2-test test-fl2log1p fl2log1p bflog1p fl2log-fun-ulps)
  420. (define-binary-fl2-test test-fl2+ fl2+ bf+ binary-fl2-fun-ulps)
  421. (define-binary-fl2-test test-fl2- fl2- bf- binary-fl2-fun-ulps)
  422. (define-binary-fl2-test test-fl2* fl2* bf* binary-fl2-fun-ulps)
  423. (define-binary-fl2-test test-fl2/ fl2/ bf/ binary-fl2-fun-ulps)
  424. ;; ===================================================================================================
  425. ;; Comprehensive test
  426. (: test-floating-point (Natural -> (Listof (U Unary-Flonum-Failure
  427. Binary-Flonum-Failure
  428. Unary-Fl/Error-Failure
  429. Binary-Fl/Error-Failure
  430. Fl2-Failure
  431. Unary-Fl2-Failure
  432. Binary-Fl2-Failure))))
  433. (define (test-floating-point n)
  434. (append
  435. ;; Hardware implementation tests
  436. (test-flabs n)
  437. (test-fl+ n)
  438. (test-fl* n)
  439. (test-fl- n)
  440. (test-fl/ n)
  441. (test-flsqrt n)
  442. (test-fllog n)
  443. (test-flexp n)
  444. (test-flexpt n)
  445. (test-flsin n)
  446. (test-flcos n)
  447. (test-fltan n)
  448. (test-flasin n)
  449. (test-flacos n)
  450. (test-flatan n)
  451. (test-fllog2 n)
  452. (test-fllogb n)
  453. ;; Derived tests
  454. (test-fl+/error n)
  455. (test-fl-/error n)
  456. (test-fl*/error n)
  457. (test-flsqr/error n)
  458. (test-fl//error n)
  459. (test-fl2 n)
  460. (test-fl2abs n)
  461. (test-fl2+ n)
  462. (test-fl2- n)
  463. (test-fl2* n)
  464. (test-fl2sqr n)
  465. (test-fl2/ n)
  466. (test-flsqrt/error n)
  467. (test-fl2sqrt n)
  468. (test-flexp/error n)
  469. (test-fl2exp n)
  470. (test-fl2expm1 n)
  471. (test-fl2log n)
  472. (test-fl2log1p n)
  473. ))