suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

cs: repair some number-test failures

Browse Source
This commit is contained in:
Matthew Flatt 2019-01-15 20:30:36 -07:00
parent 349207d19f
commit 345339990f
2 changed files with 74 additions and 62 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

55
pkgs/racket-test-core/tests/racket/number.rktl
View File

@ -5,6 +5,8 @@
(require racket/extflonum racket/random racket/list)
(define has-single-flonum? (not (eq? 'chez-scheme (system-type 'vm))))
(test #f number? 'a)
(test #f complex? 'a)
(test #f real? 'a)
@ -79,8 +81,8 @@
(test #f single-flonum? 1.2)
(test #t flonum? 1.2e3)
(test #f single-flonum? 1.2e3)
(test #f flonum? 1.2f3)
(test #t single-flonum? 1.2f3)
(test (not has-single-flonum?) flonum? 1.2f3)
(test has-single-flonum? single-flonum? 1.2f3)
(test #t complex? -4.242154731064108e-5-6.865001427422244e-5i)
(test #f exact? -4.242154731064108e-5-6.865001427422244e-5i)
@ -119,32 +121,32 @@
(test #t real? +inf.f)
(test #f rational? +inf.f)
(test #f integer? +inf.f)
(test #f flonum? +inf.f)
(test #t single-flonum? +inf.f)
(test (not has-single-flonum?) flonum? +inf.f)
(test has-single-flonum? single-flonum? +inf.f)
(test #t number? -inf.f)
(test #t complex? -inf.f)
(test #t real? -inf.f)
(test #f rational? -inf.f)
(test #f integer? -inf.f)
(test #f flonum? -inf.f)
(test #t single-flonum? -inf.f)
(test (not has-single-flonum?) flonum? -inf.f)
(test has-single-flonum? single-flonum? -inf.f)
(test #t number? +nan.f)
(test #t complex? +nan.f)
(test #t real? +nan.f)
(test #f rational? +nan.f)
(test #f integer? +nan.f)
(test #f flonum? +nan.f)
(test #t single-flonum? +nan.f)
(test (not has-single-flonum?) flonum? +nan.f)
(test has-single-flonum? single-flonum? +nan.f)
(test #t number? -nan.f)
(test #t complex? -nan.f)
(test #t real? -nan.f)
(test #f rational? -nan.f)
(test #f integer? -nan.f)
(test #f flonum? -nan.f)
(test #t single-flonum? -nan.f)
(test (not has-single-flonum?) flonum? -nan.f)
(test has-single-flonum? single-flonum? -nan.f)
(arity-test inexact? 1 1)
(arity-test number? 1 1)
@ -163,16 +165,16 @@
(test "+nan.0" number->string +nan.0)
(test "+nan.0" number->string +nan.0)
(test "+inf.f" number->string +inf.f)
(test "-inf.f" number->string -inf.f)
(test "+nan.f" number->string +nan.f)
(test "+nan.f" number->string +nan.f)
(test "0.0f0" number->string 0.0f0)
(test "0.0f0" number->string 0.0f1)
(test "0.0f0" number->string 0.0f17)
(test "13.25f0" number->string 13.25f0)
(test "13.25f0" number->string 1.325f1)
(test "-4.25f0" number->string -4.25f0)
(test (if has-single-flonum? "+inf.f" "+inf.0") number->string +inf.f)
(test (if has-single-flonum? "-inf.f" "-inf.0") number->string -inf.f)
(test (if has-single-flonum? "+nan.f" "+nan.0") number->string +nan.f)
(test (if has-single-flonum? "+nan.f" "+nan.0") number->string +nan.f)
(test (if has-single-flonum? "0.0f0" "0.0") number->string 0.0f0)
(test (if has-single-flonum? "0.0f0" "0.0") number->string 0.0f1)
(test (if has-single-flonum? "0.0f0" "0.0") number->string 0.0f17)
(test (if has-single-flonum? "13.25f0" "13.25") number->string 13.25f0)
(test (if has-single-flonum? "13.25f0" "13.25") number->string 1.325f1)
(test (if has-single-flonum? "-4.25f0" "-4.25") number->string -4.25f0)
(map (lambda (n)
;; test that fresh strings are generated:
@ -723,9 +725,10 @@
(err/rt-test (inexact->exact -inf.0))
(err/rt-test (inexact->exact +nan.0))
(when has-single-flonum?
(err/rt-test (inexact->exact +inf.f) (lambda (exn) (regexp-match? #rx"[+]inf[.]f" (exn-message exn))))
(err/rt-test (inexact->exact -inf.f) (lambda (exn) (regexp-match? #rx"[-]inf[.]f" (exn-message exn))))
(err/rt-test (inexact->exact +nan.f) (lambda (exn) (regexp-match? #rx"[+]nan[.]f" (exn-message exn))))
(err/rt-test (inexact->exact +nan.f) (lambda (exn) (regexp-match? #rx"[+]nan[.]f" (exn-message exn)))))
(test 2.0f0 real->single-flonum 2)
(test 2.25f0 real->single-flonum 2.25)
@ -1248,7 +1251,8 @@
(err/rt-test (arithmetic-shift 1.0 1))
(err/rt-test (arithmetic-shift 1 1.0))
(err/rt-test (arithmetic-shift 1 1.0+0.0i))
(err/rt-test (arithmetic-shift 1 (expt 2 80)) exn:fail:out-of-memory?)
(unless (eq? 'chez-scheme (system-type 'vm))
(err/rt-test (eval '(arithmetic-shift 1 (expt 2 80))) exn:fail:out-of-memory?))
(test #f bitwise-bit-set? 13 1)
(test #t bitwise-bit-set? 13 2)
@ -3194,7 +3198,7 @@
(test 0.5 there-and-back 1/2)
(let ([s (make-bytes 8)]
[n (expt (random 100) (- (random 100)))])
[n (expt (add1 (random 100)) (- (random 100)))])
(test s real->floating-point-bytes n 8 #f s)
(test s real->floating-point-bytes n 8 #f))
@ -3244,6 +3248,7 @@
(test #t single-flonum-ish? op 2.0f0 1/2)
(test #t single-flonum-ish? op 4/5 0.5f0))))
(unless (eq? 'chez-scheme (system-type 'vm))
(map (check-single-flonum)
(list + - * /
@ -3279,13 +3284,13 @@
round
floor
ceiling
truncate))
truncate)))
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; This test once trigggered a crash due to an incorrect
;; hard-wired GC declaration for xform:
(let ()
(when (eq? 'racket (system-type 'vm))
(define (root n r)
(expt n (/ 1 r)))

15
racket/src/cs/rumble/number.ss
View File

@ -28,7 +28,8 @@
(let-values ([(s r) (exact-integer-sqrt (inexact->exact n))])
(if (inexact? n)
(exact->inexact s)
s))]))
s))]
[else n]))
(define/who (integer-sqrt/remainder n)
(check who integer? n)
@ -166,6 +167,10 @@
(check who exact-nonnegative-integer? start)
(check who exact-nonnegative-integer? end)
(case (- end start)
[(1)
(if signed?
(bytevector-s8-ref bstr start)
(bytevector-u8-ref bstr start))]
[(2)
(if signed?
(bytevector-s16-ref bstr start (if big-endian?
@ -192,7 +197,7 @@
(endianness little))))]
[else
(raise-arguments-error 'integer-bytes->integer
"length is not 2, 4, or 8 bytes"
"length is not 1, 2, 4, or 8 bytes"
"length" (- end start))])]
[(bstr signed?)
(integer-bytes->integer bstr signed? (system-big-endian?) 0 (and (bytes? bstr) (bytes-length bstr)))]
@ -287,9 +292,10 @@
(define/who gcd
(case-lambda
[() 0]
[(n)
(check who rational? n)
n]
(abs n)]
[(n m)
(check who rational? n)
(check who rational? m)
@ -313,9 +319,10 @@
(define/who lcm
(case-lambda
[() 1]
[(n)
(check who rational? n)
n]
(abs n)]
[(n m)
(check who rational? n)
(check who rational? m)