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

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

@ -5,6 +5,8 @@
(require racket/extflonum racket/random racket/list) (require racket/extflonum racket/random racket/list)
(define has-single-flonum? (not (eq? 'chez-scheme (system-type 'vm))))
(test #f number? 'a) (test #f number? 'a)
(test #f complex? 'a) (test #f complex? 'a)
(test #f real? 'a) (test #f real? 'a)
@ -79,8 +81,8 @@
(test #f single-flonum? 1.2) (test #f single-flonum? 1.2)
(test #t flonum? 1.2e3) (test #t flonum? 1.2e3)
(test #f single-flonum? 1.2e3) (test #f single-flonum? 1.2e3)
(test #f flonum? 1.2f3) (test (not has-single-flonum?) flonum? 1.2f3)
(test #t single-flonum? 1.2f3) (test has-single-flonum? single-flonum? 1.2f3)
(test #t complex? -4.242154731064108e-5-6.865001427422244e-5i) (test #t complex? -4.242154731064108e-5-6.865001427422244e-5i)
(test #f exact? -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 #t real? +inf.f)
(test #f rational? +inf.f) (test #f rational? +inf.f)
(test #f integer? +inf.f) (test #f integer? +inf.f)
(test #f flonum? +inf.f) (test (not has-single-flonum?) flonum? +inf.f)
(test #t single-flonum? +inf.f) (test has-single-flonum? single-flonum? +inf.f)
(test #t number? -inf.f) (test #t number? -inf.f)
(test #t complex? -inf.f) (test #t complex? -inf.f)
(test #t real? -inf.f) (test #t real? -inf.f)
(test #f rational? -inf.f) (test #f rational? -inf.f)
(test #f integer? -inf.f) (test #f integer? -inf.f)
(test #f flonum? -inf.f) (test (not has-single-flonum?) flonum? -inf.f)
(test #t single-flonum? -inf.f) (test has-single-flonum? single-flonum? -inf.f)
(test #t number? +nan.f) (test #t number? +nan.f)
(test #t complex? +nan.f) (test #t complex? +nan.f)
(test #t real? +nan.f) (test #t real? +nan.f)
(test #f rational? +nan.f) (test #f rational? +nan.f)
(test #f integer? +nan.f) (test #f integer? +nan.f)
(test #f flonum? +nan.f) (test (not has-single-flonum?) flonum? +nan.f)
(test #t single-flonum? +nan.f) (test has-single-flonum? single-flonum? +nan.f)
(test #t number? -nan.f) (test #t number? -nan.f)
(test #t complex? -nan.f) (test #t complex? -nan.f)
(test #t real? -nan.f) (test #t real? -nan.f)
(test #f rational? -nan.f) (test #f rational? -nan.f)
(test #f integer? -nan.f) (test #f integer? -nan.f)
(test #f flonum? -nan.f) (test (not has-single-flonum?) flonum? -nan.f)
(test #t single-flonum? -nan.f) (test has-single-flonum? single-flonum? -nan.f)
(arity-test inexact? 1 1) (arity-test inexact? 1 1)
(arity-test number? 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 "+nan.0" number->string +nan.0) (test "+nan.0" number->string +nan.0)
(test "+inf.f" number->string +inf.f) (test (if has-single-flonum? "+inf.f" "+inf.0") number->string +inf.f)
(test "-inf.f" number->string -inf.f) (test (if has-single-flonum? "-inf.f" "-inf.0") number->string -inf.f)
(test "+nan.f" number->string +nan.f) (test (if has-single-flonum? "+nan.f" "+nan.0") number->string +nan.f)
(test "+nan.f" number->string +nan.f) (test (if has-single-flonum? "+nan.f" "+nan.0") number->string +nan.f)
(test "0.0f0" number->string 0.0f0) (test (if has-single-flonum? "0.0f0" "0.0") number->string 0.0f0)
(test "0.0f0" number->string 0.0f1) (test (if has-single-flonum? "0.0f0" "0.0") number->string 0.0f1)
(test "0.0f0" number->string 0.0f17) (test (if has-single-flonum? "0.0f0" "0.0") number->string 0.0f17)
(test "13.25f0" number->string 13.25f0) (test (if has-single-flonum? "13.25f0" "13.25") number->string 13.25f0)
(test "13.25f0" number->string 1.325f1) (test (if has-single-flonum? "13.25f0" "13.25") number->string 1.325f1)
(test "-4.25f0" number->string -4.25f0) (test (if has-single-flonum? "-4.25f0" "-4.25") number->string -4.25f0)
(map (lambda (n) (map (lambda (n)
;; test that fresh strings are generated: ;; test that fresh strings are generated:
@ -723,9 +725,10 @@
(err/rt-test (inexact->exact -inf.0)) (err/rt-test (inexact->exact -inf.0))
(err/rt-test (inexact->exact +nan.0)) (err/rt-test (inexact->exact +nan.0))
(err/rt-test (inexact->exact +inf.f) (lambda (exn) (regexp-match? #rx"[+]inf[.]f" (exn-message exn)))) (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 -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)))))
(test 2.0f0 real->single-flonum 2) (test 2.0f0 real->single-flonum 2)
(test 2.25f0 real->single-flonum 2.25) (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.0 1))
(err/rt-test (arithmetic-shift 1 1.0)) (err/rt-test (arithmetic-shift 1 1.0))
(err/rt-test (arithmetic-shift 1 1.0+0.0i)) (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 #f bitwise-bit-set? 13 1)
(test #t bitwise-bit-set? 13 2) (test #t bitwise-bit-set? 13 2)
@ -3194,7 +3198,7 @@
(test 0.5 there-and-back 1/2) (test 0.5 there-and-back 1/2)
(let ([s (make-bytes 8)] (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 s)
(test s real->floating-point-bytes n 8 #f)) (test s real->floating-point-bytes n 8 #f))
@ -3244,48 +3248,49 @@
(test #t single-flonum-ish? op 2.0f0 1/2) (test #t single-flonum-ish? op 2.0f0 1/2)
(test #t single-flonum-ish? op 4/5 0.5f0)))) (test #t single-flonum-ish? op 4/5 0.5f0))))
(unless (eq? 'chez-scheme (system-type 'vm))
(map (check-single-flonum) (map (check-single-flonum)
(list + - * / (list + - * /
add1 add1
sub1 sub1
sqrt sqrt
expt expt
exp exp
sin sin
cos cos
tan tan
asin asin
acos)) acos))
(map (check-single-flonum #:arity-one-only? #t) (map (check-single-flonum #:arity-one-only? #t)
(list log)) (list log))
(map (check-single-flonum #:two-arg-real-only? #t) (map (check-single-flonum #:two-arg-real-only? #t)
(list atan)) (list atan))
(map (check-single-flonum #:real-only? #f #:integer-only? #t) (map (check-single-flonum #:real-only? #f #:integer-only? #t)
(list quotient (list quotient
remainder remainder
modulo)) modulo))
(map (check-single-flonum #:real-only? #t) (map (check-single-flonum #:real-only? #t)
(list (list
abs abs
max max
min min
gcd gcd
lcm lcm
round round
floor floor
ceiling ceiling
truncate)) truncate)))
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; This test once trigggered a crash due to an incorrect ;; This test once trigggered a crash due to an incorrect
;; hard-wired GC declaration for xform: ;; hard-wired GC declaration for xform:
(let () (when (eq? 'racket (system-type 'vm))
(define (root n r) (define (root n r)
(expt n (/ 1 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))]) (let-values ([(s r) (exact-integer-sqrt (inexact->exact n))])
(if (inexact? n) (if (inexact? n)
(exact->inexact s) (exact->inexact s)
s))])) s))]
[else n]))
(define/who (integer-sqrt/remainder n) (define/who (integer-sqrt/remainder n)
(check who integer? n) (check who integer? n)
@ -166,6 +167,10 @@
(check who exact-nonnegative-integer? start) (check who exact-nonnegative-integer? start)
(check who exact-nonnegative-integer? end) (check who exact-nonnegative-integer? end)
(case (- end start) (case (- end start)
[(1)
(if signed?
(bytevector-s8-ref bstr start)
(bytevector-u8-ref bstr start))]
[(2) [(2)
(if signed? (if signed?
(bytevector-s16-ref bstr start (if big-endian? (bytevector-s16-ref bstr start (if big-endian?
@ -192,7 +197,7 @@
(endianness little))))] (endianness little))))]
[else [else
(raise-arguments-error 'integer-bytes->integer (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))])] "length" (- end start))])]
[(bstr signed?) [(bstr signed?)
(integer-bytes->integer bstr signed? (system-big-endian?) 0 (and (bytes? bstr) (bytes-length bstr)))] (integer-bytes->integer bstr signed? (system-big-endian?) 0 (and (bytes? bstr) (bytes-length bstr)))]
@ -287,9 +292,10 @@
(define/who gcd (define/who gcd
(case-lambda (case-lambda
[() 0]
[(n) [(n)
(check who rational? n) (check who rational? n)
n] (abs n)]
[(n m) [(n m)
(check who rational? n) (check who rational? n)
(check who rational? m) (check who rational? m)
@ -313,9 +319,10 @@
(define/who lcm (define/who lcm
(case-lambda (case-lambda
[() 1]
[(n) [(n)
(check who rational? n) (check who rational? n)
n] (abs n)]
[(n m) [(n m)
(check who rational? n) (check who rational? n)
(check who rational? m) (check who rational? m)