Import Upstream version 5e3upstream/5e3

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)