diff options
Diffstat (limited to 'r4rstest.scm')
| -rw-r--r-- | r4rstest.scm | 124 |
1 files changed, 80 insertions, 44 deletions
diff --git a/r4rstest.scm b/r4rstest.scm index d0842c5..5025733 100644 --- a/r4rstest.scm +++ b/r4rstest.scm @@ -88,7 +88,7 @@ (list #t #f #\a '() 9739 '(test) record-error "test" "" 'test '#() '#(a b c) )) (define i 1) -(for-each (lambda (x) (display (make-string i #\ )) +(for-each (lambda (x) (display (make-string i #\space)) (set! i (+ 3 i)) (write x) (newline)) @@ -242,6 +242,8 @@ (test '(list 3 4) 'quasiquote (quasiquote (list (unquote (+ 1 2)) 4))) (test '`(list ,(+ 1 2) 4) 'quasiquote '(quasiquote (list (unquote (+ 1 2)) 4))) (SECTION 5 2 1) +(define (tprint x) #t) +(test #t 'tprint (tprint 56)) (define add3 (lambda (x) (+ x 3))) (test 6 'define (add3 3)) (define first car) @@ -341,7 +343,7 @@ (record-error (list #f #t (list 'test-eq?-eqv?-agreement obj1 obj2))) (display "eqv? and eq? disagree about ") (write obj1) - (display #\ ) + (display #\space) (write obj2) (newline))))) @@ -605,6 +607,8 @@ (define f0.0 (string->number "0.0")) (define f0.8 (string->number "0.8")) (define f1.0 (string->number "1.0")) + (define f1e300 (and (string->number "1+3i") (string->number "1e300"))) + (define f1e-300 (and (string->number "1+3i") (string->number "1e-300"))) (define wto write-test-obj) (define lto load-test-obj) (newline) @@ -613,7 +617,27 @@ (SECTION 6 2) (test #f eqv? 1 f1.0) (test #f eqv? 0 f0.0) + (test #t eqv? f0.0 f0.0) + (cond ((= f0.0 (- f0.0)) + (test #t eqv? f0.0 (- f0.0)) + (test #t equal? f0.0 (- f0.0)))) + (cond ((= f0.0 (* -5 f0.0)) + (test #t eqv? f0.0 (* -5 f0.0)) + (test #t equal? f0.0 (* -5 f0.0)))) (SECTION 6 5 5) + (and f1e300 + (let ((f1e300+1e300i (make-rectangular f1e300 f1e300))) + (test f1.0 'magnitude (/ (magnitude f1e300+1e300i) + (* f1e300 (sqrt 2)))) + (test f.25 / f1e300+1e300i (* 4 f1e300+1e300i)))) + (and f1e-300 + (let ((f1e-300+1e-300i (make-rectangular f1e-300 f1e-300))) + (test f1.0 'magnitude (round (/ (magnitude f1e-300+1e-300i) + (* f1e-300 (sqrt 2))))) + (test f.25 / f1e-300+1e-300i (* 4 f1e-300+1e-300i)))) + (test #t = f0.0 f0.0) + (test #t = f0.0 (- f0.0)) + (test #t = f0.0 (* -5 f0.0)) (test #t inexact? f3.9) (test #t 'max (inexact? (max f3.9 4))) (test f4.0 max f3.9 4) @@ -642,18 +666,18 @@ ;;(test f0.0 expt f0.0 f-3.25) (test (atan 1) atan 1 1) - (set! write-test-obj (list f.25 f-3.25));.25 inexact errors less likely. + (set! write-test-obj (list f.25 f-3.25)) ;.25 inexact errors less likely. (set! load-test-obj (list 'define 'foo (list 'quote write-test-obj))) (test #t call-with-output-file - "tmp3" - (lambda (test-file) - (write-char #\; test-file) - (display #\; test-file) - (display ";" test-file) - (write write-test-obj test-file) - (newline test-file) - (write load-test-obj test-file) - (output-port? test-file))) + "tmp3" + (lambda (test-file) + (write-char #\; test-file) + (display #\; test-file) + (display ";" test-file) + (write write-test-obj test-file) + (newline test-file) + (write load-test-obj test-file) + (output-port? test-file))) (check-test-file "tmp3") (set! write-test-obj wto) (set! load-test-obj lto) @@ -748,43 +772,55 @@ (lambda (n1 n2) (= n1 (+ (* n2 (quotient n1 n2)) (remainder n1 n2))))) + (define b3-3 (string->number "33333333333333333333")) + (define b3-2 (string->number "33333333333333333332")) + (define b3-0 (string->number "33333333333333333330")) + (define b2-0 (string->number "2177452800")) (newline) (display ";testing bignums; ") (newline) (SECTION 6 5 7) - (test 0 modulo 33333333333333333333 3) - (test 0 modulo 33333333333333333333 -3) - (test 0 remainder 33333333333333333333 3) - (test 0 remainder 33333333333333333333 -3) - (test 2 modulo 33333333333333333332 3) - (test -1 modulo 33333333333333333332 -3) - (test 2 remainder 33333333333333333332 3) - (test 2 remainder 33333333333333333332 -3) - (test 1 modulo -33333333333333333332 3) - (test -2 modulo -33333333333333333332 -3) - (test -2 remainder -33333333333333333332 3) - (test -2 remainder -33333333333333333332 -3) - - (test 3 modulo 3 33333333333333333333) - (test 33333333333333333330 modulo -3 33333333333333333333) - (test 3 remainder 3 33333333333333333333) - (test -3 remainder -3 33333333333333333333) - (test -33333333333333333330 modulo 3 -33333333333333333333) - (test -3 modulo -3 -33333333333333333333) - (test 3 remainder 3 -33333333333333333333) - (test -3 remainder -3 -33333333333333333333) - - (test 0 modulo -2177452800 86400) - (test 0 modulo 2177452800 -86400) - (test 0 modulo 2177452800 86400) - (test 0 modulo -2177452800 -86400) - (test 0 modulo 0 -2177452800) - (test #t 'remainder (tb 281474976710655325431 65535)) - (test #t 'remainder (tb 281474976710655325430 65535)) + (test 0 modulo b3-3 3) + (test 0 modulo b3-3 -3) + (test 0 remainder b3-3 3) + (test 0 remainder b3-3 -3) + (test 2 modulo b3-2 3) + (test -1 modulo b3-2 -3) + (test 2 remainder b3-2 3) + (test 2 remainder b3-2 -3) + (test 1 modulo (- b3-2) 3) + (test -2 modulo (- b3-2) -3) + (test -2 remainder (- b3-2) 3) + (test -2 remainder (- b3-2) -3) + + (test 3 modulo 3 b3-3) + (test b3-0 modulo -3 b3-3) + (test 3 remainder 3 b3-3) + (test -3 remainder -3 b3-3) + (test (- b3-0) modulo 3 (- b3-3)) + (test -3 modulo -3 (- b3-3)) + (test 3 remainder 3 (- b3-3)) + (test -3 remainder -3 (- b3-3)) + + (test 0 modulo (- b2-0) 86400) + (test 0 modulo b2-0 -86400) + (test 0 modulo b2-0 86400) + (test 0 modulo (- b2-0) -86400) + (test 0 modulo 0 (- b2-0)) + (test #t 'remainder (tb (string->number "281474976710655325431") 65535)) + (test #t 'remainder (tb (string->number "281474976710655325430") 65535)) + + (let ((n (string->number + "30414093201713378043612608166064768844377641568960512"))) + (and n (exact? n) + (do ((pow3 1 (* 3 pow3)) + (cnt 21 (+ -1 cnt))) + ((negative? cnt) + (zero? (modulo n pow3)))))) (SECTION 6 5 8) - (test 281474976710655325431 string->number "281474976710655325431") - (test "281474976710655325431" number->string 281474976710655325431) + (test "281474976710655325431" number->string + (string->number "281474976710655325431")) (report-errs)) (define (test-numeric-predicates) @@ -831,7 +867,7 @@ (test #t eqv? #\space '#\Space) (test #t char? #\a) (test #t char? #\() -(test #t char? #\ ) +(test #t char? #\space) (test #t char? '#\newline) (test #f char=? #\A #\B) |