summaryrefslogtreecommitdiffstats
path: root/r4rstest.scm
diff options
context:
space:
mode:
authorBryan Newbold <bnewbold@robocracy.org>2017-02-20 00:05:34 -0800
committerBryan Newbold <bnewbold@robocracy.org>2017-02-20 00:05:34 -0800
commit50eb784bfcf15ee3c6b0b53d747db92673395040 (patch)
tree60f039bb5aa27bc58d92ab0c7bab0d82dbfe7686 /r4rstest.scm
parentae2b295c7deaf2d7c18ad1ed9b6050970e56bae7 (diff)
downloadscm-50eb784bfcf15ee3c6b0b53d747db92673395040.tar.gz
scm-50eb784bfcf15ee3c6b0b53d747db92673395040.zip
Import Upstream version 5e3upstream/5e3
Diffstat (limited to 'r4rstest.scm')
-rw-r--r--r4rstest.scm124
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)