[r6rs conformance test from plt scheme
atsmyles@earthlink.net**20100827021047
 Ignore-this: 35512de411311bce60bd199c820e0ec4
] adddir ./test/r6rs
addfile ./test/r6rs/README.txt
hunk ./test/r6rs/README.txt 1
+
+------------------------- An R6RS Test Suite -------------------------
+
+======================================================================
+Files and libraries
+======================================================================
+
+Files that end ".sps" are R6RS programs. The main one is "run.sps",
+which runs all the tests.
+
+Files that end ".sls" are R6RS libraries. For example, "base.sls" is a
+library that implements `(tests r6rs base)', which is a set of tests
+for `(rnrs base)'. Many R6RS implementations will auto-load ".sls"
+files if you put the directory of tests in the right place.
+
+In general, for each `(rnrs <id> ... <id>)' in the standard:
+
+ * There's a library of tests "<id>/.../<id>.sls". It defines and
+   exports a function `run-<id>-...<id>-tests'.
+
+ * There's a program "run/<id>/.../<id>.sps" that imports
+   "<id>/.../<id>.sls", runs the tests, and reports the results.
+
+And then there's 
+
+ * "run.sps", which runs all the tests (as noted above)
+
+ * "run-via-eval.sps", which is similar to "run.ss" but runs each set
+    of tests via `eval'
+
+ * "test.sls", containing `(tests r6rs test)', which implements the
+   testing utilities that are used by all the other libraries
+
+ * "contrib.sls" and "run/contrib.sps", which implement and run
+   contributed tests; these tests might be contributed when someone
+   finds a bug in an implementation that seems worth testing in other
+   implementations; also, they may be difficult to pin to a particular
+   R6RS library; finally, they may use extra libraries from the
+   "contrib" sub-directory
+
+======================================================================
+Limitations and feedback
+======================================================================
+
+The test suite tries to cover all of the bindings of R6RS, and it
+tries to check a variety of uses
+
+One goal of this test suite is to avoid using `eval' (except when
+specifcally testing `eval'). Avoiding `eval' makes the test suite as
+useful as possible to ahead-of-time compilers that implement `eval'
+with a separate interpreter. A drawback of the current approach,
+however, is that if an R6RS implementation doesn't supply one binding
+or does not support a bit of syntax used in a set of tests, then the
+whole set of tests fails to load.
+
+A related problem is that each set of tests is placed into one
+function that runs all the tests. This format creates a block of code
+that is much larger than in a typical program, which might give some
+compilers trouble.
+
+In any case, reports of bugs (in the tests) and new tests would be
+very much appreciated. File either as a Racket bug report at
+
+   http://bugs.racket-lang.org
+
+======================================================================
+Hints on running the tests
+======================================================================
+
+Ikarus (version 0.0.3+)
+------
+
+Put this directory at "<somewhere>/tests/r6rs" and run with "run.sps"
+
+  cd <somewhere>
+  ikarus --r6rs-script tests/r6rs/run.sps
+
+or run an individual library's test, such as "run/program.sps" as
+
+  cd <somewhere>
+  ikarus --r6rs-script tests/r6rs/run/program.sps
+
+Larceny (version 0.962)
+-------
+
+Put this directory at "<somewhere>/tests/r6rs" and run with "run.sps"
+
+  larceny -path <somewhere> -r6rs -program run.sps
+
+or run an individual library's test, such as "run/program.sps" as
+
+  larceny -path <somewhere> -r6rs -program run/program.sps
+
+PLT Scheme (version 4.0.2.5)
+----------
+
+If you get an SVN-based or the "Full" nightly build, then these tests are
+in a `tests/r6rs' collection already. You can run all of the tests using
+
+   mzscheme -l tests/r6rs/run.sps
+
+and so on.
+
+Otherwise, install this directory as a `tests/r6rs' collection,
+perhaps in the location reported by
+
+  (build-path (find-system-path 'addon-dir) 
+              (version) "collects"
+              "tests" "r6rs")
+
+Four tests fail; they correspond to documented non-conformance with
+R6RS.
+
+Ypsilon (version 0.9.6)
+-------
+
+Put this directory at "<somewhere>/tests/r6rs" and run with "run.sps":
+
+  cd <somewhere>
+  ypsilon --sitelib=. --clean-acc tests/r6rs/run.sps
+
+or run an individual library's test, such as "run/program.sps" as
+
+  cd <somewhere>
+  ypsilon --sitelib=. --clean-acc tests/r6rs/run/program.sps 
adddir ./test/r6rs/arithmetic
addfile ./test/r6rs/base.sls
hunk ./test/r6rs/base.sls 1
+#!r6rs
+
+(library (tests r6rs base)
+  (export run-base-tests)
+  (import (rnrs)
+          (tests r6rs test))
+
+  (define (try-reals f but-not)
+    (if (not (member 0 but-not))
+        (f 0))
+    (f -1.0)
+    (f 0.0)
+    (f 1.0)
+    (f 1/2)
+    (f (expt 2 30))
+    (f (expt 2 60))
+    (f (expt 2 90))
+    (f (- (expt 2 90)))
+    (if (not (member +inf.0 but-not))
+        (f +inf.0))
+    (if (not (member -inf.0 but-not))
+        (f -inf.0))
+    (if (not (exists nan? but-not))
+        (f +nan.0)))
+
+  (define (try-complexes f but-not)
+    (try-reals f but-not)
+    (f 1+2i))
+
+  (define (zero-or-nan? v)
+    (or (equal? v 0)
+        (nan? v)))
+
+  (define (one-two-or-two-one? v)
+    (or (equal? v '(1 2))
+        (equal? v '(2 1))))
+
+  ;; Based on tests from Ikarus:
+  (define-syntax divmod-test/?
+    (syntax-rules ()
+      [(_ x1 x2)
+       (begin
+         (test/values (div-and-mod x1 x2)
+                      (div x1 x2)
+                      (mod x1 x2))
+         (test/values (div0-and-mod0 x1 x2)
+                      (div0 x1 x2)
+                      (mod0 x1 x2)))]))
+  (define-syntax divmod-test
+    (syntax-rules ()
+      [(_ x1 x2)
+       (begin
+         (divmod-test/? x1 x2)
+         (test (<= 0 (mod x1 x2)) #t)
+         (test (< (mod x1 x2) (abs x2)) #t)
+         (test (+ (* (div x1 x2) x2) (mod x1 x2)) x1)
+         (test (<= (- (abs (/ x2 2))) (mod0 x1 x2)) #t)
+         (test (< (mod0 x1 x2) (abs (/ x2 2))) #t)
+         (test (+ (* (div0 x1 x2) x2) (mod0 x1 x2)) x1))]))
+
+  (define-syntax try-bad-divs
+    (syntax-rules ()
+      [(_ op)
+       (begin
+         (test/unspec-flonum-or-exn (op 1 0) &assertion)
+         (test/unspec-flonum-or-exn (op 1 0.0) &assertion)
+         (test/unspec-flonum-or-exn (op +inf.0 1) &assertion)
+         (test/unspec-flonum-or-exn (op -inf.0 1) &assertion)
+         (test/unspec-flonum-or-exn (op +nan.0 1) &assertion))]))
+
+  (define-syntax test-string-to-number
+    (syntax-rules ()
+      [(_ [str num] ...) (begin (test (string->number str) num) ...)]))
+
+  (define-syntax test/approx-string-to-number
+    (syntax-rules ()
+      [(_ [str num] ...) (begin (test/approx (string->number str) num) ...)]))
+
+  ;; Definitions ----------------------------------------
+
+  (define add3
+    (lambda (x) (+ x 3)))
+  (define first car)
+
+  (define reverse-subtract
+    (lambda (x y) (- y x)))
+
+  (define add4
+    (let ((x 4))
+      (lambda (y) (+ x y))))
+
+  (define x 0)
+
+  (define gen-counter
+    (lambda ()
+      (let ((n 0))
+        (lambda () (set! n (+ n 1)) n))))
+
+  (define gen-loser
+    (lambda ()
+      (let ((n 0))
+        (lambda () (set! n (+ n 1)) 27))))
+  
+  (define (fac n)
+    (if (not (integer-valued? n))
+        (assertion-violation
+         'fac "non-integral argument" n))
+    (if (negative? n)
+        (assertion-violation
+         'fac "negative argument" n))
+    (letrec
+        ((loop (lambda (n r)
+                 (if (zero? n)
+                     r
+                     (loop (- n 1) (* r n))))))
+      (loop n 1)))
+
+  (define compose
+    (lambda (f g)
+      (lambda args
+        (f (apply g args)))))
+
+  (define list-length
+    (lambda (obj)
+      (call-with-current-continuation
+       (lambda (return)
+         (letrec ((r
+                   (lambda (obj)
+                     (cond ((null? obj) 0)
+                           ((pair? obj)
+                            (+ (r (cdr obj)) 1))
+                           (else (return #f))))))
+           (r obj))))))
+
+  (define-syntax be-like-begin
+    (syntax-rules ()
+      ((be-like-begin name)
+       (define-syntax name
+         (syntax-rules ()
+           ((name expr (... ...))
+            (begin expr (... ...))))))))
+  (be-like-begin sequence)
+
+  (define p (cons 4 5))
+  (define-syntax p.car 
+    (identifier-syntax (car p)))
+
+  (define-syntax kons
+    (identifier-syntax cons))
+
+  ;; Not the same as in the report, because we avoid `set-car!':
+  (define-syntax p2.car
+    (identifier-syntax
+     (_ (car p))
+     ((set! _ e) (set! p (cons e (cdr p))))))
+
+  ;; Expressions ----------------------------------------
+
+  (define (run-base-tests)
+    ;; 11.2.1
+    (test (add3 3) 6)
+    (test (first '(1 2)) 1)
+
+    ;; 11.2.2
+    (test (let ()
+            (define even?
+              (lambda (x)
+                (or (= x 0) (odd? (- x 1)))))
+            (define-syntax odd?
+              (syntax-rules ()
+                ((odd?  x) (not (even? x)))))
+            (even? 10))
+          #t)
+    (test (let ()
+            (define-syntax bind-to-zero
+              (syntax-rules ()
+                ((bind-to-zero id) (define id 0))))
+            (bind-to-zero x)
+            x)
+          0)
+
+    ;; 11.3
+    (test (let ((x 5))
+            (define foo (lambda (y) (bar x y)))
+            (define bar (lambda (a b) (+ (* a b) a)))
+            (foo (+ x 3)))
+          45)
+    (test (let ((x 5))
+            (letrec* ((foo (lambda (y) (bar x y)))
+                      (bar (lambda (a b) (+ (* a b) a))))
+                     (foo (+ x 3))))
+          45)
+
+    (test/exn (letrec ([x y]
+                       [y x])
+                'should-not-get-here)
+              &assertion)
+
+    (test (letrec ([x (if (eq? (cons 1 2) (cons 1 2))
+                          x
+                          1)]) 
+            x)
+          1)
+
+    ;; 11.4.1
+    ;; (These tests are especially silly, since they really
+    ;;  have to work to get this far.)
+    (test (quote a) 'a)
+    (test (quote #(a b c)) (vector 'a 'b 'c))
+    (test (quote (+ 1 2)) '(+ 1 2))
+    (test '"abc" "abc")
+    (test '145932 145932)
+    (test 'a 'a)
+    (test '#(a b c) (vector 'a 'b 'c))
+    (test '() (list))
+    (test '(+ 1 2) '(+ 1 2))
+    (test '(quote a) '(quote a))
+    (test ''a '(quote a))
+
+    ;; 11.4.2
+    ;; (test (lambda (x) (+ x x)) {a procedure})
+    (test ((lambda (x) (+ x x)) 4) 8)
+    (test ((lambda (x)
+             (define (p y)
+               (+ y 1))
+             (+ (p x) x))
+           5) 
+          11)
+    (test (reverse-subtract 7 10) 3)
+    (test (add4 6) 10)
+    (test ((lambda x x) 3 4 5 6) '(3 4 5 6))
+    (test ((lambda (x y . z) z) 3 4 5 6)
+          '(5 6))
+    
+    ;; 11.4.3
+    (test (if (> 3 2) 'yes 'no) 'yes)
+    (test (if (> 2 3) 'yes 'no) 'no)
+    (test (if (> 3 2)
+              (- 3 2)
+              (+ 3 2))
+          1)
+    (test/unspec (if #f #f))
+
+    ;; 11.4.4
+    (test (let ((x 2))
+            (+ x 1)
+            (set! x 4)
+            (+ x 1)) 
+          5)
+
+    ;; 11.4.5
+    (test (cond ((> 3 2) 'greater)
+                ((< 3 2) 'less))          
+          'greater)
+
+    (test (cond ((> 3 3) 'greater)
+                ((< 3 3) 'less)
+                (else 'equal))
+          'equal)
+    (test (cond ('(1 2 3) => cadr)
+                (else #t))          
+          2)
+
+    (test (case (* 2 3)
+            ((2 3 5 7) 'prime)
+            ((1 4 6 8 9) 'composite))
+          'composite)
+    (test/unspec (case (car '(c d))
+                   ((a) 'a)
+                   ((b) 'b)))
+    (test (case (car '(c d))
+            ((a e i o u) 'vowel)
+            ((w y) 'semivowel)
+            (else 'consonant))
+          'consonant)
+
+    (test (and (= 2 2) (> 2 1)) #t)
+    (test (and (= 2 2) (< 2 1)) #f)
+    (test (and 1 2 'c '(f g)) '(f g))
+    (test (and) #t)
+
+    (test (or (= 2 2) (> 2 1)) #t)
+    (test (or (= 2 2) (< 2 1)) #t)
+    (test (or #f #f #f) #f)
+    (test (or '(b c) (/ 3 0)) '(b c))
+
+    ;; 11.4.6
+    (test (let ((x 2) (y 3))
+            (* x y))
+          6)
+
+    (test (let ((x 2) (y 3))
+            (let ((x 7)
+                  (z (+ x y)))
+              (* z x)))
+          35)
+    (test (let ((x 2) (y 3))
+            (let* ((x 7)
+                   (z (+ x y)))
+              (* z x)))
+          70)
+    (test (letrec ((even?
+                    (lambda (n)
+                      (if (zero? n)
+                          #t
+                          (odd? (- n 1)))))
+                   (odd?
+                    (lambda (n)
+                      (if (zero? n)
+                          #f
+                          (even? (- n 1))))))
+            (even? 88))   
+          #t)
+    (test (letrec* ((p
+                     (lambda (x)
+                       (+ 1 (q (- x 1)))))
+                    (q
+                     (lambda (y)
+                       (if (zero? y)
+                           0
+                           (+ 1 (p (- y 1))))))
+                    (x (p 5))
+                    (y x))
+                   y)
+          5)
+    (test (let-values (((a b) (values 1 2))
+                       ((c d) (values 3 4)))
+            (list a b c d))
+          '(1 2 3 4))
+    (test (let-values (((a b . c) (values 1 2 3 4)))
+            (list a b c))
+          '(1 2 (3 4)))
+    (test (let ((a 'a) (b 'b) (x 'x) (y 'y))
+            (let-values (((a b) (values x y))
+                         ((x y) (values a b)))
+              (list a b x y)))
+          '(x y a b))
+    (test (let ((a 'a) (b 'b) (x 'x) (y 'y))
+            (let*-values (((a b) (values x y))
+                          ((x y) (values a b)))
+              (list a b x y)))
+          '(x y x y))
+
+    ;; 11.4.7
+    (test (begin (set! x 5)
+                 (+ x 1))
+          6)
+    (test/output/unspec
+     (begin (display "4 plus 1 equals ")
+            (display (+ 4 1)))
+     "4 plus 1 equals 5")
+
+    ;; 11.5
+    (test (eqv? 'a 'a) #t)
+    (test (eqv? 'a 'b) #f)
+    (test (eqv? 2 2) #t)
+    (test (eqv? '() '()) #t)
+    (test (eqv? 100000000 100000000) #t)
+    (test (eqv? (cons 1 2) (cons 1 2)) #f)
+    (test (eqv? (lambda () 1) (lambda () 2)) #f)
+    (test (eqv? #f 'nil) #f)
+    (test/unspec (let ((p (lambda (x) x)))
+                   (eqv? p p)))
+    (test/unspec (eqv? "" ""))
+    (test/unspec (eqv? '#() '#()))
+    (test/unspec (eqv? (lambda (x) x)
+                       (lambda (x) x)))
+    (test/unspec (eqv? (lambda (x) x) (lambda (y) y)))
+    (test/unspec (eqv? +nan.0 +nan.0))
+
+    (test/unspec (let ((g (gen-counter)))
+                   (eqv? g g)))
+    (test (eqv? (gen-counter) (gen-counter)) #f)
+
+    (test/unspec (let ((g (gen-loser)))
+                   (eqv? g g)))
+    (test/unspec (eqv? (gen-loser) (gen-loser)))
+
+    (test/unspec (letrec ((f (lambda () (if (eqv? f g) 'both 'f)))
+                          (g (lambda () (if (eqv? f g) 'both 'g))))
+                   (eqv? f g)))
+
+    (test (letrec ((f (lambda () (if (eqv? f g) 'f 'both)))
+                   (g (lambda () (if (eqv? f g) 'g 'both))))
+            (eqv? f g))
+          #f)
+    
+    (test/unspec (eqv? '(a) '(a)))
+    (test/unspec (eqv? "a" "a"))
+    (test/unspec (eqv? '(b) (cdr '(a b))))
+    (test (let ((x '(a)))
+            (eqv? x x))
+          #t)
+
+    (test (eq? 'a 'a) #t)
+    (test/unspec (eq? '(a) '(a)))
+    (test (eq? (list 'a) (list 'a)) #f)
+    (test/unspec (eq? "a" "a"))
+    (test/unspec (eq? "" ""))
+    (test (eq? '() '()) #t)
+    (test/unspec (eq? 2 2))
+    (test/unspec (eq? #\A #\A))
+    (test (eq? car car) #t)
+    (test/unspec (let ((n (+ 2 3)))
+                   (eq? n n)))
+    (test (let ((x '(a)))
+            (eq? x x)) 
+          #t)
+    (test/unspec (let ((x '#()))
+                   (eq? x x)))
+    (test/unspec (let ((p (lambda (x) x)))
+                   (eq? p p)))
+
+    (test (equal? 'a 'a) #t)
+    (test (equal? '(a) '(a)) #t)
+    (test (equal? '(a (b) c) '(a (b) c)) #t)
+    (test (equal? "abc" "abc") #t)
+    (test (equal? 2 2) #t)
+    (test (equal? (make-vector 5 'a)
+                  (make-vector 5 'a)) 
+          #t)
+    (test (equal? '#vu8(1 2 3 4 5)
+                  (u8-list->bytevector
+                   '(1 2 3 4 5)))
+          #t)
+    (test/unspec (equal? (lambda (x) x)
+                         (lambda (y) y)))
+
+    (test (let* ((x (list 'a))
+                 (y (list 'a))
+                 (z (list x y)))
+            (list (equal? z (list y x))
+                  (equal? z (list x x))))
+          '(#t #t))
+
+    ;; 11.6
+    (test (procedure? car) #t)
+    (test (procedure? 'car) #f)
+    (test (procedure? (lambda (x) (* x x))) #t)
+    (test (procedure? '(lambda (x) (* x x))) #f)
+
+    ;; 11.7.4
+    (test (complex? 3+4i)                         #t)
+    (test (complex? 3)                            #t)
+    (test (real? 3)                               #t)
+    (test (real? -2.5+0.0i)                       #f)
+    (test (real? -2.5+0i)                         #t)
+    (test (real? -2.5)                            #t)
+    (test (real? #e1e10)                          #t)
+    (test (rational? 6/10)                        #t)
+    (test (rational? 6/3)                         #t)
+    (test (rational? 2)                           #t)
+    (test (integer? 3+0i)                         #t)
+    (test (integer? 3.0)                          #t)
+    (test (integer? 8/4)                          #t)
+
+    (test (number? +nan.0)                        #t)
+    (test (complex? +nan.0)                       #t)
+    (test (real? +nan.0)                          #t)
+    (test (rational? +nan.0)                      #f)
+    (test (complex? +inf.0)                       #t)
+    (test (real? -inf.0)                          #t)
+    (test (rational? -inf.0)                      #f)
+    (test (integer? -inf.0)                       #f)
+
+    (test (real-valued? +nan.0)                   #t)
+    (test (real-valued? +nan.0+0i)                   #t)
+    (test (real-valued? -inf.0)                   #t)
+    (test (real-valued? 3)                        #t)
+    (test (real-valued? -2.5+0.0i)                #t)
+    (test (real-valued? -2.5+0i)                  #t)
+    (test (real-valued? -2.5)                     #t)
+    (test (real-valued? #e1e10)                   #t)
+
+    (test (rational-valued? +nan.0)               #f)
+    (test (rational-valued? -inf.0)               #f)
+    (test (rational-valued? 6/10)                 #t)
+    (test (rational-valued? 6/10+0.0i)            #t)
+    (test (rational-valued? 6/10+0i)              #t)
+    (test (rational-valued? 6/3)                  #t)
+
+    (test (integer-valued? 3+0i)                  #t)
+    (test (integer-valued? 3+0.0i)                #t)
+    (test (integer-valued? 3.0)                   #t)
+    (test (integer-valued? 3.0+0.0i)              #t)
+    (test (integer-valued? 8/4)                   #t)
+
+    (test (exact? 5)                    #t)
+    (test (inexact? +inf.0)             #t)
+
+    (test (inexact 2) 2.0)
+    (test (inexact 2.0) 2.0)
+    (test (exact 2) 2)
+    (test (exact 2.0) 2)
+
+    (for-each
+     (lambda (x y)
+       (let ([try-one
+              (lambda (x y)
+                (let ([try-x
+                       (lambda (x x2)
+                         (test (= x x2) #t)
+                         (test (< x x2) #f)
+                         (test (> x x2) #f)
+                         (test (<= x x2) #t)
+                         (test (>= x x2) #t))])
+                  (try-x x x)
+                  (when (exact? x)
+                    (try-x x (inexact x))
+                    (try-x (inexact x) x)))
+                (test (< x y) #t)
+                (test (<= x y) #t)
+                (test (> x y) #f)
+                (test (>= x y) #f)
+                (test (< y x) #f)
+                (test (<= y x) #f)
+                (test (> y x) #t)
+                (test (>= y x) #t))])
+         (try-one x y)
+         (try-one (inexact x) y)
+         (try-one x (inexact y))
+         (try-one (inexact x) (inexact y))))
+     (list 1/2 1 3/2 (expt 2 100) (expt 2 100))
+     (list 1 2 51/20 (expt 2 102) (/ (* 4 (expt 2 100)) 3)))
+
+    (test (= +inf.0 +inf.0)            #t)
+    (test (= -inf.0 +inf.0)            #f)
+    (test (= -inf.0 -inf.0)            #t)
+    (test (= +nan.0 +nan.0)            #f)
+
+    (try-reals
+     (lambda (x)
+       (test (< -inf.0 x +inf.0)         #t)
+       (test (> +inf.0 x -inf.0)         #t))
+     '(+inf.0 -inf.0 +nan.0))
+
+    (try-complexes
+     (lambda (z)
+       (test (= +nan.0 x)                #f))
+     '())
+
+    (try-reals
+     (lambda (x)
+       (test (< +nan.0 x)                #f)
+       (test (> +nan.0 x)                #f))
+     '())
+
+    (test (zero? +0.0)                   #t)
+    (test (zero? -0.0)                   #t)
+    (test (zero? 2.0)                    #f)
+    (test (zero? -2.0)                   #f)
+    (test (zero? +nan.0)                 #f)
+    (test (positive? 10)                 #t)
+    (test (positive? -10)                #f)
+    (test (positive? +inf.0)             #t)
+    (test (negative? -inf.0)             #t)
+    (test (positive? +nan.0)             #f)
+    (test (negative? 10)                 #f)
+    (test (negative? -10)                #t)
+    (test (negative? +nan.0)             #f)
+    (test (finite? +inf.0)               #f)
+    (test (finite? 5)                    #t)
+    (test (finite? 5.0)                  #t)
+    (test (infinite? 5.0)                #f)
+    (test (infinite? +inf.0)             #t)
+    (test (nan? +nan.0)                  #t)
+    (test (nan? +inf.0)                  #f)
+    (test (nan? 1020.0)                  #f)
+    (test (nan? 1020/3)                  #f)
+
+    (test (odd? 5) #t)
+    (test (odd? 50) #f)
+    (test (odd? 5.0) #t)
+    (test (odd? 50.0) #f)
+    (test (even? 5) #f)
+    (test (even? 50) #t)
+    (test (even? 5.0) #f)
+    (test (even? 50.0) #t)
+
+    (test (max 3 4)                               4)
+    (test (max 3.9 4)                             4.0)
+
+    (try-reals
+     (lambda (x)
+       (test (max +inf.0 x)                          +inf.0)
+       (test (min -inf.0 x)                          -inf.0))
+     '(+nan.0))
+
+    (test (+ 3 4)                                 7)
+    (test (+ 3)                                   3)
+    (test (+)                                     0)
+    (test (+ 3.0 4)                               7.0)
+    (test (+ +inf.0 +inf.0)                       +inf.0)
+    (test (+ +inf.0 -inf.0)                       +nan.0)
+
+    (test (* 4)                                   4)
+    (test (* 4 3)                                 12)
+    (test (* 4 3.0)                               12.0)
+    (test (*)                                     1)
+    (test (* 5 +inf.0)                            +inf.0)
+    (test (* -5 +inf.0)                           -inf.0)
+    (test (* +inf.0 +inf.0)                       +inf.0)
+    (test (* +inf.0 -inf.0)                       -inf.0)
+    (test (zero-or-nan? (* 0 +inf.0)) #t)
+    (test (zero-or-nan? (* 0 +nan.0)) #t)
+    (test (zero? (* 1.0 0)) #t)
+    
+    (try-reals 
+     (lambda (x)
+       (test (+ +inf.0 x)                            +inf.0)
+       (test (+ -inf.0 x)                            -inf.0))
+     '(+inf.0 -inf.0 +nan.0))
+    
+    (try-reals 
+     (lambda (x)
+       (test (+ +nan.0 x)                            +nan.0))
+     '())
+
+    (try-reals 
+     (lambda (x)
+       (test (* +nan.0 x)                            +nan.0))
+     '(0))
+    
+    (test (+ 0.0 -0.0)  0.0)
+    (test (+ -0.0 0.0)  0.0)
+    (test (+ 0.0 0.0)   0.0)
+    (test (+ -0.0 -0.0) -0.0)
+    
+    (test (- 3 4)                                 -1)
+    (test (- 3 4 5)                               -6)
+    (test (- 3)                                   -3)
+    (test (- +inf.0 +inf.0)                       +nan.0)
+    
+    (test (- 0.0)       -0.0)
+    (test (- -0.0)      0.0)
+    (test (- 0.0 -0.0)  0.0)
+    (test (- -0.0 0.0)  -0.0)
+    (test (- 0.0 0.0)   0.0)
+    (test (- -0.0 -0.0) 0.0)
+    
+    (test (/ 3 4 5)                               3/20)
+    (test (/ 2 3)                                 2/3)
+    (test (/ 3 2.0)                               1.5)
+    (test (/ 3)                                   1/3)
+    (test (/ 0.0)                                 +inf.0)
+    (test (/ 1.0 0)                               +inf.0)
+    (test (/ -1 0.0)                              -inf.0)
+    (test (/ +inf.0)                              0.0)
+
+    (test/exn (/ 0 0) &assertion)
+    (test/exn (/ 3 0) &assertion)
+    (test (/ 0 3.5)                               0.0)
+    (test (/ 0 0.0)                               +nan.0)
+    (test (/ 0.0 0)                               +nan.0)
+    (test (/ 0.0 0.0)                             +nan.0)
+
+    (test (abs 7)                                 7)
+    (test (abs -7)                                7)
+    (test (abs (- (expt 2 100)))                  (expt 2 100))
+    (test (abs -inf.0)                            +inf.0)
+
+    (test (div 123 10) 12)
+    (test (mod 123 10) 3)
+    (test (div 123 -10) -12)
+    (test (mod 123 -10) 3)
+    (test (div -123 10) -13)
+    (test (mod -123 10) 7)
+    (test (div -123 -10) 13)
+    (test (mod -123 -10) 7)
+
+    (test (div0 123 10) 12)
+    (test (mod0 123 10) 3)
+    (test (div0 123 -10) -12)
+    (test (mod0 123 -10) 3)
+    (test (div0 -123 10) -12)
+    (test (mod0 -123 10) -3)
+    (test (div0 -123 -10) 12)
+    (test (mod0 -123 -10) -3)
+
+    ;; `divmod-test' cases originally from Ikarus:
+
+    (divmod-test +17 +3)
+    (divmod-test +17 -3)
+    (divmod-test -17 +3)
+    (divmod-test -17 -3)
+    (divmod-test +16 +3)
+    (divmod-test +16 -3)
+    (divmod-test -16 +3)
+    (divmod-test -16 -3)
+    (divmod-test +15 +3)
+    (divmod-test +15 -3)
+    (divmod-test -15 +3)
+    (divmod-test -15 -3)
+    (divmod-test +10 +4)
+    (divmod-test +10 -4)
+    (divmod-test -10 +4)
+    (divmod-test -10 -4)
+
+    (divmod-test +3 +5/6)
+    (divmod-test -3 +5/6)
+    (divmod-test +3 -5/6)
+    (divmod-test -3 -5/6)
+
+    (divmod-test +3 +7/11)
+    (divmod-test -3 +7/11)
+    (divmod-test +3 -7/11)
+    (divmod-test -3 -7/11)
+
+    (divmod-test (least-fixnum)    +1)
+    (divmod-test (least-fixnum)    -1)
+    (divmod-test (greatest-fixnum) +1)
+    (divmod-test (greatest-fixnum) -1)
+    (divmod-test (least-fixnum)    +2)
+    (divmod-test (least-fixnum)    -2)
+    (divmod-test (greatest-fixnum) +2)
+    (divmod-test (greatest-fixnum) -2)
+
+    (divmod-test 0 (least-fixnum))
+    (divmod-test 0 (greatest-fixnum))
+    (divmod-test +1 (least-fixnum))
+    (divmod-test +1 (greatest-fixnum))
+    (divmod-test -1 (least-fixnum))
+    (divmod-test -1 (greatest-fixnum))
+    (divmod-test +2 (least-fixnum))
+    (divmod-test +2 (greatest-fixnum))
+    (divmod-test -2 (least-fixnum))
+    (divmod-test -2 (greatest-fixnum))
+
+    (divmod-test (least-fixnum) (least-fixnum))
+    (divmod-test (greatest-fixnum) (least-fixnum))
+    (divmod-test (least-fixnum) (greatest-fixnum))
+    (divmod-test (greatest-fixnum) (greatest-fixnum))    
+
+    (divmod-test +17.0 +3.0)
+    (divmod-test +17.0 -3.0)
+    (divmod-test -17.0 +3.0)
+    (divmod-test -17.0 -3.0)
+    (divmod-test +16.0 +3.0)
+    (divmod-test +16.0 -3.0)
+    (divmod-test -16.0 +3.0)
+    (divmod-test -16.0 -3.0)
+    (divmod-test +15.0 +3.0)
+    (divmod-test +15.0 -3.0)
+    (divmod-test -15.0 +3.0)
+    (divmod-test -15.0 -3.0)
+    (divmod-test +17.0 +3.5)
+    (divmod-test +17.0 -3.5)
+    (divmod-test -17.0 +3.5)
+    (divmod-test -17.0 -3.5)
+    (divmod-test +16.0 +3.5)
+    (divmod-test +16.0 -3.5)
+    (divmod-test -16.0 +3.5)
+    (divmod-test -16.0 -3.5)
+    (divmod-test +15.0 +3.5)
+    (divmod-test +15.0 -3.5)
+    (divmod-test -15.0 +3.5)
+    (divmod-test -15.0 -3.5)
+    (divmod-test/? +17.0 +nan.0)
+    (divmod-test/? -17.0 +nan.0)
+    (divmod-test/? +17.0 +inf.0)
+    (divmod-test/? +17.0 -inf.0)
+    (divmod-test/? -17.0 +inf.0)
+    (divmod-test/? -17.0 -inf.0)
+
+    (divmod-test +17.0 +3.0)
+    (divmod-test +17.0 -3.0)
+    (divmod-test -17.0 +3.0)
+    (divmod-test -17.0 -3.0)
+    (divmod-test +16.0 +3.0)
+    (divmod-test +16.0 -3.0)
+    (divmod-test -16.0 +3.0)
+    (divmod-test -16.0 -3.0)
+    (divmod-test +15.0 +3.0)
+    (divmod-test +15.0 -3.0)
+    (divmod-test -15.0 +3.0)
+    (divmod-test -15.0 -3.0)
+    (divmod-test +17.0 +3.5)
+    (divmod-test +17.0 -3.5)
+    (divmod-test -17.0 +3.5)
+    (divmod-test -17.0 -3.5)
+    (divmod-test +16.0 +3.5)
+    (divmod-test +16.0 -3.5)
+    (divmod-test -16.0 +3.5)
+    (divmod-test -16.0 -3.5)
+    (divmod-test +15.0 +3.5)
+    (divmod-test +15.0 -3.5)
+    (divmod-test -15.0 +3.5)
+    (divmod-test -15.0 -3.5)
+    (divmod-test +10.0 +4.0)
+    (divmod-test +10.0 -4.0)
+    (divmod-test -10.0 +4.0)
+    (divmod-test -10.0 -4.0)
+    (divmod-test/? +17.0 +nan.0)
+    (divmod-test/? -17.0 +nan.0)
+    (divmod-test/? +17.0 +inf.0)
+    (divmod-test/? +17.0 -inf.0)
+    (divmod-test/? -17.0 +inf.0)
+    (divmod-test/? -17.0 -inf.0)
+
+    (try-bad-divs div)
+    (try-bad-divs mod)
+    (try-bad-divs div-and-mod)
+    (try-bad-divs div0)
+    (try-bad-divs mod0)
+    (try-bad-divs div0-and-mod0)
+
+    (test (gcd 32 -36)                            4)
+    (test (gcd)                                   0)
+    (test (lcm 32 -36)                            288)
+    (test (lcm 32.0 -36)                          288.0)
+    (test (lcm)                                   1)
+    
+    (test (numerator 6)                           6)
+    (test (numerator (/ 6 4))                     3)
+    (test (denominator (/ 6 4))                   2)
+    (test (denominator 6)                         1)
+    (test (denominator (inexact (/ 6 4))) 2.0)
+
+    (test (floor -4.3)                            -5.0)
+    (test (ceiling -4.3)                          -4.0)
+    (test (truncate -4.3)                         -4.0)
+    (test (round -4.3)                            -4.0)
+
+    (test (floor 3.5)                             3.0)
+    (test (ceiling 3.5)                           4.0)
+    (test (truncate 3.5)                          3.0)
+    (test (round 3.5)                             4.0)
+    
+    (test (round 7/2)                             4)
+    (test (round 7)                               7)
+    
+    (test (floor +inf.0)                          +inf.0)
+    (test (ceiling -inf.0)                        -inf.0)
+    (test (round +nan.0)                          +nan.0)
+    
+    (test (rationalize (exact .3) 1/10)          1/3)
+    (test/approx (rationalize .3 1/10) #i1/3)
+    
+    (test (rationalize +inf.0 3)                  +inf.0)
+    (test (rationalize +inf.0 +inf.0)             +nan.0)
+    (test (rationalize 3 +inf.0)                  0.0)
+
+    (test/approx (exp 1)    2.718281828459045)
+    (test (exp +inf.0)                   +inf.0)
+    (test (exp -inf.0)                   0.0)
+    (test/approx (log 2.718281828459045) 1.0)
+    (test (log +inf.0)                   +inf.0)
+    (test (log 0.0)                      -inf.0)
+    (test/approx (log 100 10) 2.0)
+    (test/approx (log 1125899906842624 2) 50.0)
+
+    (test/exn (log 0) &assertion)
+
+    (test/approx (log -inf.0) +inf.0+3.141592653589793i)
+    (test/approx (atan -inf.0) -1.5707963267948965)
+    (test/approx (atan +inf.0) 1.5707963267948965)
+    (test/approx (log -1.0+0.0i) 0.0+3.141592653589793i)
+    (unless (eqv? 0.0 -0.0)
+      (test/approx (log -1.0-0.0i) 0.0-3.141592653589793i))
+
+    (test/approx (sqrt 5) 2.23606797749979)
+    (test/approx (sqrt -5) 0.0+2.23606797749979i)
+
+    (test (sqrt +inf.0)                +inf.0)
+    (test (sqrt -inf.0)                +inf.0i)
+
+    (test/values (exact-integer-sqrt 0) 0 0)
+    (test/values (exact-integer-sqrt 4) 2 0)
+    (test/values (exact-integer-sqrt 5) 2 1)
+    
+    (test (expt 5 3)                   125)
+    (test (expt 5 -3)                  1/125)
+    (test (expt 5 0)                   1)
+    (test (expt 0 5)                   0)
+    (test/approx (expt 0 5+.0000312i)  0.0) ; R6RS (Sept 2007) appears to be wrong; also, test that result is inexact?
+    (test/approx (expt 0.0 5+.0000312i) 0.0)
+    (test/approx (expt 0 0.0) 1.0)
+    (test/approx (expt 0.0 0.0) 1.0)
+    (test/unspec-or-exn (expt 0 -5) &implementation-restriction)
+    (test/unspec-or-exn (expt 0 -5+.0000312i) &implementation-restriction)
+    (test (expt 0 0)                   1)
+    (test (expt 0.0 0.0)               1.0)
+    
+    
+    (test/approx (make-rectangular 1.1 0.0) 1.1+0.0i)
+    (test/approx (make-rectangular 1.1 2.2) 1.1+2.2i)
+    (test/approx (make-polar 1.1 0.0) 1.1+0.0i)
+    (test/approx (make-polar 1.1 2.2) 1.1@2.2)
+
+    (test/approx (real-part 1.1+2.2i)              1.1)
+    (test/approx (imag-part 1.1+2.2i)              2.2)
+    (test/approx (magnitude 1.1@2.2)              1.1)
+
+    (test (exact? (imag-part 0.0)) #t)
+    (test (exact? (imag-part 1.0)) #t)
+    (test (exact? (imag-part 1.1)) #t)
+    (test (exact? (imag-part +nan.0)) #t)
+    (test (exact? (imag-part +inf.0)) #t)
+    (test (exact? (imag-part -inf.0)) #t)
+
+    (test (zero? (imag-part 0.0)) #t)
+    (test (zero? (imag-part 1.0)) #t)
+    (test (zero? (imag-part 1.1)) #t)
+    (test (zero? (imag-part +nan.0)) #t)
+    (test (zero? (imag-part +inf.0)) #t)
+    (test (zero? (imag-part -inf.0)) #t) 
+
+    (test/approx (angle 1.1@2.2)                  2.2)
+
+    (test/approx (angle -1.0)         3.141592653589793)
+    (test/approx (angle -1.0+0.0i)    3.141592653589793)
+    (unless (eqv? 0.0 -0.0)
+      (test/approx (angle -1.0-0.0i)    -3.141592653589793))
+    (test (angle +inf.0)       0.0)
+    (test/approx (angle -inf.0)       3.141592653589793)
+
+    (test (magnitude (make-rectangular +inf.0 1)) +inf.0)
+    (test (magnitude (make-rectangular -inf.0 1)) +inf.0)
+    (test (magnitude (make-rectangular 1 +inf.0)) +inf.0)
+    (test (magnitude (make-rectangular 1 -inf.0)) +inf.0)
+
+    (test/approx (angle -1)   3.141592653589793)
+
+    (for-each 
+     (lambda (n)
+       (test (string->number (number->string n)) n)
+       (test (string->number (number->string (inexact n) 10 5)) (inexact n))
+       (when (exact? n)
+         (test (string->number (number->string n 16) 16) n)
+         (test (string->number (string-append "#x" (number->string n 16))) n)
+         (test (string->number (number->string n 8) 8) n)
+         (test (string->number (string-append "#o" (number->string n 8))) n)
+         (test (string->number (number->string n 2) 2) n)
+         (test (string->number (string-append "#b" (number->string n 2))) n)
+         (test (string->number (number->string n 10) 10) n)
+         (test (string->number (string-append "#d" (number->string n 10))) n)))
+     '(1 15 1023 -5 2.0 1/2 2e200 1+2i))
+    (test (string->number "nope") #f)
+
+    (test (string->number "100")                  100)
+    (test (string->number "100" 16)               256)
+    (test (string->number "1e2")                  100.0)
+    (test (string->number "0/0")                  #f)
+    (test (string->number "+inf.0")               +inf.0)
+    (test (string->number "-inf.0")               -inf.0)
+    (test (string->number "+nan.0")               +nan.0)
+
+    ;; Originally from Ikarus:
+    (test-string-to-number
+     ("10" 10)
+     ("1" 1)
+     ("-17" -17)
+     ("+13476238746782364786237846872346782364876238477" 
+      13476238746782364786237846872346782364876238477)
+     ("1/2" (/ 1 2))
+     ("-1/2" (/ 1 -2))
+     ("#x24" 36)
+     ("#x-24" -36)
+     ("#b+00000110110" 54)
+     ("#b-00000110110/10" -27)
+     ("#e10" 10)
+     ("#e1" 1)
+     ("#e-17" -17)
+     ("#e#x24" 36)
+     ("#e#x-24" -36)
+     ("#e#b+00000110110" 54)
+     ("#e#b-00000110110/10" -27)
+     ("#x#e24" 36)
+     ("#x#e-24" -36)
+     ("#b#e+00000110110" 54)
+     ("#b#e-00000110110/10" -27)
+     ("#e1e1000" (expt 10 1000))
+     ("#e-1e1000" (- (expt 10 1000)))
+     ("#e1e-1000" (expt 10 -1000))
+     ("#e-1e-1000" (- (expt 10 -1000))))
+
+    (test/approx-string-to-number
+     ("#i1e100" (inexact (expt 10 100)))
+     ("#i1e1000" (inexact (expt 10 1000)))
+     ("#i-1e1000" (inexact (- (expt 10 1000))))
+     ("1e100" (inexact (expt 10 100)))
+     ("1.0e100" (inexact (expt 10 100)))
+     ("1.e100" (inexact (expt 10 100)))
+     ("0.1e100" (inexact (expt 10 99)))
+     (".1e100" (inexact (expt 10 99)))
+     ("+1e100" (inexact (expt 10 100)))
+     ("+1.0e100" (inexact (expt 10 100)))
+     ("+1.e100" (inexact (expt 10 100)))
+     ("+0.1e100" (inexact (expt 10 99)))
+     ("+.1e100" (inexact (expt 10 99)))
+     ("-1e100" (inexact (- (expt 10 100))))
+     ("-1.0e100" (inexact (- (expt 10 100))))
+     ("-1.e100" (inexact (- (expt 10 100))))
+     ("-0.1e100" (inexact (- (expt 10 99))))
+     ("-.1e100" (inexact (- (expt 10 99)))))
+
+    ;; 11.8
+    (test (not #t)    #f)
+    (test (not 3)           #f)
+    (test (not (list 3))    #f)
+    (test (not #f)   #t)
+    (test (not '())         #f)
+    (test (not (list))      #f)
+    (test (not 'nil)        #f)
+    
+    (test (boolean? #f)   #t)
+    (test (boolean? 0)           #f)
+    (test (boolean? '())         #f)
+
+    (test (boolean=? #f #f) #t)
+    (test (boolean=? #t #t) #t)
+    (test (boolean=? #t #f) #f)
+    (test (boolean=? #f #t) #f)
+    (test (boolean=? #t #t #f) #f)
+    (test (boolean=? #t #t #t #t) #t)
+
+    ;; 11.9
+    (test (pair? '(a . b))         #t)
+    (test (pair? '(a b c))         #t)
+    (test (pair? '())              #f)
+    (test (pair? '#(a b))          #f)
+
+    (test (cons 'a '())            '(a))
+    (test (cons '(a) '(b c d))     '((a) b c d))
+    (test (cons "a" '(b c))        '("a" b c))
+    (test (cons 'a 3)              '(a . 3))
+    (test (cons '(a b) 'c)         '((a b) . c))
+
+    (test (car '(a b c))           'a)
+    (test (car '((a) b c d))       '(a))
+    (test (car '(1 . 2))           1)
+    (test/exn (car '()) &assertion)
+    
+    (test (cdr '((a) b c d))       '(b c d))
+    (test (cdr '(1 . 2))           2)
+    (test/exn (cdr '()) &assertion)
+
+    (test (cadr '(1 2)) 2)
+    (test (cddr '(1 2)) '())
+    (test (cdar '((1) 2)) '())
+    (test (caar '((1) 2)) 1)
+
+    (test (cadar '((1 2))) 2)
+    (test (cddar '((1 2))) '())
+    (test (cdaar '(((1) 2))) '())
+    (test (caaar '(((1) 2))) 1)
+    (test (caddr '(0 1 2)) 2)
+    (test (cdddr '(0 1 2)) '())
+    (test (cdadr '(0 (1) 2)) '())
+    (test (caadr '(0 (1) 2)) 1)
+
+    (test (cadaar '(((1 2)))) 2)
+    (test (cddaar '(((1 2)))) '())
+    (test (cdaaar '((((1) 2)))) '())
+    (test (caaaar '((((1) 2)))) 1)
+    (test (caddar '((0 1 2))) 2)
+    (test (cdddar '((0 1 2))) '())
+    (test (cdadar '((0 (1) 2))) '())
+    (test (caadar '((0 (1) 2))) 1)
+    (test (cadadr '(- (1 2))) 2)
+    (test (cddadr '(- (1 2))) '())
+    (test (cdaadr '(- ((1) 2))) '())
+    (test (caaadr '(- ((1) 2))) 1)
+    (test (cadddr '(- 0 1 2)) 2)
+    (test (cddddr '(- 0 1 2)) '())
+    (test (cdaddr '(- 0 (1) 2)) '())
+    (test (caaddr '(- 0 (1) 2)) 1)
+
+    (test (null? '())           #t)
+    (test (null? '(1))          #f)
+    (test (null? #f)            #f)
+
+    (test (list? '(a b c))      #t)
+    (test (list? '())           #t)
+    (test (list? '(a . b))      #f)
+    
+    (test (list 'a (+ 3 4) 'c)             '(a 7 c))
+    (test (list)                           '())
+
+    (test (length '(a b c))                3)
+    (test (length '(a (b) (c d e)))        3)
+    (test (length '())                     0)
+
+    (test (append '(x) '(y))               '(x y))
+    (test (append '(a) '(b c d))           '(a b c d))
+    (test (append '(a (b)) '((c)))         '(a (b) (c)))
+    (test (append '(a b) '(c . d))         '(a b c . d))
+    (test (append '() 'a)                  'a)
+
+    (test (reverse '(a b c))               '(c b a))
+    (test (reverse '(a (b c) d (e (f))))   '((e (f)) d (b c) a))
+
+    (test (list-tail '(a b c d) 2)                  '(c d))
+    (test (list-tail '(a b . c) 2)                  'c)
+
+    (test (list-ref '(a b c d) 2)                 'c)
+    (test (list-ref '(a b c . d) 2)                 'c)
+
+    (test (map cadr '((a b) (d e) (g h)))    '(b e h))
+
+    (test (map (lambda (n) (expt n n))
+               '(1 2 3 4 5))
+          '(1 4 27 256 3125))
+
+    (test (map + '(1 2 3) '(4 5 6))          '(5 7 9))
+
+    (test (one-two-or-two-one?
+           (let ((count 0))
+             (map (lambda (ignored)
+                    (set! count (+ count 1))
+                    count)
+                  '(a b))))
+          #t)
+
+    (test (let ((v (make-vector 5)))
+            (for-each (lambda (i)
+                        (vector-set! v i (* i i)))
+                      '(0 1 2 3 4))
+            v) 
+          '#(0 1 4 9 16))
+
+    (test/unspec (for-each (lambda (x) x) '(1 2 3 4)))
+
+    (test/unspec (for-each even? '()))
+
+    ;; 11.10
+    (test (symbol? 'foo)           #t)
+    (test (symbol? (car '(a b)))   #t)
+    (test (symbol? "bar")          #f)
+    (test (symbol? 'nil)           #t)
+    (test (symbol? '())            #f)
+    (test (symbol? #f)      #f)
+
+    (test (symbol=? 'a 'a)         #t)
+    (test (symbol=? 'a 'A)         #f)
+    (test (symbol=? 'a 'b)         #f)
+    (test (symbol=? 'a 'a 'b)      #f)
+    (test (symbol=? 'a 'a 'a 'a)   #t)
+    
+    (test (symbol->string 'flying-fish)     
+          "flying-fish")
+    (test (symbol->string 'Martin)           "Martin")
+    (test (symbol->string
+           (string->symbol "Malvina"))     
+          "Malvina")
+
+    (test (eq? 'mISSISSIppi 'mississippi)   #f)
+    (test (string->symbol "mISSISSIppi")
+          'mISSISSIppi)
+    (test (eq? 'bitBlt (string->symbol "bitBlt"))      #t)
+    (test (eq? 'JollyWog
+               (string->symbol
+                (symbol->string 'JollyWog)))   #t)
+    (test (string=? "K. Harper, M.D."
+                    (symbol->string
+                     (string->symbol "K. Harper, M.D.")))   
+          #t)
+
+    ;; 11.11
+    (test (char? #\a) #t)
+    (test (char? 'a) #f)
+    (test (char? 65) #f)
+    
+    (test (integer->char 32) #\space)
+    (test (integer->char #xDF) #\xDF)
+    (test (integer->char #x10AAAA) #\x10AAAA)
+    (test (char->integer (integer->char 5000))
+          5000)
+    (test/exn (integer->char #xD800) &assertion)
+    (test (char=? #\z #\xDF) #f)
+    (test (char=? #\z #\z) #t)
+    (test (char<? #\z #\z) #f)
+    (test (char<? #\z #\xDF) #t)
+    (test (char<? #\xDF #\z) #f)
+    (test (char<? #\z #\Z) #f)
+    (test (char<=? #\z #\z) #t)
+    (test (char<=? #\z #\xDF) #t)
+    (test (char<=? #\xDF #\z) #f)
+    (test (char<=? #\z #\Z) #f)
+    (test (char>? #\z #\z) #f)
+    (test (char>? #\z #\xDF) #f)
+    (test (char>? #\xDF #\z) #t)
+    (test (char>? #\z #\Z) #t)
+    (test (char>=? #\z #\z) #t)
+    (test (char>=? #\z #\xDF) #f)
+    (test (char>=? #\xDF #\z) #t)
+    (test (char>=? #\z #\Z) #t)
+
+    ;; 11.12
+    (test (string? "apple") #t)
+    (test (string? #vu8(1 2)) #f)
+    (test (string? #\a) #f)
+    (test (string? 77) #f)
+
+    (test (string-length (make-string 10)) 10)
+    (test (string-length (make-string 10 #\a)) 10)
+    (test (string-ref (make-string 10 #\a) 0) #\a)
+    (test (string-ref (make-string 10 #\a) 5) #\a)
+    (test (string-ref (make-string 10 #\a) 9) #\a)
+
+    (test (string=? "Strasse" "Strasse") #t)
+    (test (string=? "Stra\xDF;e" "Strasse") #f)
+    (test (string=? "Strasse" "Strasse" "Stra\xDF;e") #f)
+    (test (string=? "Strasse" "Stra\xDF;e" "Strasse") #f)
+    (test (string=? "Stra\xDF;e" "Strasse" "Strasse") #f)
+    (test (string=? "Strasse" "Strasse" "Strasse") #t)
+
+    (test (string<? "z" "z") #f)
+    (test (string<? "z" "\xDF;") #t)
+    (test (string<? "\xDF;" "z") #f)
+    (test (string<? "z" "zz") #t)
+    (test (string<? "z" "Z") #f)
+    (test (string<=? "z" "\xDF;") #t)
+    (test (string<=? "\xDF;" "z") #f)
+    (test (string<=? "z" "zz") #t)
+    (test (string<=? "z" "Z") #f)
+    (test (string<=? "z" "z") #t)
+
+    (test (string<? "z" "z") #f)
+    (test (string>? "z" "\xDF;") #f)
+    (test (string>? "\xDF;" "z") #t)
+    (test (string>? "z" "zz") #f)
+    (test (string>? "z" "Z") #t)
+    (test (string>=? "z" "\xDF;") #f)
+    (test (string>=? "\xDF;" "z") #t)
+    (test (string>=? "z" "zz") #f)
+    (test (string>=? "z" "Z") #t)
+    (test (string>=? "z" "z") #t)
+
+    (test (substring "apple" 0 3) "app")
+    (test (substring "apple" 1 3) "pp")
+    (test (substring "apple" 3 5) "le")
+
+    (test (string-append "apple") "apple")
+    (test (string-append "apple" "banana") "applebanana")
+    (test (string-append "apple" "banana" "cherry") "applebananacherry")
+
+    (test (string->list "apple") (list #\a #\p #\p #\l #\e))
+    (test (list->string (list #\a #\p #\p #\l #\e)) "apple")
+
+    (let ([accum '()])
+      (test/unspec (string-for-each (lambda (a) (set! accum (cons a accum)))
+                                    "elppa"))
+      (test accum '(#\a #\p #\p #\l #\e))
+      (test/unspec (string-for-each (lambda (a b) (set! accum (cons (list a b) accum)))
+                                    "elppa"
+                                    "ananb"))
+      (test accum '((#\a #\b) (#\p #\n) (#\p #\a) (#\l #\n) (#\e #\a)
+                    #\a #\p #\p #\l #\e))
+      (test/unspec (string-for-each (lambda (a b c) (set! accum c))
+                                    "elppa"
+                                    "ananb"
+                                    "chery"))
+      (test accum #\y))
+
+    (test "apple" (string-copy "apple"))
+    (let ([s "apple"])
+      (test (eq? s (string-copy s)) #f))
+
+    ;; 11.13
+    (test (vector? '#(1 2 3)) #t)
+    (test (vector? "apple") #f)
+
+    (test (vector-length (make-vector 10)) 10)
+    (test (vector-length (make-vector 10 'x)) 10)
+    (test (vector-ref (make-vector 10 'x) 0) 'x)
+    (test (vector-ref (make-vector 10 'x) 5) 'x)
+    (test (vector-ref (make-vector 10 'x) 9) 'x)
+
+    (test '#(0 (2 2 2 2) "Anna")  (vector 0 '(2 2 2 2) "Anna"))
+    (test (vector 'a 'b 'c)       '#(a b c))
+    (test (vector-ref '#(1 1 2 3 5 8 13 21) 5)   8)
+
+    (test (let ((vec (vector 0 '(2 2 2 2) "Anna")))
+            (vector-set! vec 1 '("Sue" "Sue"))
+            vec)
+          '#(0 ("Sue" "Sue") "Anna"))
+
+    (test/unspec-or-exn (vector-set! '#(0 1 2) 1 "doe") &assertion)
+
+    (test (vector->list '#(dah dah didah))  '(dah dah didah))
+    (test (list->vector '(dididit dah))     '#(dididit dah))
+
+    (let ([vec (vector 'x 'y 'z)])
+      (vector-fill! vec 10.1)
+      (test vec '#(10.1 10.1 10.1)))
+
+    (test (vector-map (lambda (x) (+ 1 x)) 
+                      '#(1 2 3))
+          '#(2 3 4))
+    (test (vector-map (lambda (x y) (- x y)) 
+                      '#(3 4 5) 
+                      '#(0 -1 2))
+          '#(3 5 3))
+    (test (vector-map (lambda (x y f) (f (- x y)))
+                      '#(3 4 5) 
+                      '#(0 -1 2)
+                      (vector - * /))
+          '#(-3 5 1/3))
+
+    (let ([accum '()])
+      (test/unspec (vector-for-each (lambda (a) (set! accum (cons a accum)))
+                                    '#(e l p p a)))
+      (test accum '(a p p l e))
+      (test/unspec (vector-for-each (lambda (a b) (set! accum (cons (list a b) accum)))
+                                    '#(e l p p a)
+                                    '#(a n a n b)))
+      (test accum '((a b) (p n) (p a) (l n) (e a)
+                    a p p l e))
+      (test/unspec (vector-for-each (lambda (a b c) (set! accum c))
+                                    '#(e l p p a)
+                                    '#(a n a n b)
+                                    '#(c h e r y)))
+      (test accum 'y))
+
+    ;; 11.14
+    (for-each
+     (lambda (error)
+       (test/exn (error 'apple "bad" 'worm) &who)
+       (test/exn (error #f "bad" 'worm) &message)
+       (test/exn (error 'apple "bad" 'worm) &irritants)
+       (test/exn (error 'apple "bad") &irritants))
+     (list error assertion-violation))
+    (test/exn (error 'apple "bad" 'worm) &error)
+    (test/exn (assertion-violation 'apple "bad" 'worm) &assertion)
+    
+    (test (condition-message
+           (guard (v [#t v])
+                  (assertion-violation 'apple "bad" 'worm)))
+          "bad")
+    (test (condition-who
+           (guard (v [#t v])
+                  (assertion-violation 'apple "bad" 'worm)))
+          'apple)
+    (test (condition-irritants
+           (guard (v [#t v])
+                  (assertion-violation 'apple "bad" 'worm)))
+          '(worm))
+    (test (who-condition?
+           (guard (v [#t v])
+                  (assertion-violation #f "bad" 'worm)))
+          #f)
+    (test (error?
+           (guard (v [#t v])
+                  (assertion-violation #f "bad" 'worm)))
+          #f)
+    (test (error?
+           (guard (v [#t v])
+                  (error #f "bad" 'worm)))
+          #t)
+
+    (test (fac 5) 120)
+    (test/exn (fac 4.5) &assertion)
+    (test/exn (fac -3) &assertion)
+    (test/exn (fac -3) &message)
+
+    ;; 11.15
+    (test (apply + (list 3 4))               7)
+    (test/approx ((compose sqrt *) 12 75)    30)
+    
+    (test (call-with-current-continuation
+           (lambda (exit)
+             (for-each (lambda (x)
+                         (if (negative? x)
+                             (exit x)))
+                       '(54 0 37 -3 245 19))
+             #t))
+          -3)
+    (test (call/cc
+           (lambda (exit)
+             (for-each (lambda (x)
+                         (if (negative? x)
+                             (exit x)))
+                       '(54 0 37 -3 245 19))
+             #t))
+          -3)
+
+    (test (list-length '(1 2 3 4))             4)
+
+    (test (list-length '(a b . c))             #f)
+
+    (test/values (values))
+    (test (values 1) 1)
+    (test/values (values 1 2 3) 1 2 3)
+
+    (test (call-with-current-continuation procedure?) #t)
+
+    (test (call-with-values (lambda () (values 4 5))
+            (lambda (a b) b))
+          5)
+
+    (test (call-with-values * -) -1)
+
+    (test (let ((path '())
+                (c #f))
+            (let ((add (lambda (s)
+                         (set! path (cons s path)))))
+              (dynamic-wind
+                  (lambda () (add 'connect))
+                  (lambda ()
+                    (add (call-with-current-continuation
+                          (lambda (c0)
+                            (set! c c0)
+                            'talk1))))
+                  (lambda () (add 'disconnect)))
+              (if (< (length path) 4)
+                  (c 'talk2)
+                  (reverse path))))
+          '(connect talk1 disconnect
+                    connect talk2 disconnect))
+    
+    (test (let ((n 0))
+            (call-with-current-continuation
+             (lambda (k)
+               (dynamic-wind
+                   (lambda ()
+                     (set! n (+ n 1))
+                     (k))
+                   (lambda ()
+                     (set! n (+ n 2)))
+                   (lambda ()
+                     (set! n (+ n 4))))))
+            n) 
+          1)
+
+    (test (let ((n 0))
+            (call-with-current-continuation
+             (lambda (k)
+               (dynamic-wind
+                   values
+                   (lambda ()
+                     (dynamic-wind
+                         values
+                         (lambda ()
+                           (set! n (+ n 1))
+                           (k))
+                         (lambda ()
+                           (set! n (+ n 2))
+                           (k))))
+                   (lambda ()
+                     (set! n (+ n 4))))))
+            n) 
+          7)
+
+    ;; 11.16
+    (test (let loop ((numbers '(3 -2 1 6 -5))
+                     (nonneg '())
+                     (neg '()))
+            (cond ((null? numbers) (list nonneg neg))
+                  ((>= (car numbers) 0)
+                   (loop (cdr numbers)
+                         (cons (car numbers) nonneg)
+                         neg))
+                  ((< (car numbers) 0)
+                   (loop (cdr numbers)
+                         nonneg
+                         (cons (car numbers) neg)))))
+          '((6 1 3) (-5 -2)))
+
+    ;; 11.17
+    (test `(list ,(+ 1 2) 4)  '(list 3 4))
+    (test (let ((name 'a)) `(list ,name ',name)) 
+          '(list a (quote a)))
+    (test `(a ,(+ 1 2) ,@(map abs '(4 -5 6)) b)
+          '(a 3 4 5 6 b))
+
+    (test `((foo ,(- 10 3)) ,@(cdr '(c)) . ,(car '(cons)))
+          '((foo 7) . cons))
+    (test `#(10 5 ,(- 4) ,@(map - '(16 9)) 8)
+          '#(10 5 -4 -16 -9 8))
+    (test (let ((name 'foo))
+            `((unquote name name name)))
+          '(foo foo foo))
+    (test (let ((name '(foo)))
+            `((unquote-splicing name name name)))
+          '(foo foo foo))
+    (test (let ((q '((append x y) (sqrt 9))))
+            ``(foo ,,@q)) 
+          '`(foo (unquote (append x y) (sqrt 9))))
+    (test (let ((x '(2 3))
+                (y '(4 5)))
+            `(foo (unquote (append x y) (- 9))))
+          '(foo (2 3 4 5) -9))
+
+    (test `(a `(b ,(+ 1 2) ,(foo ,(+ 1 3) d) e) f) 
+          '(a `(b ,(+ 1 2) ,(foo 4 d) e) f))
+    (test (let ((name1 'x)
+                (name2 'y))
+            `(a `(b ,,name1 ,',name2 d) e))
+          '(a `(b ,x ,'y d) e))
+
+    (test (let ((a 3)) `((1 2) ,a ,4 ,'five 6))
+          '((1 2) 3 4 five 6))
+    (test (let ((a 3)) `((1 2) ,a ,4 ,'five 6))
+          (let ((a 3)) 
+            (cons '(1 2)
+                  (cons a (cons 4 (cons 'five '(6)))))))
+    
+    ;; 11.18
+    (test (let-syntax ((when (syntax-rules ()
+                               ((when test stmt1 stmt2 ...)
+                                (if test
+                                    (begin stmt1
+                                           stmt2 ...))))))
+            (let ((if #t))
+              (when if (set! if 'now))
+              if))
+          'now)
+
+    (test (let ((x 'outer))
+            (let-syntax ((m (syntax-rules () ((m) x))))
+              (let ((x 'inner))
+                (m))))
+          'outer)
+
+    (test (let ()
+            (let-syntax ((def (syntax-rules ()
+                                ((def stuff ...) (define stuff ...)))))
+              (def foo 42))
+            foo)
+          42)
+
+    (test (let ()
+            (let-syntax ())
+            5) 
+          5)
+
+    (test (letrec-syntax
+              ((my-or (syntax-rules ()
+                        ((my-or) #f)
+                        ((my-or e) e)
+                        ((my-or e1 e2 ...)
+                         (let ((temp e1))
+                           (if temp
+                               temp
+                               (my-or e2 ...)))))))
+            (let ((x #f)
+                  (y 7)
+                  (temp 8)
+                  (let odd?)
+                  (if even?))
+              (my-or x
+                     (let temp)
+                     (if y)
+                     y)))
+          7)
+
+    (test (let ((f (lambda (x) (+ x 1))))
+            (let-syntax ((f (syntax-rules ()
+                              ((f x) x)))
+                         (g (syntax-rules ()
+                              ((g x) (f x)))))
+              (list (f 1) (g 1)))) 
+          '(1 2))
+    
+    (test (let ((f (lambda (x) (+ x 1))))
+            (letrec-syntax ((f (syntax-rules ()
+                                 ((f x) x)))
+                            (g (syntax-rules ()
+                                 ((g x) (f x)))))
+              (list (f 1) (g 1)))) 
+          '(1 1))
+
+    (test (sequence 1 2 3 4) 4)
+
+    (test (let ((=> #f))
+            (cond (#t => 'ok)))
+          'ok)
+    
+    (test p.car 4)
+    ; (test/exn (set! p.car 15) &syntax) - not a runtime test
+
+    (test/unspec (set! p2.car 15))
+    (test p2.car 15)
+    (test p '(15 . 5))
+
+    (test (kons 1 2) '(1 . 2))
+
+    ;;;
+    ))
addfile ./test/r6rs/bytevectors.sls
hunk ./test/r6rs/bytevectors.sls 1
+#!r6rs
+
+(library (tests r6rs bytevectors)
+  (export run-bytevectors-tests)
+  (import (rnrs)
+          (tests r6rs test))
+
+  (define (run-bytevectors-tests)
+    
+    ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+    ;; Tests originally from R6RS, plus added
+
+    (test (endianness little) 'little)
+    (test (endianness big) 'big)
+    (test (symbol? (native-endianness)) #t)
+
+    (test (bytevector? #vu8(1 2 3)) #t)
+    (test (bytevector? "123") #f)
+
+    (test (bytevector-length #vu8(1 2 3)) 3)
+    (test (bytevector-length (make-bytevector 10)) 10)
+    (test (bytevector-length (make-bytevector 10 3)) 10)
+    (test (bytevector-u8-ref (make-bytevector 10 3) 0) 3)
+    (test (bytevector-u8-ref (make-bytevector 10 3) 5) 3)
+    (test (bytevector-u8-ref (make-bytevector 10 3) 9) 3)
+    (test (bytevector-u8-ref (make-bytevector 10 255) 9) 255)
+    (test (bytevector-u8-ref (make-bytevector 10 -1) 9) 255)
+    (test (bytevector-u8-ref (make-bytevector 10 -128) 9) 128)
+
+    (let ([v (make-bytevector 5 2)])
+      (test/unspec (bytevector-fill! v -1))
+      (test v #vu8(255 255 255 255 255))
+      (test/unspec (bytevector-fill! v 17))
+      (test v #vu8(17 17 17 17 17))
+      (test/unspec (bytevector-fill! v 255))
+      (test v #vu8(255 255 255 255 255)))
+    
+    (test (let ((b (u8-list->bytevector '(1 2 3 4 5 6 7 8))))
+            (bytevector-copy! b 0 b 3 4)
+            (bytevector->u8-list b)) 
+          '(1 2 3 1 2 3 4 8))
+
+    (test (bytevector-copy #vu8(1 2 3)) #vu8(1 2 3))
+
+    (test (let ((b1 (make-bytevector 16 -127))
+                (b2 (make-bytevector 16 255)))
+            (list
+             (bytevector-s8-ref b1 0)
+             (bytevector-u8-ref b1 0)
+             (bytevector-s8-ref b2 0)
+             (bytevector-u8-ref b2 0)))
+          '(-127 129 -1 255))
+
+    (test (let ((b (make-bytevector 16 -127)))
+            
+            (bytevector-s8-set! b 0 -126)
+            (bytevector-u8-set! b 1 246)
+            
+            (list
+             (bytevector-s8-ref b 0)
+             (bytevector-u8-ref b 0)
+             (bytevector-s8-ref b 1)
+             (bytevector-u8-ref b 1)))
+          '(-126 130 -10 246))
+
+    (test (bytevector->u8-list #vu8(1 2 3)) '(1 2 3))
+    (test (bytevector->u8-list #vu8(255 255 255)) '(255 255 255))
+    (test (u8-list->bytevector '(1 2 3)) #vu8(1 2 3))
+    (test (u8-list->bytevector '()) #vu8())
+
+    (let ([b (make-bytevector 16 -127)])
+      (test/unspec
+       (bytevector-uint-set! b 0 (- (expt 2 128) 3)
+                             (endianness little) 16))
+       
+      (test (bytevector-uint-ref b 0 (endianness little) 16)
+            #xfffffffffffffffffffffffffffffffd)
+
+      (test (bytevector-sint-ref b 0 (endianness little) 16)
+            -3)
+
+      (test (bytevector->u8-list b)
+            '(253 255 255 255 255 255 255 255
+                  255 255 255 255 255 255 255 255))
+
+      (test/unspec (bytevector-uint-set! b 0 (- (expt 2 128) 3)
+                                         (endianness big) 16))
+      (test (bytevector-uint-ref b 0 (endianness big) 16)
+            #xfffffffffffffffffffffffffffffffd)
+
+      (test (bytevector-sint-ref b 0 (endianness big) 16) -3)
+
+      (test (bytevector->u8-list b) 
+            '(255 255 255 255 255 255 255 255
+                  255 255 255 255 255 255 255 253))
+
+      (test
+       (let ((b (u8-list->bytevector '(1 2 3 255 1 2 1 2))))
+         (bytevector->sint-list b (endianness little) 2)) 
+       '(513 -253 513 513))
+
+      (test (let ((b (u8-list->bytevector '(1 2 3 255 1 2 1 2))))
+              (bytevector->uint-list b (endianness little) 2)) 
+            '(513 65283 513 513)))
+
+    (let ([b (u8-list->bytevector
+              '(255 255 255 255 255 255 255 255
+                    255 255 255 255 255 255 255 253))])
+      
+      (test (bytevector-u16-ref b 14 (endianness little)) 65023)
+      (test (bytevector-s16-ref b 14 (endianness little)) -513)
+      (test (bytevector-u16-ref b 14 (endianness big)) 65533)
+      (test (bytevector-s16-ref b 14 (endianness big)) -3)
+
+      (test/unspec (bytevector-u16-set! b 0 12345 (endianness little)))
+      (test (bytevector-u16-ref b 0 (endianness little)) 12345)
+      
+      (test/unspec (bytevector-u16-native-set! b 0 12345))
+      (test (bytevector-u16-native-ref b 0) 12345)
+
+      (test/unspec (bytevector-u16-ref b 0 (endianness little))))
+
+    (let ([b (u8-list->bytevector
+              '(255 255 255 255 255 255 255 255
+                    255 255 255 255 255 255 255 253))])
+
+      (test (bytevector-u32-ref b 12 (endianness little)) 4261412863)
+      (test (bytevector-s32-ref b 12 (endianness little)) -33554433)
+      (test (bytevector-u32-ref b 12 (endianness big)) 4294967293)
+      (test (bytevector-s32-ref b 12 (endianness big)) -3))
+
+    (let ([b (u8-list->bytevector
+              '(255 255 255 255 255 255 255 255
+                    255 255 255 255 255 255 255 253))])
+      (test (bytevector-u64-ref b 8 (endianness little)) 18302628885633695743)
+      (test (bytevector-s64-ref b 8 (endianness little)) -144115188075855873)
+      (test (bytevector-u64-ref b 8 (endianness big)) 18446744073709551613)
+      (test (bytevector-s64-ref b 8 (endianness big)) -3))
+      
+    (for-each
+     (lambda (k)
+       (for-each
+        (lambda (n)
+          (if (zero? (fxand k 3))
+              (let ([b (make-bytevector 12)])
+                (test/unspec (bytevector-ieee-single-native-set! b k n))
+                (test/approx (bytevector-ieee-single-native-ref b k) n))
+              (let ([b (make-bytevector 12)])
+                (test/exn (bytevector-ieee-single-native-set! b k n) &assertion)
+                (test/exn (bytevector-ieee-single-native-ref b k) &assertion)))
+          (let ([b (make-bytevector 12)])
+            (test/unspec (bytevector-ieee-single-set! b k n 'big))
+            (test/approx (bytevector-ieee-single-ref b k 'big) n))
+          (let ([b (make-bytevector 12)])
+            (test/unspec (bytevector-ieee-single-set! b k n 'little))
+            (test/approx (bytevector-ieee-single-ref b k 'little) n))
+          (if (zero? (fxand k 7))
+              (let ([b (make-bytevector 12)])
+                (test/unspec (bytevector-ieee-double-native-set! b k n))
+                (test/approx (bytevector-ieee-double-native-ref b k) n))
+              (let ([b (make-bytevector 12)])
+                (test/exn (bytevector-ieee-double-native-set! b k n) &assertion)
+                (test/exn (bytevector-ieee-double-native-ref b k) &assertion)))
+          (let ([b (make-bytevector 12)])
+            (test/unspec (bytevector-ieee-double-set! b k n 'big))
+            (test/approx (bytevector-ieee-double-ref b k 'big) n))
+          (let ([b (make-bytevector 12)])
+            (test/unspec (bytevector-ieee-double-set! b k n 'little))
+            (test/approx (bytevector-ieee-double-ref b k 'little) n)))
+        '(1.0 25.78 +inf.0 -inf.0 +nan.0)))
+     '(0 1 2 3 4))
+
+    (test (string->utf8 "apple") #vu8(97 112 112 108 101))
+    (test (string->utf8 "app\x3BB;e") #vu8(97 112 112 206 187 101))
+    (test (string->utf16 "app\x3BB;e" 'little) #vu8(97 0 112 0 112 0 #xBB #x3 101 0))
+    (test (string->utf16 "app\x3BB;e" 'big) #vu8(0 97 0 112 0 112 #x3 #xBB 0 101))
+    (test (string->utf16 "app\x3BB;e") #vu8(0 97 0 112 0 112 #x3 #xBB 0 101))
+    (test (string->utf32 "app\x3BB;e" 'little) #vu8(97 0 0 0 112 0 0 0 112 0 0 0 #xBB #x3 0 0 101 0 0 0))
+    (test (string->utf32 "app\x3BB;e" 'big) #vu8(0 0 0 97 0 0 0 112 0 0 0 112 0 0 #x3 #xBB 0 0 0 101))
+    (test (string->utf32 "app\x3BB;e") #vu8(0 0 0 97 0 0 0 112 0 0 0 112 0 0 #x3 #xBB 0 0 0 101))
+
+    (let ([bv-append
+           (lambda (bv1 bv2)
+             (let ([bv (make-bytevector (+ (bytevector-length bv1)
+                                           (bytevector-length bv2)))])
+               (bytevector-copy! bv1 0 bv 0  (bytevector-length bv1))
+               (bytevector-copy! bv2 0 bv (bytevector-length bv1) (bytevector-length bv2))
+               bv))])
+      (for-each
+       (lambda (str)
+         (test (utf8->string (string->utf8 str)) str)
+         (test (utf16->string (string->utf16 str 'big) 'big) str)
+         (test (utf16->string (string->utf16 str 'little) 'little) str)
+         (test (utf16->string (bv-append #vu8(#xFF #xFE) (string->utf16 str 'little)) 'big) str)
+         (test (utf16->string (bv-append #vu8(#xFE #xFF) (string->utf16 str 'big)) 'little) str)
+         (test (utf16->string (bv-append #vu8(#xFF #xFE) (string->utf16 str 'little)) 'little #t) 
+               (string-append "\xFEFF;" str))
+         (test (utf16->string (bv-append #vu8(#xFE #xFF) (string->utf16 str 'little)) 'little #t) 
+               (string-append "\xFFFE;" str))
+         (test (utf16->string (bv-append #vu8(#xFE #xFF) (string->utf16 str 'big)) 'big #t) 
+               (string-append "\xFEFF;" str))
+         (test (utf16->string (bv-append #vu8(#xFF #xFE) (string->utf16 str 'big)) 'big #t) 
+               (string-append "\xFFFE;" str))
+         (test (utf32->string (string->utf32 str 'big) 'big) str)
+         (test (utf32->string (string->utf32 str 'little) 'little) str)
+         (test (utf32->string (bv-append #vu8(#xFF #xFE 0 0) (string->utf32 str 'little)) 'big) str)
+         (test (utf32->string (bv-append #vu8(0 0 #xFE #xFF) (string->utf32 str 'big)) 'little) str)
+         (test (utf32->string (bv-append #vu8(#xFF #xFE 0 0) (string->utf32 str 'little)) 'little #t) 
+               (string-append "\xFEFF;" str))
+         (test (utf32->string (bv-append #vu8(#xFE #xFF 0 0) (string->utf32 str 'little)) 'little #t) 
+               (string-append "\xFFFE;" str))
+         (test (utf32->string (bv-append #vu8(0 0 #xFE #xFF) (string->utf32 str 'big)) 'big #t) 
+               (string-append "\xFEFF;" str))
+         (test (utf32->string (bv-append #vu8(0 0 #xFF #xFE) (string->utf32 str 'big)) 'big #t) 
+               (string-append "\xFFFE;" str)))
+       (list "apple"
+             "app\x3BB;e"
+             "\x0;\x1;\x80;\xFF;\xD7FF;\xE000;\x10FFFF;")))
+
+    ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+    ;; Tests originally from Ikarus
+
+    (test (bytevector? (make-bytevector 1)) #t)
+    (test (bytevector? (make-bytevector 1 17)) #t)
+    (test (bytevector? (make-bytevector 10 -17)) #t)
+    (test (bytevector? 'foo) #f)
+    (test (bytevector? "hey") #f)
+    (test (bytevector? '#(2837 2398 239)) #f)
+    (test (bytevector-length (make-bytevector 0)) 0)
+    (test (bytevector-length (make-bytevector 100 -30)) 100)
+    (test (let ((b (u8-list->bytevector '(1 2 3 4 5 6 7 8))))
+            (bytevector-copy! b 0 b 3 4)
+            (bytevector->u8-list b))
+          '(1 2 3 1 2 3 4 8))
+    (test (bytevector-uint-ref 
+           (u8-list->bytevector '(17))
+           0 'little 1)
+          17)
+    (test (bytevector-uint-ref 
+           (u8-list->bytevector '(17))
+           0 'big 1)
+          17)
+    (test (bytevector-uint-ref 
+           (u8-list->bytevector '(17 54))
+           0 'little 2)
+          (+ 17 (* 54 256)))
+    (test (bytevector-uint-ref 
+           (u8-list->bytevector (reverse '(17 54)))
+           0 'big 2)
+          (+ 17 (* 54 256)))
+    (test (bytevector-uint-ref 
+           (u8-list->bytevector '(17 54 98))
+           0 'little 3)
+          (+ 17 (* 54 256) (* 98 256 256)))
+    (test (bytevector-uint-ref 
+           (u8-list->bytevector (reverse '(17 54 98)))
+           0 'big 3)
+          (+ 17 (* 54 256) (* 98 256 256)))
+    (test (bytevector-uint-ref 
+           (u8-list->bytevector '(17 54 98 120))
+           0 'little 4)
+          (+ 17 (* 54 256) (* 98 256 256) (* 120 256 256 256)))
+
+    (test (bytevector-uint-ref 
+           (u8-list->bytevector
+            '(#x89 #x04 #x39 #x82 #x49 #x20 #x93 #x48 #x17
+                   #x83 #x79 #x94 #x38 #x87 #x34 #x97 #x38 #x12))
+           0 'little 18)
+          #x123897348738947983174893204982390489)
+    (test (bytevector-uint-ref 
+           (u8-list->bytevector
+            (reverse
+             '(#x89 #x04 #x39 #x82 #x49 #x20 #x93 #x48 #x17
+                    #x83 #x79 #x94 #x38 #x87 #x34 #x97 #x38 #x12)))
+           0 'big 18)
+          #x123897348738947983174893204982390489)
+    (test (let ((b (u8-list->bytevector '(1 2 3 255 1 2 1 2))))
+            (bytevector->uint-list b 'little 2))
+          '(513 65283 513 513))
+    (test (bytevector->u8-list
+           (uint-list->bytevector '(513 65283 513 513) 'little 2))
+          '(1 2 3 255 1 2 1 2))
+    (test (bytevector->u8-list
+           (uint-list->bytevector '(513 65283 513 513) 'big 2))
+          '(2 1 255 3 2 1 2 1))
+    (test (let ((b (u8-list->bytevector '(1 2 3 255 1 2 1 2))))
+            (bytevector->sint-list b 'little 2))
+          '(513 -253 513 513))
+    (test (let ((b (u8-list->bytevector '(2 1 255 3 2 1 2 1))))
+            (bytevector->sint-list b 'big 2))
+          '(513 -253 513 513))
+    (test (bytevector->u8-list
+           (sint-list->bytevector '(513 -253 513 513) 'little 2))
+          '(1 2 3 255 1 2 1 2))
+    (test (let ((b (u8-list->bytevector '(1 2 3 255 1 2 1 2))))
+            (bytevector->sint-list b 'little 2))
+          '(513 -253 513 513))
+    (test (let ((b (make-bytevector 16 -127)))
+            (bytevector-uint-set! b 0 (- (expt 2 128) 3) 'little 16)
+            (list 
+             (bytevector-uint-ref b 0 'little 16)
+             (bytevector-sint-ref b 0 'little 16)
+             (bytevector->u8-list b)))
+          '(#xfffffffffffffffffffffffffffffffd
+            -3
+            (253 255 255 255 255 255 255 255
+                 255 255 255 255 255 255 255 255)))
+    (test (let ((b (make-bytevector 16 -127)))
+            (bytevector-uint-set! b 0 (- (expt 2 128) 3) 'big 16)
+            (list 
+             (bytevector-uint-ref b 0 'big 16)
+             (bytevector-sint-ref b 0 'big 16)
+             (bytevector->u8-list b)))
+          '(#xfffffffffffffffffffffffffffffffd
+            -3
+            (255 255 255 255 255 255 255 255
+                 255 255 255 255 255 255 255 253)))
+    (test (bytevector->u8-list '#vu8(1 2 3 4))
+          '(1 2 3 4))
+    (test (let ((b (make-bytevector 4 0)))
+            (bytevector-sint-set! b 0 -1 'little 4)
+            (bytevector-uint-ref b 0 'little 4))
+          #xFFFFFFFF)
+    (test (let ((b (make-bytevector 4 0)))
+            (bytevector-sint-set! b 0 -256 'little 4)
+            (bytevector-uint-ref b 0 'little 4))
+          #xFFFFFF00)
+    (test (let ((b (make-bytevector 4 0)))
+            (bytevector-sint-set! b 0 (- (expt 256 2)) 'little 4)
+            (bytevector-uint-ref b 0 'little 4))
+          #xFFFF0000)
+    (test (let ((b (make-bytevector 8 0)))
+            (bytevector-sint-set! b 0 (- (expt 256 2)) 'little 8)
+            (bytevector-uint-ref b 0 'little 8))
+          #xFFFFFFFFFFFF0000)
+    (test (let ((b (make-bytevector 8 0)))
+            (bytevector-sint-set! b 0 (- (expt 256 4)) 'little 8)
+            (bytevector-uint-ref b 0 'little 8))
+          #xFFFFFFFF00000000)
+    (test (let ((b (make-bytevector 8 0)))
+            (bytevector-sint-set! b 0 (- (expt 256 7)) 'little 8)
+            (bytevector-uint-ref b 0 'little 8))
+          #xFF00000000000000)
+    (test (let ((b (make-bytevector 8 0)))
+            (bytevector-sint-set! b 0 (- 1 (expt 2 63)) 'little 8)
+            (bytevector-sint-ref b 0 'little 8))
+          (- 1 (expt 2 63)))
+    (test (let ((b (make-bytevector 4 38)))
+            (bytevector-sint-set! b 0 (- (expt 2 31) 1) 'little 4)
+            (bytevector-sint-ref b 0 'little 4))
+          #x7FFFFFFF)
+    (test (let ((b (make-bytevector 4 38)))
+            (bytevector-sint-set! b 0 (- (expt 2 31)) 'little 4)
+            (bytevector-sint-ref b 0 'little 4))
+          #x-80000000)
+    (test (let ((b (make-bytevector 5 38)))
+            (bytevector-sint-set! b 0 (- (expt 2 32)) 'little 5)
+            (bytevector-sint-ref b 0 'little 5))
+          #x-100000000)
+    (test (let ((b (make-bytevector 4 0)))
+            (bytevector-sint-set! b 0 -1 'big 4)
+            (bytevector-uint-ref b 0 'big 4))
+          #xFFFFFFFF)
+    (test (let ((b (make-bytevector 4 0)))
+            (bytevector-sint-set! b 0 -256 'big 4)
+            (bytevector-uint-ref b 0 'big 4))
+          #xFFFFFF00)
+    (test (let ((b (make-bytevector 4 0)))
+            (bytevector-sint-set! b 0 (- (expt 256 2)) 'big 4)
+            (bytevector-uint-ref b 0 'big 4))
+          #xFFFF0000)
+    (test (let ((b (make-bytevector 8 0)))
+            (bytevector-sint-set! b 0 (- (expt 256 2)) 'big 8)
+            (bytevector-uint-ref b 0 'big 8))
+          #xFFFFFFFFFFFF0000)
+    (test (let ((b (make-bytevector 8 0)))
+            (bytevector-sint-set! b 0 (- (expt 256 4)) 'big 8)
+            (bytevector-uint-ref b 0 'big 8))
+          #xFFFFFFFF00000000)
+    (test (let ((b (make-bytevector 8 0)))
+            (bytevector-sint-set! b 0 (- (expt 256 7)) 'big 8)
+            (bytevector-uint-ref b 0 'big 8))
+          #xFF00000000000000)
+    (test (let ((b (make-bytevector 8 0)))
+            (bytevector-sint-set! b 0 (- 1 (expt 2 63)) 'big 8)
+            (bytevector-sint-ref b 0 'big 8))
+          (- 1 (expt 2 63)))
+    (test (let ((b (make-bytevector 4 38)))
+            (bytevector-sint-set! b 0 (- (expt 2 31) 1) 'big 4)
+            (bytevector-sint-ref b 0 'big 4))
+          #x7FFFFFFF)
+    (test (let ((b (make-bytevector 4 38)))
+            (bytevector-sint-set! b 0 (- (expt 2 31)) 'big 4)
+            (bytevector-sint-ref b 0 'big 4))
+          #x-80000000)
+    (test (let ((b (make-bytevector 5 38)))
+            (bytevector-sint-set! b 0 (- (expt 2 32)) 'big 5)
+            (bytevector-sint-ref b 0 'big 5))
+          #x-100000000)
+    (test (bytevector-u16-ref '#vu8(255 253) 0 'little)
+          65023)
+    (test (bytevector-u16-ref '#vu8(255 253) 0 'big)
+          65533)
+    (test (bytevector-s16-ref '#vu8(255 253) 0 'little)
+          -513)
+    (test (bytevector-s16-ref '#vu8(255 253) 0 'big)
+          -3)
+    (test (let ((v (make-bytevector 2)))
+            (bytevector-u16-native-set! v 0 12345)
+            (bytevector-u16-native-ref v 0))
+          12345)
+    (test (let ((v (make-bytevector 2)))
+            (bytevector-u16-set! v 0 12345 'little)
+            (bytevector-u16-ref v 0 'little))
+          12345)
+    (test (let ((v (make-bytevector 2)))
+            (bytevector-u16-set! v 0 12345 'big)
+            (bytevector-u16-ref v 0 'big))
+          12345)
+
+    ;;
+    ))
addfile ./test/r6rs/conditions.sls
hunk ./test/r6rs/conditions.sls 1
+#!r6rs
+
+(library (tests r6rs conditions)
+  (export run-conditions-tests)
+  (import (rnrs)
+          (tests r6rs test))
+
+
+  (define-syntax test-cond
+    (syntax-rules ()
+      [(_ &c &parent (make arg ...) pred sel ...)
+       (begin
+         (test (pred (make arg ...)) #t)
+         (let ([v (make arg ...)])
+           (test (sel v) arg) ...
+           'ok)
+         (test ((record-predicate (record-type-descriptor &parent)) (make arg ...)) #t)
+         (test (record-type-parent (record-type-descriptor &c)) (record-type-descriptor &parent)))]))
+
+  ;; ----------------------------------------
+
+  (define-record-type (&cond1 make-cond1 real-cond1?)
+    (parent &condition)
+    (fields
+     (immutable x real-cond1-x)))
+  
+  (define cond1?
+    (condition-predicate
+     (record-type-descriptor &cond1)))
+  (define cond1-x
+    (condition-accessor
+     (record-type-descriptor &cond1)
+     real-cond1-x))
+  
+  (define foo (make-cond1 'foo))
+  
+  (define-record-type (&cond2 make-cond2 real-cond2?)
+    (parent &condition)
+    (fields
+     (immutable y real-cond2-y)))
+
+  (define cond2?
+    (condition-predicate
+     (record-type-descriptor &cond2)))
+  (define cond2-y
+    (condition-accessor
+     (record-type-descriptor &cond2)
+     real-cond2-y))
+
+  (define bar (make-cond2 'bar))
+
+  (define-condition-type &c &condition
+    make-c c?
+    (x c-x))
+
+  (define-condition-type &c1 &c
+    make-c1 c1?
+    (a c1-a))
+
+  (define-condition-type &c2 &c
+    make-c2 c2?
+    (b c2-b))
+
+  (define v1 (make-c1 "V1" "a1"))
+
+  (define v2 (make-c2 "V2" "b2"))
+
+  (define v3 (condition
+              (make-c1 "V3/1" "a3")
+              (make-c2 "V3/2" "b3")))
+
+  (define v4 (condition v1 v2))
+
+  (define v5 (condition v2 v3))
+
+  ;; ----------------------------------------
+
+  (define (run-conditions-tests)
+
+    (test (condition? foo) #t)
+    (test (cond1? foo) #t)
+    (test (cond1-x foo) 'foo)
+
+    (test (condition? (condition foo bar)) #t)
+    (test (cond1? (condition foo bar)) #t)
+    (test (cond2? (condition foo bar)) #t)
+    (test (cond1? (condition foo)) #t)
+    (test/unspec (real-cond1? (condition foo)))
+    (test (real-cond1? (condition foo bar)) #f)
+    (test (cond1-x (condition foo bar)) 'foo)
+    (test (cond2-y (condition foo bar)) 'bar)
+                
+    (test (simple-conditions (condition foo bar))
+          (list foo bar))
+
+    (test (simple-conditions
+           (condition foo (condition bar)))
+          (list foo bar))
+    
+    (test (c? v1)        #t)
+    (test (c1? v1)       #t)
+    (test (c2? v1)       #f)
+    (test (c-x v1)       "V1")
+    (test (c1-a v1)      "a1")
+
+    (test (c? v2)        #t)
+    (test (c1? v2)       #f)
+    (test (c2? v2)       #t)
+    (test (c-x v2)       "V2")
+    (test (c2-b v2)      "b2")
+
+    (test (c? v3)        #t)
+    (test (c1? v3)       #t)
+    (test (c2? v3)       #t)
+    (test (c-x v3)       "V3/1")
+    (test (c1-a v3)      "a3")
+    (test (c2-b v3)      "b3")
+
+    (test (c? v4)        #t)
+    (test (c1? v4)       #t)
+    (test (c2? v4)       #t)
+    (test (c-x v4)       "V1")
+    (test (c1-a v4)      "a1")
+    (test (c2-b v4)      "b2")
+
+    (test (c? v5)        #t)
+    (test (c1? v5)       #t)
+    (test (c2? v5)       #t)
+    (test (c-x v5)       "V2")
+    (test (c1-a v5)      "a3")
+    (test (c2-b v5)      "b2")
+
+    (test-cond &message &condition
+               (make-message-condition "message")
+               message-condition?
+               condition-message)
+    
+    (test-cond &warning &condition
+               (make-warning)
+               warning?)
+    
+    (test-cond &serious &condition
+               (make-serious-condition)
+               serious-condition?)
+
+    (test-cond &error &serious
+               (make-error)
+               error?)
+
+    (test-cond &violation &serious
+               (make-violation)
+               violation?)
+
+    (test-cond &assertion &violation
+               (make-assertion-violation)
+               assertion-violation?)
+
+    (test-cond &irritants &condition
+               (make-irritants-condition (list 'sand 'salt 'acid))
+               irritants-condition?
+               condition-irritants)
+
+    (test-cond &who &condition
+               (make-who-condition 'new-boss)
+               who-condition?
+               condition-who)
+
+    (test-cond &non-continuable &violation
+               (make-non-continuable-violation)
+               non-continuable-violation?)
+
+    (test-cond &implementation-restriction &violation
+              (make-implementation-restriction-violation)
+              implementation-restriction-violation?)
+
+    (test-cond &lexical &violation
+               (make-lexical-violation)
+               lexical-violation?)
+    
+    (test-cond &syntax &violation
+               (make-syntax-violation '(lambda (x) case) 'case)
+               syntax-violation?
+               syntax-violation-form
+               syntax-violation-subform)
+
+    (test-cond &undefined &violation
+               (make-undefined-violation)
+               undefined-violation?)
+
+    ;; These tests really belong in io/ports.ss:
+
+    (test-cond &i/o &error
+               (make-i/o-error)
+               i/o-error?)
+
+    (test-cond &i/o-read &i/o
+               (make-i/o-read-error)
+               i/o-read-error?)
+
+    (test-cond &i/o-write &i/o
+               (make-i/o-write-error)
+               i/o-write-error?)
+
+
+    (test-cond &i/o-invalid-position &i/o
+               (make-i/o-invalid-position-error 10)
+               i/o-invalid-position-error?
+               i/o-error-position)
+
+    (test-cond &i/o-filename &i/o
+               (make-i/o-filename-error "bad.txt")
+               i/o-filename-error?
+               i/o-error-filename)
+
+    (test-cond &i/o-file-protection &i/o-filename
+               (make-i/o-file-protection-error "private.txt")
+               i/o-file-protection-error?
+               i/o-error-filename)
+
+    (test-cond &i/o-file-is-read-only  &i/o-file-protection
+               (make-i/o-file-is-read-only-error "const.txt")
+               i/o-file-is-read-only-error?
+               i/o-error-filename)
+
+    (test-cond &i/o-file-already-exists &i/o-filename
+               (make-i/o-file-already-exists-error "x.txt")
+               i/o-file-already-exists-error?
+               i/o-error-filename)
+
+    (test-cond &i/o-file-does-not-exist &i/o-filename
+               (make-i/o-file-does-not-exist-error "unicorn.txt")
+               i/o-file-does-not-exist-error?
+               i/o-error-filename)
+
+    (test-cond &i/o-port &i/o
+               (make-i/o-port-error "Hong Kong")
+               i/o-port-error?
+               i/o-error-port)
+
+    (test-cond &i/o-decoding &i/o-port
+               (make-i/o-decoding-error "Hong Kong")
+               i/o-decoding-error?
+               i/o-error-port)
+
+    (test-cond &i/o-encoding &i/o-port
+               (make-i/o-encoding-error "Hong Kong" #\$)
+               i/o-encoding-error?
+               i/o-error-port
+               i/o-encoding-error-char)
+    
+    ;;
+    ))
+
adddir ./test/r6rs/contrib
addfile ./test/r6rs/contrib.sls
hunk ./test/r6rs/contrib.sls 1
+#!r6rs
+
+(library (tests r6rs contrib)
+  (export run-contrib-tests)
+  (import (rnrs)
+          (tests r6rs test)
+          (prefix (tests r6rs contrib helper1) L:))
+
+  ;; Definitions ----------------------------------------
+
+  ;; from Derick Eddington:
+  (define-syntax my-letrec
+    (syntax-rules ()
+      [(_ ([v e] ...) . b)
+       (let ()
+         (define t (list e ...))
+         (define v (let ([v (car t)]) (set! t (cdr t)) v))
+         ...
+         . b)]))
+
+  ;; Expressions ----------------------------------------
+
+  (define (run-contrib-tests)
+
+    ;; from Derick Eddington:
+    (test (my-letrec ([f (lambda (x) (g x 2))]
+                      [g (lambda (x y) (+ x y))])
+            (f 1))
+          3)
+
+    ;; from Derick Eddington:
+    (test (L:s L:x) 'ok)
+
+    ;;;
+    ))
addfile ./test/r6rs/control.sls
hunk ./test/r6rs/control.sls 1
+#!r6rs
+
+(library (tests r6rs control)
+  (export run-control-tests)
+  (import (rnrs)
+          (tests r6rs test))
+
+  (define (run-control-tests)
+
+    (test (when (> 3 2) 'greater) 'greater)
+    (test/unspec (when (< 3 2) 'greater))
+    (test/unspec (unless (> 3 2) 'less))
+    (test (unless (< 3 2) 'less) 'less)
+
+    (test (do ((vec (make-vector 5))
+               (i 0 (+ i 1)))
+              ((= i 5) vec)
+            (vector-set! vec i i))
+          '#(0 1 2 3 4))
+
+    (test (let ((x '(1 3 5 7 9)))
+            (do ((x x (cdr x))
+                 (sum 0 (+ sum (car x))))
+                ((null? x) sum)))
+          25)
+
+    (let ([foo
+           (case-lambda 
+            (() 'zero)
+            ((x) (list 'one x))
+            ((x y) (list 'two x y))
+            ((a b c d . e) (list 'four a b c d e))
+            (rest (list 'rest rest)))])
+
+      (test (foo) 'zero)
+      (test (foo 1) '(one 1))
+      (test (foo 1 2) '(two 1 2))
+      (test (foo 1 2 3) '(rest (1 2 3)))
+      (test (foo 1 2 3 4) '(four 1 2 3 4 ())))
+      
+    ;;
+    ))
+
addfile ./test/r6rs/enums.sls
hunk ./test/r6rs/enums.sls 1
+#!r6rs
+
+(library (tests r6rs enums)
+  (export run-enums-tests)
+  (import (rnrs)
+          (tests r6rs test))
+
+  ;; ----------------------------------------
+
+  (define-enumeration color
+    (black white purple maroon)
+    color-set)
+  
+  ;; ----------------------------------------
+
+  (define (run-enums-tests)
+    
+    (test (let* ((e (make-enumeration '(red green blue)))
+                 (i (enum-set-indexer e)))
+            (list (i 'red) (i 'green) (i 'blue) (i 'yellow)))
+          '(0 1 2 #f))
+
+    (let* ((e (make-enumeration '(red green blue)))
+           (r ((enum-set-constructor e) '(red))))
+      (test (enum-set->list (enum-set-universe e))
+            '(red green blue))
+      (test (enum-set->list (enum-set-universe r))
+            '(red green blue))
+      (test ((enum-set-indexer
+              ((enum-set-constructor e) '(red)))
+             'green)
+            1)
+      (test (enum-set-member? 'red e) #t)
+      (test (enum-set-member? 'black e) #f)
+      (test (enum-set-subset? e e) #t)
+      (test (enum-set-subset? r e) #t)
+      (test (enum-set-subset? e r) #f)
+      (test (enum-set-subset? e (make-enumeration '(blue green red))) #t)
+      (test (enum-set-subset? e (make-enumeration '(blue green red black))) #t)
+      (test (enum-set-subset? (make-enumeration '(blue green red black)) e) #f)
+      (test (enum-set-subset? ((enum-set-constructor
+                                (make-enumeration '(blue green red black)))
+                               '(red))
+                              e) #f)
+      (test (enum-set-subset? ((enum-set-constructor
+                                (make-enumeration '(green red)))
+                               '(red))
+                              e) #t)
+      (test (enum-set=? e e) #t)
+      (test (enum-set=? r e) #f)
+      (test (enum-set=? e r) #f)
+      (test (enum-set=? e (make-enumeration '(blue green red))) #t))
+
+    (test (let* ((e (make-enumeration '(red green blue)))
+                 (c (enum-set-constructor e)))
+            (list
+             (enum-set-member? 'blue (c '(red blue)))
+             (enum-set-member? 'green (c '(red blue)))
+             (enum-set-subset? (c '(red blue)) e)
+             (enum-set-subset? (c '(red blue)) (c '(blue red)))
+             (enum-set-subset? (c '(red blue)) (c '(red)))
+             (enum-set=? (c '(red blue)) (c '(blue red)))))
+          (list #t #f #t #t #f #t))
+
+    (test (let* ((e (make-enumeration '(red green blue)))
+                 (c (enum-set-constructor e)))
+            (enum-set->list (c '(blue red)))) 
+          '(red blue))
+
+    (test (let* ((e (make-enumeration '(red green blue)))
+                 (c (enum-set-constructor e)))
+            (list (enum-set->list
+                   (enum-set-union (c '(blue)) (c '(red))))
+                  (enum-set->list
+                   (enum-set-intersection (c '(red green))
+                                          (c '(red blue))))
+                  (enum-set->list
+                   (enum-set-difference (c '(red green))
+                                        (c '(red blue))))))
+          '((red blue) (red) (green)))
+
+    (test (let* ((e (make-enumeration '(red green blue)))
+                 (c (enum-set-constructor e)))
+            (enum-set->list
+             (enum-set-complement (c '(red)))))
+          '(green blue))
+
+    (test (let ((e1 (make-enumeration
+                     '(red green blue black)))
+                (e2 (make-enumeration
+                     '(red black white))))
+            (enum-set->list
+             (enum-set-projection e1 e2)))
+          '(red black))
+
+    (test (color black)                      'black)
+    ; (test/exn (color purpel) &syntax) ; not a runtime exception
+    (test (enum-set->list (color-set))       '())
+    (test (enum-set->list
+           (color-set maroon white)) 
+          '(white maroon))
+
+    ;;
+    ))
+
addfile ./test/r6rs/eval.sls
hunk ./test/r6rs/eval.sls 1
+#!r6rs
+
+(library (tests r6rs eval)
+  (export run-eval-tests)
+  (import (rnrs)
+          (rnrs eval)
+          (tests r6rs test))
+
+  (define (run-eval-tests)
+
+    (test (eval '(let ((x 3)) x)
+                (environment '(rnrs)))
+          3)
+
+    (test (eval
+           '(eval:car (eval:cons 2 4))
+           (environment
+            '(prefix (only (rnrs) car cdr cons null?)
+                     eval:)))
+          2)
+
+    ;; Check that `eval' at compile-time produces values (such as conditions)
+    ;; that make sense at compile time (i.e., no phase crossing):
+    (test (eval
+           '(let-syntax ([x (lambda (stx)
+                              (datum->syntax
+                               #'here
+                               (condition-message
+                                (call/cc
+                                 (lambda (esc)
+                                   (with-exception-handler
+                                    (lambda (exn) (esc exn))
+                                    (lambda ()
+                                      (eval '(assertion-violation 'exptime "ok")
+                                            (environment
+                                             '(rnrs)
+                                             '(rnrs eval))))))))))])
+              x)
+           (environment '(rnrs) '(for (rnrs eval) expand)))
+          "ok")
+
+    ;;
+    ))
+
addfile ./test/r6rs/exceptions.sls
hunk ./test/r6rs/exceptions.sls 1
+#!r6rs
+
+(library (tests r6rs exceptions)
+  (export run-exceptions-tests)
+  (import (rnrs)
+          (tests r6rs test))
+
+  (define (run-exceptions-tests)
+
+    (test/output
+     (guard (con
+             ((error? con)
+              (if (message-condition? con)
+                  (display (condition-message con))
+                  (display "an error has occurred"))
+              'error)
+             ((violation? con)
+              (if (message-condition? con)
+                  (display (condition-message con))
+                  (display "the program has a bug"))
+              'violation))
+            (raise
+             (condition
+              (make-error)
+              (make-message-condition "I am an error"))))
+     'error
+     "I am an error")
+
+    (test/exn
+     (guard (con
+             ((error? con)
+              (if (message-condition? con)
+                  (display (condition-message con))
+                  (display "an error has occurred"))
+              'error))
+            (raise
+             (condition
+              (make-violation)
+              (make-message-condition "I am an error"))))
+     &violation)
+
+    (test/output
+     (guard (con
+             ((error? con)
+              (display "error opening file")
+              #f))
+            (call-with-input-file "foo-must-not-exist.scm" read))
+     #f
+     "error opening file")
+
+    (test/output
+     (with-exception-handler
+      (lambda (con)
+        (cond
+         ((not (warning? con))
+          (raise con))
+         ((message-condition? con)
+          (display (condition-message con)))
+         (else
+          (display "a warning has been issued")))
+        42)
+      (lambda ()
+        (+ (raise-continuable
+            (condition
+             (make-warning)
+             (make-message-condition
+              "should be a number")))
+           23)))
+     65
+     "should be a number")
+
+    (test/exn (with-exception-handler (lambda (x) 0)
+                                      (lambda () (error #f "bad")))
+              &non-continuable)
+
+    
+    (let ([v '()])
+      (test (guard (exn [(equal? exn 5) 'five])
+                   ;; `guard' should jump back in before re-raising
+                   (guard (exn [(equal? exn 6) 'six])
+                          (dynamic-wind
+                              (lambda () (set! v (cons 'in v)))
+                              (lambda () (raise 5))
+                              (lambda () (set! v (cons 'out v))))))
+            'five)
+      (test v '(out in out in)))
+      
+
+      
+    ;;
+    ))
+
addfile ./test/r6rs/hashtables.sls
hunk ./test/r6rs/hashtables.sls 1
+#!r6rs
+
+(library (tests r6rs hashtables)
+  (export run-hashtables-tests)
+  (import (rnrs)
+          (tests r6rs test))
+
+  (define-syntax test-ht
+    (syntax-rules ()
+      [(_ mk key=? ([key val] ...)
+          key/r orig-val new-val
+          key/a a-val
+          key/rm)
+       (let ([h mk])
+         (test (hashtable? h) #t)
+         (test (hashtable-size h) 0)
+         (test (hashtable-ref h key/r 'nope) 'nope)
+         (test/unspec (hashtable-delete! h key)) ...
+         (test (hashtable-size h) 0)
+
+         (test (hashtable-ref h key/r 'nope) 'nope)
+         (test (hashtable-contains? h key/r) #f)
+         (test/unspec (hashtable-set! h key/r orig-val))
+         (test (hashtable-ref h key/r 'nope) orig-val)
+         (test (hashtable-contains? h key/r) #t)
+         (test (hashtable-size h) 1)
+
+         (test/unspec (hashtable-set! h key val)) ...
+         (test (hashtable-size h) (length '(key ...)))
+         (test (hashtable-ref h key/r 'nope) orig-val)
+         (test (hashtable-ref h key 'nope) val) ...
+
+         (let ([h1 (hashtable-copy h #t)]
+               [h1i (hashtable-copy h)])
+           (test (hashtable-mutable? h) #t)
+           (test (hashtable-mutable? h1) #t)
+           (test (hashtable-mutable? h1i) #f)
+           
+           (test (vector-length (hashtable-keys h))
+                 (hashtable-size h))
+           (test (vector-length (let-values ([(k e) (hashtable-entries h)])
+                                  e))
+                 (hashtable-size h))
+           (test (exists (lambda (v) (key=? v key/r))
+                         (vector->list (hashtable-keys h)))
+                 #t)
+
+           (test/unspec (hashtable-set! h key/r new-val))
+           (test (hashtable-contains? h key/r) #t)
+           (test (hashtable-ref h key/r 'nope) new-val)
+
+           (test/unspec (hashtable-update! h key/r (lambda (v)
+                                                     (test v new-val)
+                                                     orig-val)
+                                           'nope))
+           (test (hashtable-ref h key/r 'nope) orig-val)
+           (test/unspec (hashtable-update! h key/r (lambda (v)
+                                                     (test v orig-val)
+                                                     new-val)
+                                           'nope))
+           (test (hashtable-ref h key/r 'nope) new-val)
+
+           (test/unspec (hashtable-update! h key/a (lambda (v)
+                                                     (test v 'nope)
+                                                     a-val)
+                                           'nope))
+           (test (hashtable-ref h key/a 'nope) a-val)
+           (test/unspec (hashtable-delete! h key/a))
+
+           (test (hashtable-contains? h key/rm) #t)
+           (hashtable-delete! h key/rm)
+           (test (hashtable-contains? h key/rm) #f)
+           (test (hashtable-ref h key/rm 'nope) 'nope)
+
+           (test (hashtable-ref h1 key 'nope) val) ...
+           (test (hashtable-ref h1i key 'nope) val) ...
+           (test (hashtable-contains? h1 key/rm) #t)
+           (test (hashtable-contains? h1i key/rm) #t)
+
+           (hashtable-clear! h)
+           (test (hashtable-contains? h key) #f) ...
+           (test (hashtable-contains? h1 key) #t) ...
+           (test (hashtable-contains? h1i key) #t) ...
+
+           (test/unspec (hashtable-clear! h1))
+           
+           (test/exn (hashtable-set! h1i key/r #f) &violation)
+           (test/exn (hashtable-delete! h1i key/r) &violation)
+           (test/exn (hashtable-update! h1i key/r (lambda (q) q) 'none) &violation)
+           (test/exn (hashtable-clear! h1i) &violation)))]))
+  
+  ;; ----------------------------------------
+
+  (define (run-hashtables-tests)
+
+    (let-values ([(kv vv)
+                  (let ((h (make-eqv-hashtable)))
+                    (hashtable-set! h 1 'one)
+                    (hashtable-set! h 2 'two)
+                    (hashtable-set! h 3 'three)
+                    (hashtable-entries h))])
+      (test/alts (cons kv vv)
+                 '(#(1 2 3)  . #(one two three))
+                 '(#(1 3 2)  . #(one three two))
+                 '(#(2 1 3)  . #(two one three))
+                 '(#(2 3 1)  . #(two three one))
+                 '(#(3 1 2)  . #(three one two))
+                 '(#(3 2 1)  . #(three two one))))
+    
+    (test-ht (make-eq-hashtable) eq?
+             (['a 7] ['b "bee"]
+              [#t 8] [#f 9]
+              ['c 123456789101112])
+             'b "bee" "bumble"
+             'd 12
+             'c)
+    
+    (test-ht (make-eqv-hashtable) eqv?
+             (['a 7] [#\b "bee"]
+              [#t 8] [0.0 85]
+              [123456789101112 'c])
+             #\b "bee" "bumble"
+             'd 12
+             123456789101112)
+
+    (let ([val-of (lambda (a)
+                    (if (number? a) 
+                        a 
+                        (string->number a)))])
+      (test-ht (make-hashtable val-of
+                               (lambda (a b)
+                                 (= (val-of a) (val-of b)))) 
+               equal?
+               ([1 'one]["2" 'two]
+                [3 'three]["4" 'four])
+               2 'two 'er
+               5 'five
+               4))
+
+    (test (hashtable? (make-eq-hashtable 10)) #t)
+    (test (hashtable? (make-eqv-hashtable 10)) #t)
+    (test (hashtable? (make-hashtable (lambda (x) 0) equal? 10)) #t)
+    
+    (let ([zero (lambda (a) 0)]
+          [same? (lambda (a b) #t)])
+      (let ([ht (make-hashtable zero same?)])
+        (test (hashtable-equivalence-function ht) same?)
+        (test (hashtable-hash-function ht) zero)))
+
+    (test (equal-hash "a") (equal-hash (make-string 1 #\a)))
+    (test (equal-hash 1024) (equal-hash (expt 2 10)))
+    (test (equal-hash '(1 2 3)) (equal-hash (list 1 2 3)))
+
+    (test (string-hash "a") (string-hash (make-string 1 #\a)))
+    (test (string-hash "aaaaa") (string-hash (make-string 5 #\a)))
+    (test (string-ci-hash "aAaAA") (string-ci-hash (make-string 5 #\a)))
+    (test (string-ci-hash "aAaAA") (string-ci-hash (make-string 5 #\A)))
+
+    (test (symbol-hash 'a) (symbol-hash 'a))
+
+    ;;
+    ))
+
adddir ./test/r6rs/io
addfile ./test/r6rs/lists.sls
hunk ./test/r6rs/lists.sls 1
+#!r6rs
+
+(library (tests r6rs lists)
+  (export run-lists-tests)
+  (import (rnrs)
+          (tests r6rs test))
+
+  (define (run-lists-tests)
+    
+    ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+    ;;  Tests originally from R6RS
+
+    (test (find even? '(3 1 4 1 5 9)) 4)
+    (test (find even? '(3 1 5 1 5 9)) #f)
+    
+    (test (for-all even? '()) #t)
+    (test (for-all even? '(3 1 4 1 5 9)) #f)
+    ;; (test (for-all even? '(3 1 4 1 5 9 . 2)) #f) ; removed from R6RS
+    (test (for-all even? '(2 4 14)) #t)
+    (test/exn (for-all even? '(2 4 14 . 9)) &assertion)
+    (test (for-all (lambda (n) (and (even? n) n))
+                   '(2 4 14)) 
+          14)
+    (test (for-all < '(1 2 3) '(2 3 4)) #t)
+    (test (for-all < '(1 2 4) '(2 3 4)) #f)
+    
+    (test (exists even? '(3 1 4 1 5 9)) #t)
+    (test (exists even? '(3 1 1 5 9)) #f)
+    (test (exists even? '()) #f)
+    (test/exn (exists even? '(3 1 1 5 9 . 2)) &assertion)
+    (test (exists (lambda (n) (and (even? n) n)) '(2 1 4 14)) 2)
+    (test (exists < '(1 2 4) '(2 3 4)) #t)
+    (test (exists > '(1 2 3) '(2 3 4)) #f)
+
+    (test (filter even? '(3 1 4 1 5 9 2 6)) '(4 2 6))
+
+    (test/values (partition even? '(3 1 4 1 5 9 2 6)) '(4 2 6) '(3 1 1 5 9))
+
+    (test (fold-left + 0 '(1 2 3 4 5)) 15)
+
+    (test (fold-left (lambda (a e) (cons e a)) '()
+                     '(1 2 3 4 5)) 
+          '(5 4 3 2 1))
+
+    (test (fold-left (lambda (count x)
+                       (if (odd? x) (+ count 1) count))
+                     0
+                     '(3 1 4 1 5 9 2 6 5 3)) 
+          7)
+    (test (fold-left (lambda (max-len s)
+                       (max max-len (string-length s)))
+                     0
+                     '("longest" "long" "longer")) 
+          7)
+
+    (test (fold-left cons '(q) '(a b c)) '((((q) . a) . b) . c))
+    
+    (test (fold-left + 0 '(1 2 3) '(4 5 6)) 21)
+    
+    (test (fold-right + 0 '(1 2 3 4 5)) 15)
+    
+    (test (fold-right cons '() '(1 2 3 4 5)) '(1 2 3 4 5))
+    
+    (test (fold-right (lambda (x l)
+                        (if (odd? x) (cons x l) l))
+                      '()
+                      '(3 1 4 1 5 9 2 6 5))
+          '(3 1 1 5 9 5))
+
+    (test (fold-right cons '(q) '(a b c)) '(a b c q))
+
+    (test (fold-right + 0 '(1 2 3) '(4 5 6)) 21)
+    
+    (test (remp even? '(3 1 4 1 5 9 2 6 5)) '(3 1 1 5 9 5))
+
+    (test (remove 1 '(3 1 4 1 5 9 2 6 5)) '(3 4 5 9 2 6 5))
+    
+    (test (remv 1 '(3 1 4 1 5 9 2 6 5)) '(3 4 5 9 2 6 5))
+    
+    (test (remq 'foo '(bar foo baz)) '(bar baz))
+    
+    (test (memp even? '(3 1 4 1 5 9 2 6 5)) '(4 1 5 9 2 6 5))
+    
+    (test (memq 'a '(a b c))               '(a b c))
+    (test (memq 'b '(a b c))               '(b c))
+    (test (memq 'a '(b c d))               #f)
+    (test (memq (list 'a) '(b (a) c))      #f)
+    (test (member (list 'a) '(b (a) c))   '((a) c))
+    (test/unspec (memq 101 '(100 101 102)))
+    (test (memv 101 '(100 101 102)) '(101 102))
+
+    (let ([d '((3 a) (1 b) (4 c))])
+      (test (assp even? d) '(4 c))
+      (test (assp odd? d) '(3 a)))
+
+    (let ([e '((a 1) (b 2) (c 3))])
+      (test (assq 'a e)      '(a 1))
+      (test (assq 'b e)      '(b 2))
+      (test (assq 'd e)      #f))
+
+
+    (test (assq (list 'a) '(((a)) ((b)) ((c))))
+          #f)
+    (test (assoc (list 'a) '(((a)) ((b)) ((c))))   
+          '((a)))
+    (test/unspec (assq 5 '((2 3) (5 7) (11 13))))
+    (test (assv 5 '((2 3) (5 7) (11 13))) '(5 7))
+
+    (test (cons* 1 2 '(3 4 5)) '(1 2 3 4 5))
+    (test (cons* 1 2 3) '(1 2 . 3))
+    (test (cons* 1) 1)
+
+    ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+    ;; Tests originally from Ikarus
+
+    (test (for-all even? '(1 2 3 4)) #f)
+    (test (for-all even? '(10 12 14 16)) #t)
+    (test (for-all even? '(2 3 4)) #f)
+    (test (for-all even? '(12 14 16)) #t)
+    (test (for-all (lambda (x) x) '(12 14 16)) 16)
+    (test (for-all (lambda (x) x) '(12 14)) 14)
+    (test (for-all (lambda (x) x) '(12)) 12)
+    (test (for-all (lambda (x) x) '()) #t)
+    ;; (test (for-all even? '(13 . 14)) #f) ; removed from R6RS
+    (test (for-all cons '(1 2 3) '(a b c)) '(3 . c))
+    (test (for-all (lambda (a b) (= a 1)) '(1 2 3) '(a b c)) #f)
+    ;; R6RS merely says that this *should* work, but not must:
+    ;; (test (for-all (lambda (a b) (= a 1)) '(1 2) '(a b c)) #f)
+    (test (fold-left + 0 '(1 2 3 4 5)) 15)
+    (test (fold-left (lambda (a b) (cons b a)) '() '(1 2 3 4 5))
+          '(5 4 3 2 1))
+    (test (fold-left (lambda (count x)
+                       (if (odd? x) 
+                           (+ count 1) 
+                           count))
+                     0 
+                     '(3 1 4 1 5 9 2 6 5 3))
+          7)
+    (test (fold-left cons '(q) '(a b c)) '((((q) . a) . b) . c))
+    (test (fold-left + 0 '(1 2 3) '(4 5 6)) 21)
+    (test (fold-right + 0 '(1 2 3 4 5)) 15)
+    (test (fold-right cons '() '(1 2 3 4 5))
+          '(1 2 3 4 5))
+    (test (fold-right (lambda (x l)
+                        (if (odd? x) 
+                            (cons x l)
+                            l))
+                      '()
+                      '(3 1 4 1 5 9 2 6 5 3))
+          '(3 1 1 5 9 5 3))
+    (test (fold-right + 0 '(1 2 3) '(4 5 6)) 21)
+
+    ;;
+    ))
addfile ./test/r6rs/mutable-pairs.sls
hunk ./test/r6rs/mutable-pairs.sls 1
+#!r6rs
+
+(library (tests r6rs mutable-pairs)
+  (export run-mutable-pairs-tests)
+  (import (rnrs)
+          (rnrs mutable-pairs)
+          (tests r6rs test))
+
+  (define (f) (list 'not-a-constant-list))
+  (define (g) '(constant-list))
+  
+  (define (run-mutable-pairs-tests)
+
+    (test/unspec (set-car! (f) 3))
+    (test/unspec-or-exn (set-car! (g) 3)
+                        &assertion)
+
+    (test (let ((x (list 'a 'b 'c 'a))
+                (y (list 'a 'b 'c 'a 'b 'c 'a)))
+            (set-cdr! (list-tail x 2) x)
+            (set-cdr! (list-tail y 5) y)
+            (list
+             (equal? x x)
+             (equal? x y)
+             (equal? (list x y 'a) (list y x 'b))))
+          '(#t #t #f))
+      
+    ;;
+    ))
+
addfile ./test/r6rs/mutable-strings.sls
hunk ./test/r6rs/mutable-strings.sls 1
+#!r6rs
+
+(library (tests r6rs mutable-strings)
+  (export run-mutable-strings-tests)
+  (import (rnrs)
+          (rnrs mutable-strings)
+          (tests r6rs test))
+
+  (define (f) (make-string 3 #\*))
+  (define (g) "***")
+  
+  (define (run-mutable-strings-tests)
+
+    (test/unspec (string-set! (f) 0 #\?))
+    (test/unspec-or-exn (string-set! (g) 0 #\?)
+                        &assertion)
+    (test/unspec-or-exn (string-set! (symbol->string 'immutable)
+                                     0
+                                     #\?)
+                        &assertion)
+      
+    ;;
+    ))
+
addfile ./test/r6rs/programs.sls
hunk ./test/r6rs/programs.sls 1
+#!r6rs
+
+(library (tests r6rs programs)
+  (export run-programs-tests)
+  (import (rnrs)
+          (tests r6rs test))
+
+  (define (run-programs-tests)
+
+    (test (list? (command-line)) #t)
+    (test (string? (car (command-line))) #t)
+      
+    ;;
+    ))
+
addfile ./test/r6rs/r5rs.sls
hunk ./test/r6rs/r5rs.sls 1
+#!r6rs
+
+(library (tests r6rs r5rs)
+  (export run-r5rs-tests)
+  (import (rnrs)
+          (rnrs r5rs)
+          (rnrs eval)
+          (tests r6rs test))
+
+  ;; ----------------------------------------
+
+  (define a-stream
+    (letrec ((next
+              (lambda (n)
+                (cons n (delay (next (+ n 1)))))))
+      (next 0)))
+  (define head car)
+  (define tail
+    (lambda (stream) (force (cdr stream))))
+
+  (define count 0)
+  (define p
+    (delay (begin (set! count (+ count 1))
+                  (if (> count x)
+                      count
+                      (force p)))))
+  (define x 5)
+
+  ;; ----------------------------------------
+
+  (define (run-r5rs-tests)
+
+    (test (modulo 13 4)            1)
+    (test (remainder 13 4)         1)
+
+    (test (modulo -13 4)           3)
+    (test (remainder -13 4)        -1)
+    
+    (test (modulo 13 -4)           -3)
+    (test (remainder 13 -4)        1)
+
+    (test (modulo -13 -4)          -1)
+    (test (remainder -13 -4)       -1)
+
+    (test (remainder -13 -4.0)     -1.0)
+
+    (test (force (delay (+ 1 2)))    3)
+    
+    (test (let ((p (delay (+ 1 2))))
+            (list (force p) (force p)))  
+          '(3 3))
+    
+
+    (test (head (tail (tail a-stream))) 2)
+
+    (test/unspec p)
+    (test (force p) 6)
+    (test/unspec p)
+    (test (begin (set! x 10)
+                 (force p))      
+          6)
+
+    ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+    ;;  quotient, remainder, and modulo tests from Ikarus's
+    ;;  "bignums" test suite
+
+    (test (quotient 348972 3434)
+          101)
+    (test (quotient -348972 3434)
+          -101)
+    (test (quotient 348972 -3434)
+          -101)
+    (test (quotient -348972 -3434)
+          101)
+    (test (quotient 536870912 238)
+          2255760)
+    (test (quotient -536870912 238)
+          -2255760)
+    (test (quotient 536870912 -238)
+          -2255760)
+    (test (quotient -536870912 -238)
+          2255760)
+    (test (quotient 536870912238479837489374 324873)
+          1652556267336712615)
+    (test (quotient -536870912238479837489374 324873)
+          -1652556267336712615)
+    (test (quotient 536870912238479837489374 -324873)
+          -1652556267336712615)
+    (test (quotient -536870912238479837489374 -324873)
+          1652556267336712615)
+    (test (quotient 536870912238479837489374 3248732398479823749283)
+          165)
+    (test (quotient -536870912238479837489374 3248732398479823749283)
+          -165)
+    (test (quotient 536870912238479837489374 -3248732398479823749283)
+          -165)
+    (test (quotient -536870912238479837489374 -3248732398479823749283)
+          165)
+    (test (quotient 5368709122384798374893743894798327498234 3248732398479823749283)
+          1652555047284588078)
+    (test (quotient -5368709122384798374893743894798327498234 3248732398479823749283)
+          -1652555047284588078)
+    (test (quotient 5368709122384798374893743894798327498234 -3248732398479823749283)
+          -1652555047284588078)
+    (test (quotient -5368709122384798374893743894798327498234 -3248732398479823749283)
+          1652555047284588078)
+    (test (remainder 23 349839489348)
+          23)
+    (test (remainder -23 349839489348)
+          -23)
+    (test (remainder 23 -349839489348)
+          23)
+    (test (remainder -23 -349839489348)
+          -23)
+    (test (modulo 348972 3434)
+          2138)
+    (test (modulo -348972 3434)
+          1296)
+    (test (modulo 348972 -3434)
+          -1296)
+    (test (modulo -348972 -3434)
+          -2138)
+    (test (modulo -23 349839489348)
+          349839489325)
+    (test (modulo -23 -349839489348)
+          -23)
+    (test (modulo 23 349839489348)
+          23)
+    (test (modulo 23 -349839489348)
+          -349839489325)
+    (test (remainder 536870912 238)
+          32)
+    (test (remainder -536870912 238)
+          -32)
+    (test (remainder 536870912 -238)
+          32)
+    (test (remainder -536870912 -238)
+          -32)
+    (test (modulo 536870912 238)
+          32)
+    (test (modulo -536870912 238)
+          206)
+    (test (modulo 536870912 -238)
+          -206)
+    (test (modulo -536870912 -238)
+          -32)
+    (test (modulo 536870912238479837489374 324873)
+          116479)
+    (test (modulo -536870912238479837489374 324873)
+          208394)
+    (test (modulo 536870912238479837489374 -324873)
+          -208394)
+    (test (modulo -536870912238479837489374 -324873)
+          -116479)
+    (test (modulo 536870912238479837489374 3248732398479823749283)
+          830066489308918857679)
+    (test (modulo 536870912238479837489374 -3248732398479823749283)
+          -2418665909170904891604)
+    (test (modulo -536870912238479837489374 3248732398479823749283)
+          2418665909170904891604)
+    (test (modulo -536870912238479837489374 -3248732398479823749283)
+          -830066489308918857679)
+
+    ;; ----------------------------------------
+
+    (test (exact->inexact 1) 1.0)
+    (test (exact->inexact 1.0) 1.0)
+    (test (inexact->exact 1) 1)
+    (test (inexact->exact 1.0) 1)
+
+    ;; ----------------------------------------
+
+    (test (eval '(cond [#t 1]) (null-environment 5)) 1)
+    (test (eval '(cond [#t => (lambda (x) x)]) (null-environment 5)) #t)
+
+
+    (test (eval '(cons 1 2) (scheme-report-environment 5)) '(1 . 2))
+
+    ;;
+    ))
+
addfile ./test/r6rs/reader.sls
hunk ./test/r6rs/reader.sls 1
+#!r6rs
+
+(library (tests r6rs reader)
+  (export run-reader-tests)
+  (import (rnrs)
+          (tests r6rs test))
+
+  (define-syntax number-test
+    (syntax-rules ()
+      [(_ str ...)
+       (begin
+         (test (read (open-string-input-port str))
+               (string->number str))
+         ...)]))
+
+  (define (run-reader-tests)
+    (number-test
+     "12"
+     "+12"
+     "3427384783264876238746784234"
+     "0"
+     "+0"
+     "-12"
+     "-3498738947983748939478347834"
+     "-0"
+     "#x-238973897AAAAAFFFFbb00bbdddcc"
+     "#x238973897AAAAA000FFFFbbbbdddcc"
+     "#x+07edf387"
+     "#x+0"
+     "#x-0"
+     "#x0"
+     "#b01010101010000000111111111110000"
+     "#b-01010101010000000111111111110000"
+     "#b+01010101010000000111111111110000"
+     "#b+0"
+     "#b-0"
+     "#b0"
+     "#d2398128321308912830912830912839"
+     "#d-2398128321308912830912830912839"
+     "#d+2398128321308912830912830912839"
+     "#d+0"
+     "#d-0"
+     "#d0"
+     "#o237612036721631263126371263712"
+     "#o-2376120036721631263126371263712"
+     "#o+23761236721631263126371263712"
+     "#o+0"
+     "#o-0"
+     "#o0"
+     
+     "#X-238973897AAAAAFFFFbb00bbdddcc"
+     "#X238973897AAAAA000FFFFbbbbdddcc"
+     "#X+07edf387"
+     "#X+0"
+     "#X-0"
+     "#X0"
+     "#B01010101010000000111111111110000"
+     "#B-01010101010000000111111111110000"
+     "#B+01010101010000000111111111110000"
+     "#B+0"
+     "#B-0"
+     "#B0"
+     "#D2398128321308912830912830912839"
+     "#D-2398128321308912830912830912839"
+     "#D+2398128321308912830912830912839"
+     "#D+0"
+     "#D-0"
+     "#D0"
+     "#O237612036721631263126371263712"
+     "#O-2376120036721631263126371263712"
+     "#O+23761236721631263126371263712"
+     "#O+0"
+     "#O-0"
+     "#O0"
+     "#i#xf/e"
+     "#x#if/e")
+    
+    (test (read (open-string-input-port "#\\nul")) 
+          (integer->char #x0))
+    (test (read (open-string-input-port "#\\alarm")) 
+          (integer->char #x7))
+    (test (read (open-string-input-port "#\\backspace")) 
+          (integer->char #x8))
+    (test (read (open-string-input-port "#\\tab")) 
+          (integer->char #x9))
+    (test (read (open-string-input-port "#\\linefeed")) 
+          (integer->char #xA))
+    (test (read (open-string-input-port "#\\newline")) 
+          (integer->char #xA))
+    (test (read (open-string-input-port "#\\vtab")) 
+          (integer->char #xB))
+    (test (read (open-string-input-port "#\\page")) 
+          (integer->char #xC))
+    (test (read (open-string-input-port "#\\return")) 
+          (integer->char #xD))
+    (test (read (open-string-input-port "#\\esc")) 
+          (integer->char #x1B))
+    (test (read (open-string-input-port "#\\space")) 
+          (integer->char #x20))
+    (test (read (open-string-input-port "#\\delete")) 
+          (integer->char #x7F))
+
+    ;;
+    ))
adddir ./test/r6rs/records
adddir ./test/r6rs/run
addfile ./test/r6rs/run-via-eval.sps
hunk ./test/r6rs/run-via-eval.sps 1
+#!r6rs
+
+(import (rnrs) (rnrs eval) (tests r6rs test))
+
+(define-syntax test-library
+   (syntax-rules ()
+     [(_ test-proc library-name)
+      (test/unspec (eval '(test-proc) (environment 'library-name)))]))
+
+(test-library run-base-tests               (tests r6rs base))
+(test-library run-reader-tests             (tests r6rs reader))
+(test-library run-unicode-tests            (tests r6rs unicode))
+(test-library run-bytevectors-tests        (tests r6rs bytevectors))
+(test-library run-lists-tests              (tests r6rs lists))
+(test-library run-sorting-tests            (tests r6rs sorting))
+(test-library run-control-tests            (tests r6rs control))
+(test-library run-records-syntactic-tests  (tests r6rs records syntactic))
+(test-library run-records-procedural-tests (tests r6rs records procedural))
+(test-library run-exceptions-tests         (tests r6rs exceptions))
+(test-library run-conditions-tests         (tests r6rs conditions))
+(test-library run-io-ports-tests           (tests r6rs io ports))
+(test-library run-io-simple-tests          (tests r6rs io simple))
+(test-library run-programs-tests           (tests r6rs programs))
+(test-library run-arithmetic-fixnums-tests (tests r6rs arithmetic fixnums))
+(test-library run-arithmetic-flonums-tests (tests r6rs arithmetic flonums))
+(test-library run-arithmetic-bitwise-tests (tests r6rs arithmetic bitwise))
+(test-library run-syntax-case-tests        (tests r6rs syntax-case))
+(test-library run-hashtables-tests         (tests r6rs hashtables))
+(test-library run-enums-tests              (tests r6rs enums))
+(test-library run-eval-tests               (tests r6rs eval))
+(test-library run-mutable-pairs-tests      (tests r6rs mutable-pairs))
+(test-library run-mutable-strings-tests    (tests r6rs mutable-strings))
+(test-library run-r5rs-tests               (tests r6rs r5rs))
+(test-library run-contrib-tests            (tests r6rs contrib))
+
+(report-test-results)
+
addfile ./test/r6rs/run.sps
hunk ./test/r6rs/run.sps 1
+#!r6rs
+
+(import (rnrs)
+        (tests r6rs test)
+        (tests r6rs base)
+        (tests r6rs reader)
+        (tests r6rs unicode)
+        (tests r6rs bytevectors)
+        (tests r6rs lists)
+        (tests r6rs sorting)
+        (tests r6rs control)
+        (tests r6rs records syntactic)
+        (tests r6rs records procedural)
+        (tests r6rs exceptions)
+        (tests r6rs conditions)
+        (tests r6rs io ports)
+        (tests r6rs io simple)
+        (tests r6rs programs)
+        (tests r6rs arithmetic fixnums)
+        (tests r6rs arithmetic flonums)
+        (tests r6rs arithmetic bitwise)
+        (tests r6rs syntax-case)
+        (tests r6rs hashtables)
+        (tests r6rs enums)
+        (tests r6rs eval)
+        (tests r6rs mutable-pairs)
+        (tests r6rs mutable-strings)
+        (tests r6rs r5rs)
+        (tests r6rs contrib))
+
+(run-base-tests)
+
+(run-reader-tests)
+(run-unicode-tests)
+(run-bytevectors-tests)
+(run-lists-tests)
+(run-sorting-tests)
+(run-control-tests)
+(run-records-syntactic-tests)
+(run-records-procedural-tests)
+(run-exceptions-tests)
+(run-conditions-tests)
+(run-io-ports-tests)
+(run-io-simple-tests)
+(run-programs-tests)
+(run-arithmetic-fixnums-tests)
+(run-arithmetic-flonums-tests)
+(run-arithmetic-bitwise-tests)
+(run-syntax-case-tests)
+(run-hashtables-tests)
+(run-enums-tests)
+(run-eval-tests)
+(run-mutable-pairs-tests)
+(run-mutable-strings-tests)
+(run-r5rs-tests)
+(run-contrib-tests)
+
+(report-test-results)
+
addfile ./test/r6rs/sorting.sls
hunk ./test/r6rs/sorting.sls 1
+#!r6rs
+
+(library (tests r6rs sorting)
+  (export run-sorting-tests)
+  (import (rnrs)
+          (tests r6rs test))
+
+  (define (run-sorting-tests)
+
+    (test (list-sort < '(3 5 2 1)) '(1 2 3 5))
+    (test (vector-sort < '#(3 5 2 1)) '#(1 2 3 5))
+
+    (let ([v (vector 3 5 2 1)])
+      (test/unspec (vector-sort! < v))
+      (test v '#(1 2 3 5)))
+
+    ;;
+    ))
+
addfile ./test/r6rs/syntax-case.sls
hunk ./test/r6rs/syntax-case.sls 1
+#!r6rs
+
+(library (tests r6rs syntax-case)
+  (export run-syntax-case-tests)
+  (import (for (rnrs) run expand)
+          (rename (only (rnrs base) cons) (cons kons)) ; for free-identifier=?
+          (tests r6rs test))
+
+  (define (unwrap s)
+    (cond
+     [(pair? s) (cons (unwrap (car s)) (unwrap (cdr s)))]
+     [(vector? s) (list->vector (map unwrap (vector->list s)))]
+     [(null? s) s]
+     [(number? s) s]
+     [(string? s) s]
+     [(boolean? s) s]
+     [else (syntax->datum s)]))
+
+  ;; ----------------------------------------
+  
+  (define p (cons 4 5))
+  (define-syntax p.car
+    (lambda (x)
+      (syntax-case x ()
+        [(_ . rest) #'((car p) . rest)]
+        [_  #'(car p)])))
+
+  ;; Different frmo the report to avoid set-car!
+  (define p2 (cons 4 5))
+  (define-syntax p2.car
+    (make-variable-transformer
+     (lambda (x)
+       (syntax-case x (set!)
+         [(set! _ e) #'(set! p2 (cons e (cdr p2)))]
+         [(_ . rest) #'((car p2) . rest)]
+         [_  #'(car p2)]))))
+  
+  (define-syntax rec
+    (lambda (x)
+      (syntax-case x ()
+        [(_ x e)
+         (identifier? #'x)
+         #'(letrec ([x e]) x)])))
+
+  (define-syntax loop
+    (lambda (x)
+      (syntax-case x ()
+        [(k e ...)
+         (with-syntax
+             ([break (datum->syntax #'k 'break)])
+           #'(call-with-current-continuation
+              (lambda (break)
+                (let f () e ... (f)))))])))
+
+  ;; ----------------------------------------
+  
+  (define (run-syntax-case-tests)
+
+    (test p.car 4)
+    ;; (test/exn (set! p.car 15) &syntax) ; not a runtime exception
+
+    (set! p2.car 15)
+    (test p2.car 15)
+    (test p2 '(15 . 5))
+    
+    (test (map (rec fact
+                    (lambda (n)
+                      (if (= n 0)                 
+                          1
+                          (* n (fact (- n 1))))))
+               '(1 2 3 4 5))
+          '(1 2 6 24 120))
+    
+    ; (test/exn (rec 5 (lambda (x) x)) &syntax) ; not a runtime exception
+    
+    (test
+     (let ([fred 17])
+       (define-syntax a
+         (lambda (x)
+           (syntax-case x ()
+             [(_ id) #'(b id fred)])))
+       (define-syntax b
+         (lambda (x)
+           (syntax-case x ()
+             [(_ id1 id2)
+              #`(list
+                   #,(free-identifier=? #'id1 #'id2)
+                   #,(bound-identifier=? #'id1 #'id2))])))
+       (a fred)) 
+     '(#t #f))
+
+    ; (test/exn (let ([a 3] [a 4]) (+ a a)) &syntax)
+
+    (test (let-syntax
+              ([dolet (lambda (x)
+                        (syntax-case x ()
+                          [(_ b)
+                           #'(let ([a 3] [b 4]) (+ a b))]))])
+            (dolet a)) 
+          7)
+
+    ;; check that it's ok as an expression:
+    (test 6
+          (let-syntax ([foo
+                        (syntax-rules ()
+                          [(_)
+                           (let-syntax ([bar
+                                         (syntax-rules ()
+                                           [(_) 5])])
+                             (bar))])])
+            (+ 1 (foo))))
+
+    #;
+    (test/exn (let ([else #f])
+                (case 0 [else (write "oops")])) 
+              &syntax)
+
+    (test (let ((n 3) (ls '()))
+            (loop
+             (if (= n 0) (break ls))
+             (set! ls (cons 'a ls))
+             (set! n (- n 1)))) 
+          '(a a a))
+
+    ;; ----------------------------------------
+
+    (test (syntax-case #'1 () [1 'one])  'one)
+    (test (syntax-case #'(1) () [(1) 'one])  'one)
+    (test (syntax-case '(1) () [(x) #'x]) 1)
+    (test (syntax-case #'(1) () [(x) (syntax->datum #'x)]) 1)
+    (test (syntax-case '("a") () [(x) #'x]) "a")
+    (test (syntax-case #'("a") () [(x) (syntax->datum #'x)]) "a")
+    (test (syntax-case '(1 #f "s" #vu8(9) #(5 7)) () 
+            [(x ...) #'(x ...)]) 
+          '(1 #f "s" #vu8(9) #(5 7)))
+    (test (syntax-case #'(1 #f "s" #vu8(9) #(5 7)) () 
+            [(x ...) (map syntax->datum #'(x ...))]) 
+          '(1 #f "s" #vu8(9) #(5 7)))
+    (test (syntax-case '(1 2 3 4) () [(x y . z) #'z]) '(3 4))
+    (test (syntax-case #'(a b c d) () [(x y . z) (syntax->datum #'z)]) 
+          '(c d))
+    (test (syntax-case #'(nonesuch 12) (nonesuch) 
+            [(nonesuch x) (syntax->datum #'x)])
+          12)
+    (test (syntax-case #'(different 12) (nonesuch) 
+            [(nonesuch x) #'x]
+            [_ 'other])
+          'other)
+    (test (syntax-case '(1 2 3 4) ()
+            [(1 x ...) #'(x ...)])
+          '(2 3 4))
+    (test (syntax-case '(1 2 3 4) ()
+            [(1 x ... 3 4) #'(x ...)])
+          '(2))
+    (test (syntax-case '(1 2 3 4) ()
+            [(1 x ... 2 3 4) #'(x ...)])
+          '())
+    (test (syntax-case '(1 2 3 4) ()
+            [(1 x ... . y) #'y])
+          '())
+    (test (syntax-case '(1 2 3 4 . 5) ()
+            [(1 x ... . y) #'y])
+          '5)
+    (test (syntax-case '(1 2 3 4 . 5) ()
+            [(1 x ... 4 . y) #'y])
+          '5)
+    (test (syntax-case '(1 2 3 4 . 5) ()
+            [(1 x ... 5 . y) #'y]
+            [_ 'no])
+          'no)
+    (test (syntax-case '#(1 2 3 4) ()
+            [#(1 x y 4) (car #'(x y))])
+          '2)
+    (test (syntax-case '#(1 2 3 4) ()
+            [#(1 x y 4) (cadr #'(x y))])
+          '3)
+    (test (syntax-case '#(1 2 3 4) ()
+            [#(1 x y 4) (syntax->datum (cddr #'(x y)))])
+          '())
+    (test (syntax-case '#(1 2 3 4) ()
+            [#(1 2 3 4) 'match])
+          'match)
+    (test (syntax-case '#(1 2 3 4) ()
+            [#(1 x y 4) #'y])
+          '3)
+    (test (syntax-case '#(1 2 3 4) ()
+            [#(1 x ...) #'(x ...)])
+          '(2 3 4))
+    (test (syntax-case '#(1 2 3 4) ()
+            [#(1 x ... 4) #'(x ...)])
+          '(2 3))
+    (test (syntax-case '#(1 2 3 4) ()
+            [#(1 x ... 2 3 4) #'(x ...)])
+          '())
+    (test (syntax-case #'() ()
+            [(x ...)
+             (let ([v #'#(x ...)])
+               (list (syntax->datum v) (vector? v)))])
+          '(#() #t))
+    (test (syntax-case #'(1) ()
+            [(_) (syntax->datum #'_)])
+          '_)
+    (test (syntax-case '((a) (b c)) ()
+            [((x ...) ...)
+             #'(x ... ...)])
+          '(a b c))
+    (test (syntax-case #'((a) (b c)) ()
+            [((x ...) ...)
+             (map syntax->datum #'(x ... ...))])
+          '(a b c))
+
+    (test (syntax-case #'(... x) ()
+            [a (syntax->datum #'a)])
+          'x)
+    (test (syntax-case #'(... ...) ()
+            [a (syntax->datum #'a)])
+          '...)
+    (test (syntax-case #'(... (other ...)) ()
+            [a (syntax->datum #'a)])
+          '(other ...))
+    (test (syntax-case #'(1 2 3) ()
+            [(a ...) (syntax->datum #'((a (... ...)) ...))])
+          '((1 ...) (2 ...) (3 ...)))
+    (test (syntax-case #'(1 2 3) ()
+            [(a b c) (syntax->datum #'(... (a ...)))])
+          '(1 ...))
+    (test (syntax-case #'(1 2 3) ()
+            [(a b c) (syntax->datum #'(... (... (a) b)))])
+          '(... (1) 2))
+
+    (test (identifier? 'x) #f)
+    (test (identifier? #'x) #t)
+    (test (bound-identifier=? #'x #'x) #t)
+    (test (bound-identifier=? #'x #'y) #f)
+    (test (bound-identifier=? #'cons #'kons) #f)
+    (test (free-identifier=? #'x #'x) #t)
+    (test (free-identifier=? #'x #'y) #f)
+    ;; (test (free-identifier=? #'cons #'kons) #t) ;; see PLT bug report #10210
+
+    (test (syntax->datum #'1) 1)
+    (test (syntax->datum #'a) 'a)
+    (test (syntax->datum #'(a b)) '(a b))
+    (test (syntax->datum #'(a . b)) '(a . b))
+
+    (test (syntax->datum '1) 1)
+    (test (syntax->datum '(1 . 2)) '(1 . 2))
+    (test (syntax->datum '(1 2)) '(1 2))
+    (test (syntax->datum (cons #'a #'b)) '(a . b))
+    (test (syntax->datum (vector #'a #'b)) '#(a b))
+    (test (syntax->datum '#(1 2)) '#(1 2))
+
+    (test (syntax->datum (datum->syntax #'x 1)) 1)
+    (test (syntax->datum (datum->syntax #'x 'a)) 'a)
+    (test (syntax->datum (datum->syntax #'x '(a b))) '(a b))
+    (test (syntax->datum (datum->syntax #'x '(a . b))) '(a . b))
+
+    (test (number? (car (syntax->datum (datum->syntax #'x (list 1))))) #t)
+
+    (test (map identifier? (generate-temporaries '(1 2 3))) '(#t #t #t))
+    (test (map identifier? (generate-temporaries #'(1 2 3))) '(#t #t #t))
+    (test (map identifier? (generate-temporaries (cons 1 #'(2 3)))) '(#t #t #t))
+
+    (test (cadr (with-syntax ([x 1]
+                              [y 2])
+                  #'(x y)))
+          2)
+
+    (test (syntax->datum #`(1 2 3)) '(1 2 3))
+    (test (syntax->datum #`1) 1)
+    
+    ;; Check wrapping:
+    (test (let ([v #`(1 #,(+ 1 1) 3)])
+            (list (pair? v)
+                  (syntax->datum (car v))
+                  (cadr v)
+                  (syntax->datum (cddr v))))
+          '(#t 1 2 (3)))
+    (test (let ([v #`(1 #,@(list (+ 1 1)) 3)])
+            (list (pair? v)
+                  (syntax->datum (car v))
+                  (cadr v)
+                  (syntax->datum (cddr v))))
+          '(#t 1 2 (3)))
+    (test (let ([v #`(1 #,@(list (+ 1 1) (- 8 1)) 3)])
+            (list (pair? v)
+                  (syntax->datum (car v))
+                  (cadr v)
+                  (caddr v)
+                  (syntax->datum (cdddr v))))
+          '(#t 1 2 7 (3)))
+    (test (syntax-case '(1 2 3) ()
+            [(x ...) #`(x ...)])
+          '(1 2 3))
+
+    (test (unwrap
+           #`(1 2 (unsyntax 3 4 5) 6))
+          '(1 2 3 4 5 6))
+    (test (unwrap
+           #`(1 2 (unsyntax-splicing '(3 4) '(5)) 6))
+          '(1 2 3 4 5 6))
+
+    (test (unwrap
+           #`#(1 2 (unsyntax-splicing '(3 4) '(5)) 6))
+          '#(1 2 3 4 5 6))
+    (test (unwrap
+           #`(1 #`(#,(+ 3 4) #,#,(+ 1 1))))
+          '(1 #`(#,(+ 3 4) #,2)))
+
+    (test (unwrap
+           (syntax-case #'(weird-letrec ([x 1][y 7]) x) ()
+             [(_ ([v e] ...) . b)
+              #'(let ()
+                  (define v) ...
+                  . b)]))
+          '(let () (define x) (define y) x))
+
+    (test/exn (syntax-violation #f "bad" 7) &syntax)
+    (test/exn (syntax-violation 'form "bad" 7) &syntax)
+    (test/exn (syntax-violation #f "bad" #'7) &syntax)
+    (test/exn (syntax-violation #f "bad" #'7 8) &syntax)
+    (test/exn (syntax-violation #f "bad" #'7 #'8) &syntax)
+    (test/exn (syntax-violation #f "bad" 7 #'8) &syntax)
+    (test/exn (syntax-violation 'form "bad" #'7 #'8) &syntax)
+    (test/exn (syntax-violation 'form "bad" 7 #'8) &syntax)
+    (test/exn (syntax-violation 'form "bad" #'7 8) &syntax)
+    (test/exn (syntax-violation 'form "bad" 7 8) &syntax)
+    (test/exn (syntax-violation "form" "bad" 7) &syntax)
+    (test/exn (syntax-violation "form" "bad" 7 8) &syntax)
+
+    (test (condition-message
+           (guard (v [#t v])
+                  (syntax-violation 'apple "bad" 'worm)))
+          "bad")
+    (test (condition-who
+           (guard (v [#t v])
+                  (syntax-violation 'apple "bad" 'worm)))
+          'apple)
+    (test (condition-who
+           (guard (v [#t v])
+                  (syntax-violation "apple" "bad" 'worm)))
+          "apple")
+    (test (who-condition?
+           (guard (v [#t v])
+                  (syntax-violation #f "bad" 'worm)))
+          #f)
+    (test (condition-who
+           (guard (v [#t v])
+                  (syntax-violation #f "bad" #'worm)))
+          'worm)
+    (test (syntax-violation-form
+           (guard (v [#t v])
+                  (syntax-violation 'apple "bad" '(worm))))
+          '(worm))
+    (test (syntax-violation-subform
+           (guard (v [#t v])
+                  (syntax-violation 'apple "bad" '(worm))))
+          #f)
+    (test (syntax-violation-subform
+           (guard (v [#t v])
+                  (syntax-violation 'apple "bad" '(worm) '((another)))))
+          '((another)))
+
+
+    ;;
+    ))
+
addfile ./test/r6rs/test.sls
hunk ./test/r6rs/test.sls 1
+#!r6rs
+
+(library (tests r6rs test)
+  (export test
+          test/approx
+          test/alts
+          test/exn
+          test/values
+          test/output
+          test/unspec
+          test/unspec-or-exn
+          test/unspec-flonum-or-exn
+          test/output/unspec
+          run-test
+          report-test-results)
+  (import (rnrs))
+
+  (define-record-type err
+    (fields err-c))
+
+  (define-record-type expected-exception
+    (fields))
+
+  (define-record-type multiple-results
+    (fields values))
+
+  (define-record-type approx
+    (fields value))
+
+  (define-record-type alts
+    (fields values))
+
+  (define-syntax test
+    (syntax-rules ()
+      [(_ expr expected)
+       (begin
+         ;; (write 'expr) (newline)
+         (run-test 'expr
+                   (catch-exns (lambda () expr))
+                   expected))]))
+
+   (define (catch-exns thunk)
+      (guard (c [#t (make-err c)])
+        (call-with-values thunk
+          (lambda x
+            (if (= 1 (length x))
+                (car x)
+                (make-multiple-results x))))))
+
+  (define-syntax test/approx
+    (syntax-rules ()
+      [(_ expr expected)
+       (run-test 'expr
+                 (make-approx expr)
+                 (make-approx expected))]))
+
+  (define-syntax test/alts
+    (syntax-rules ()
+      [(_ expr expected0 expected ...)
+       (run-test 'expr
+                 expr
+                 (make-alts (list expected0 expected ...)))]))
+
+  (define (good-enough? x y)
+    ;; relative error should be with 0.1%, but greater
+    ;; relative error is allowed when the expected value
+    ;; is near zero.
+    (cond ((not (number? x)) #f)
+          ((not (number? y)) #f)
+          ((or (not (real? x))
+               (not (real? y)))
+           (and (good-enough? (real-part x) (real-part	y))
+                (good-enough? (imag-part x) (imag-part	y))))
+          ((infinite? x)
+           (=	x (* 2.0 y)))
+          ((infinite? y)
+           (= (* 2.0 x) y))
+          ((nan? y)
+           (nan? x))
+          ((> (magnitude y) 1e-6)
+           (< (/ (magnitude (- x y))
+                 (magnitude y))
+              1e-3))
+          (else
+           (< (magnitude (- x y)) 1e-6))))
+
+  (define-syntax test/exn
+    (syntax-rules ()
+      [(_ expr condition)
+       (test (guard (c [((condition-predicate (record-type-descriptor condition)) c)
+                        (make-expected-exception)])
+                    expr)
+             (make-expected-exception))]))
+
+  (define-syntax test/values
+    (syntax-rules ()
+      [(_ expr val ...)
+       (run-test 'expr
+                 (catch-exns (lambda () expr))
+                 (make-multiple-results (list val ...)))]))
+
+  (define-syntax test/output
+    (syntax-rules ()
+      [(_ expr expected str)
+       (run-test 'expr
+                 (capture-output
+                  (lambda ()
+                    (run-test 'expr
+                              (guard (c [#t (make-err c)])
+                                     expr)
+                              expected)))
+                 str)]))
+
+  (define-syntax test/unspec
+    (syntax-rules ()
+      [(_ expr)
+       (test (begin expr 'unspec) 'unspec)]))
+
+  (define-syntax test/unspec-or-exn
+    (syntax-rules ()
+      [(_ expr condition)
+       (test (guard (c [((condition-predicate (record-type-descriptor condition)) c)
+                        'unspec])
+                    (begin expr 'unspec))
+             'unspec)]))
+
+  (define-syntax test/unspec-flonum-or-exn
+    (syntax-rules ()
+      [(_ expr condition)
+       (test (guard (c [((condition-predicate (record-type-descriptor condition)) c)
+                        'unspec-or-flonum])
+                    (let ([v expr])
+                      (if (flonum? v)
+                          'unspec-or-flonum
+                          (if (eq? v 'unspec-or-flonum)
+                              (list v)
+                              v))))
+             'unspec-or-flonum)]))
+
+  (define-syntax test/output/unspec
+    (syntax-rules ()
+      [(_ expr str)
+       (test/output (begin expr 'unspec) 'unspec str)]))
+
+  (define checked 0)
+  (define failures '())
+
+  (define (capture-output thunk)
+    (if (file-exists? "tmp-catch-out")
+        (delete-file "tmp-catch-out"))
+    (dynamic-wind
+        (lambda () 'nothing)
+        (lambda ()
+          (with-output-to-file "tmp-catch-out"
+            thunk)
+          (call-with-input-file "tmp-catch-out"
+            (lambda (p)
+              (get-string-n p 1024))))
+        (lambda ()
+          (if (file-exists? "tmp-catch-out")
+              (delete-file "tmp-catch-out")))))
+  
+  (define (same-result? got expected)
+    (cond
+     [(and (real? expected) (nan? expected))
+      (and (real? got) (nan? got))]
+     [(expected-exception? expected)
+      (expected-exception? got)]
+     [(approx? expected)
+      (and (approx? got)
+           (good-enough? (approx-value expected)
+                         (approx-value got)))]
+     [(multiple-results? expected)
+      (and (multiple-results? got)
+           (= (length (multiple-results-values expected))
+              (length (multiple-results-values got)))
+           (for-all same-result?
+                    (multiple-results-values expected)
+                    (multiple-results-values got)))]
+     [(alts? expected)
+      (exists (lambda (e) (same-result? got e))
+              (alts-values expected))]
+     [else (equal? got expected)]))
+    
+  (define (run-test expr got expected)
+    (set! checked (+ 1 checked))
+    (unless (same-result? got expected)
+      (set! failures
+            (cons (list expr got expected)
+                  failures))))
+
+  (define (write-result prefix v)
+    (cond
+     [(multiple-results? v)
+      (for-each (lambda (v)
+                  (write-result prefix v))
+                (multiple-results-values v))]
+     [(approx? v)
+      (display prefix)
+      (display "approximately ")
+      (write (approx-value v))]
+     [(alts? v)
+      (write-result (string-append prefix "   ")
+                    (car (alts-values v)))
+      (for-each (lambda (v)
+                  (write-result (string-append prefix "OR ")
+                                v))
+                (cdr (alts-values v)))]
+     [else
+      (display prefix)
+      (write v)]))
+
+  (define (report-test-results)
+    (if (null? failures)
+        (begin
+          (display checked)
+          (display " tests passed\n"))
+        (begin
+          (display (length failures))
+          (display " tests failed:\n\n")
+          (for-each (lambda (t)
+                      (display "Expression:\n ")
+                      (write (car t))
+                      (display "\nResult:")
+                      (write-result "\n " (cadr t))
+                      (display "\nExpected:")
+                      (write-result "\n " (caddr t))
+                      (display "\n\n"))
+                    (reverse failures))
+          (display (length failures))
+          (display " of ")
+          (display checked)
+          (display " tests failed.\n")))))
addfile ./test/r6rs/unicode.sls
hunk ./test/r6rs/unicode.sls 1
+#!r6rs
+
+(library (tests r6rs unicode)
+  (export run-unicode-tests)
+  (import (rnrs)
+          (tests r6rs test))
+
+  (define (run-unicode-tests)
+
+    (test (char-upcase #\i) #\I)
+    (test (char-downcase #\i) #\i)
+    (test (char-titlecase #\i) #\I)
+    (test (char-foldcase #\i) #\i)
+    
+    (test (char-upcase #\xDF) #\xDF)
+    (test (char-downcase #\xDF) #\xDF)
+    (test (char-titlecase #\xDF) #\xDF)
+    (test (char-foldcase #\xDF) #\xDF)
+    
+    (test (char-upcase #\x3A3) #\x3A3)
+    (test (char-downcase #\x3A3) #\x3C3)
+    (test (char-titlecase #\x3A3) #\x3A3)
+    (test (char-foldcase #\x3A3) #\x3C3)
+
+    (test (char-upcase #\x3C2) #\x3A3)
+    (test (char-downcase #\x3C2) #\x3C2)
+    (test (char-titlecase #\x3C2) #\x3A3)
+    (test (char-foldcase #\x3C2) #\x3C3)
+
+    (test (char-ci<? #\z #\Z) #f)
+    (test (char-ci<? #\Z #\z) #f)
+    (test (char-ci<? #\a #\Z) #t)
+    (test (char-ci<? #\Z #\a) #f)
+    (test (char-ci<=? #\z #\Z) #t)
+    (test (char-ci<=? #\Z #\z) #t)
+    (test (char-ci<=? #\a #\Z) #t)
+    (test (char-ci<=? #\Z #\a) #f)
+    (test (char-ci=? #\z #\a) #f)
+    (test (char-ci=? #\z #\Z) #t)
+    (test (char-ci=? #\x3C2 #\x3C3) #t)
+    (test (char-ci>? #\z #\Z) #f)
+    (test (char-ci>? #\Z #\z) #f)
+    (test (char-ci>? #\a #\Z) #f)
+    (test (char-ci>? #\Z #\a) #t)
+    (test (char-ci>=? #\Z #\z) #t)
+    (test (char-ci>=? #\z #\Z) #t)
+    (test (char-ci>=? #\z #\Z) #t)
+    (test (char-ci>=? #\a #\z) #f)
+
+    (test (char-alphabetic? #\a) #t)
+    (test (char-alphabetic? #\1) #f)
+    (test (char-numeric? #\1) #t)
+    (test (char-numeric? #\a) #f)
+    (test (char-whitespace? #\space) #t)
+    (test (char-whitespace? #\x00A0) #t)
+    (test (char-whitespace? #\a) #f)
+    (test (char-upper-case? #\a) #f)
+    (test (char-upper-case? #\A) #t)
+    (test (char-upper-case? #\x3A3) #t)
+    (test (char-lower-case? #\a) #t)
+    (test (char-lower-case? #\A) #f)
+    (test (char-lower-case? #\x3C3) #t)
+    (test (char-lower-case? #\x00AA) #t)
+    (test (char-title-case? #\a) #f)
+    (test (char-title-case? #\A) #f)
+    (test (char-title-case? #\I) #f)
+    (test (char-title-case? #\x01C5) #t)
+
+    (test (char-general-category #\a) 'Ll)
+    (test (char-general-category #\space) 'Zs)
+    (test (char-general-category #\x10FFFF) 'Cn)
+
+    (test (string-upcase "Hi") "HI")
+    (test (string-upcase "HI") "HI")
+    (test (string-downcase "Hi") "hi")
+    (test (string-downcase "hi") "hi")
+    (test (string-foldcase "Hi") "hi")
+    (test (string-foldcase "HI") "hi")
+    (test (string-foldcase "hi") "hi")
+
+    (test (string-upcase "Stra\xDF;e") "STRASSE")
+    (test (string-downcase "Stra\xDF;e") "stra\xDF;e")
+    (test (string-foldcase "Stra\xDF;e") "strasse")
+    (test (string-downcase "STRASSE")  "strasse")
+    
+    (test (string-downcase "\x3A3;") "\x3C3;")
+
+    (test (string-upcase "\x39E;\x391;\x39F;\x3A3;") "\x39E;\x391;\x39F;\x3A3;")
+    (test (string-downcase "\x39E;\x391;\x39F;\x3A3;") "\x3BE;\x3B1;\x3BF;\x3C2;")
+    (test (string-downcase "\x39E;\x391;\x39F;\x3A3;\x3A3;") "\x3BE;\x3B1;\x3BF;\x3C3;\x3C2;")
+    (test (string-downcase "\x39E;\x391;\x39F;\x3A3; \x3A3;") "\x3BE;\x3B1;\x3BF;\x3C2; \x3C3;")
+    (test (string-foldcase "\x39E;\x391;\x39F;\x3A3;") "\x3BE;\x3B1;\x3BF;\x3C3;")
+    (test (string-upcase "\x3BE;\x3B1;\x3BF;\x3C3;") "\x39E;\x391;\x39F;\x3A3;") 
+    (test (string-upcase "\x3BE;\x3B1;\x3BF;\x3C2;") "\x39E;\x391;\x39F;\x3A3;") 
+
+    (test (string-titlecase "kNock KNoCK") "Knock Knock")
+    (test (string-titlecase "who's there?") "Who's There?")
+    (test (string-titlecase "r6rs") "R6rs") ; this example appears to be wrong in R6RS (Sept 2007 version)
+    (test (string-titlecase "R6RS") "R6rs") ; this one, too
+
+    (test (string-downcase "A\x3A3;'x") "a\x3C3;'x") ; ' is a MidLetter
+
+    (test (string-ci<? "a" "Z") #t)
+    (test (string-ci<? "A" "z") #t)
+    (test (string-ci<? "Z" "a") #f)
+    (test (string-ci<? "z" "A") #f)
+    (test (string-ci<? "z" "Z") #f)
+    (test (string-ci<? "Z" "z") #f)
+    (test (string-ci>? "a" "Z") #f)
+    (test (string-ci>? "A" "z") #f)
+    (test (string-ci>? "Z" "a") #t)
+    (test (string-ci>? "z" "A") #t)
+    (test (string-ci>? "z" "Z") #f)
+    (test (string-ci>? "Z" "z") #f)
+    (test (string-ci=? "z" "Z") #t)
+    (test (string-ci=? "z" "a") #f)
+    (test (string-ci=? "Stra\xDF;e" "Strasse") #t)
+    (test (string-ci=? "Stra\xDF;e" "STRASSE") #t)
+    (test (string-ci=? "\x39E;\x391;\x39F;\x3A3;" "\x3BE;\x3B1;\x3BF;\x3C2;") #t)
+    (test (string-ci=? "\x39E;\x391;\x39F;\x3A3;" "\x3BE;\x3B1;\x3BF;\x3C3;") #t)
+    (test (string-ci<=? "a" "Z") #t)
+    (test (string-ci<=? "A" "z") #t)
+    (test (string-ci<=? "Z" "a") #f)
+    (test (string-ci<=? "z" "A") #f)
+    (test (string-ci<=? "z" "Z") #t)
+    (test (string-ci<=? "Z" "z") #t)
+    (test (string-ci>=? "a" "Z") #f)
+    (test (string-ci>=? "A" "z") #f)
+    (test (string-ci>=? "Z" "a") #t)
+    (test (string-ci>=? "z" "A") #t)
+    (test (string-ci>=? "z" "Z") #t)
+    (test (string-ci>=? "Z" "z") #t)
+
+    (test (string-normalize-nfd "\xE9;") "\x65;\x301;")
+    (test (string-normalize-nfc "\xE9;") "\xE9;")
+    (test (string-normalize-nfd "\x65;\x301;") "\x65;\x301;")
+    (test (string-normalize-nfc "\x65;\x301;") "\xE9;")
+
+    (test (string-normalize-nfkd "\xE9;") "\x65;\x301;")
+    (test (string-normalize-nfkc "\xE9;") "\xE9;")
+    (test (string-normalize-nfkd "\x65;\x301;") "\x65;\x301;")
+    (test (string-normalize-nfkc "\x65;\x301;") "\xE9;")
+
+    ;;
+    ))