Updating R7RS tests.

tests/r7rs-tests.scm

@@ -1,7 +1,9 @@
+;; -*- coding: utf-8 -*-
 
 (import (scheme base) (scheme char) (scheme division) (scheme lazy)
         (scheme inexact) (scheme complex) (scheme time) (scheme eval)
         (scheme file) (scheme read) (scheme write) (scheme case-lambda)
+        (scheme process-context)
         (chibi test))
 
 (test-begin "r7rs")
@@ -305,6 +307,11 @@
 ;; (string=? (symbol->string \vari{obj})
 ;;           (symbol->string \varii{obj})))
 
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; 6 Standard Procedures
+
+;; 6.1 Equivalence Predicates
+
 (test #t (eqv? 'a 'a))
 (test #f (eqv? 'a 'b))
 (test #t (eqv? 2 2))
@@ -386,6 +393,8 @@
 ;; (test \unspecified (equal? (lambda (x) x)
 ;;         (lambda (y) y)))
 
+;; 6.2 Numbers
+
 (test #t (complex? 3+4i))
 (test #t (complex? 3))
 (test #t (real? 3))
@@ -410,15 +419,72 @@
 
 (test #t (finite? 3))
 (test #f (finite? +inf.0))
-;; (test #f (finite? 3.0+inf.0i))
+(test #f (finite? 3.0+inf.0i))
+
+(test #f (infinite? 3))
+(test #t (infinite? +inf.0))
+(test #f (infinite? +nan.0))
+(test #t (infinite? 3.0+inf.0i))
 
 (test #t (nan? +nan.0))
 (test #f (nan? 32))
 ;; (test #t (nan? +nan.0+5.0i))
 (test #f (nan? 1+2i))
 
-(test 4 (max 3 4))    ; exact
+(test #t (= 1 1.0 1.0+0.0i))
-(test 4.0 (max 3.9 4))  ; inexact%
+(test #f (= 1.0 1.0+1.0i))
+(test #t (< 1 2 3))
+(test #f (< 1 1 2))
+(test #t (> 3.0 2.0 1.0))
+(test #f (> -3.0 2.0 1.0))
+(test #t (<= 1 1 2))
+(test #f (<= 1 2 1))
+(test #t (>= 2 1 1))
+(test #f (>= 1 2 1))
+
+(test #t (zero? 0))
+(test #t (zero? 0.0))
+(test #t (zero? 0.0+0.0i))
+(test #f (zero? 1))
+(test #f (zero? -1))
+
+(test #f (positive? 0))
+(test #f (positive? 0.0))
+(test #t (positive? 1))
+(test #t (positive? 1.0))
+(test #f (positive? -1))
+(test #f (positive? -1.0))
+(test #t (positive? +inf.0))
+(test #f (positive? -inf.0))
+
+(test #f (negative? 0))
+(test #f (negative? 0.0))
+(test #f (negative? 1))
+(test #f (negative? 1.0))
+(test #t (negative? -1))
+(test #t (negative? -1.0))
+(test #f (negative? +inf.0))
+(test #t (negative? -inf.0))
+
+(test #f (odd? 0))
+(test #t (odd? 1))
+(test #t (odd? -1))
+(test #f (odd? 102))
+
+(test #t (even? 0))
+(test #f (even? 1))
+(test #t (even? -2))
+(test #t (even? 102))
+
+(test 3 (max 3))
+(test 4 (max 3 4))
+(test 4.0 (max 3.9 4))
+(test 5.0 (max 5 3.9 4))
+(test +inf.0 (max 100 +inf.0))
+(test 3 (min 3))
+(test 3 (min 3 4))
+(test 3.0 (min 3 3.1))
+(test -inf.0 (min -inf.0 -100))
 
 (test 7 (+ 3 4))
 (test 3 (+ 3))
@@ -433,6 +499,7 @@
 (test 1/3 (/ 3))
 
 (test 7 (abs -7))
+(test 7 (abs 7))
 
 ;; (test \vr (\hyper{operator}/ \vri{n} \vrii{n}))
 ;; {n_r}
@@ -445,6 +512,16 @@
 ;; (= \vri{n} (+ (* \vrii{n} (\hyper{operator}-quotient \vri{n} \vrii{n}))
 ;;            (\hyper{operator}-remainder \vri{n} \vrii{n}))))
 
+(test-values (values 2 1) (floor/ 5 2))
+(test-values (values -3 1) (floor/ -5 2))
+(test-values (values -3 -1) (floor/ 5 -2))
+(test-values (values 2 -1) (floor/ -5 -2))
+(test-values (values 2 1) (truncate/ 5 2))
+(test-values (values -2 -1) (truncate/ -5 2))
+(test-values (values -2 1) (truncate/ 5 -2))
+(test-values (values 2 -1) (truncate/ -5 -2))
+(test-values (values 2.0 -1.0) (truncate/ -5.0 -2))
+
 (test 1 (modulo 13 4))
 (test 1 (remainder 13 4))
 
@@ -487,31 +564,55 @@
   (exact .3) 1/10))    ; exact
 ;; (test #i1/3 (rationalize .3 1/10))  ; inexact%
 
+(test 0.0 (atan 0.0 1.0))
+(test -0.0 (atan -0.0 1.0))
+(test 0.785398163397448 (atan 1.0 1.0))
+(test 1.5707963267949 (atan 1.0 0.0))
+(test 2.35619449019234 (atan 1.0 -1.0))
+(test 3.14159265358979 (atan 0.0 -1.0))
+(test -3.14159265358979 (atan -0.0 -1.0)) ;
+(test -2.35619449019234 (atan -1.0 -1.0))
+(test -1.5707963267949 (atan -1.0 0.0))
+(test -0.785398163397448 (atan -1.0 1.0))
+;;(test undefined (atan 0.0 0.0))
+
+(test 1764 (square 42))
+(test 4.0 (square 2))
+
+(test +i (sqrt -1))
+
 (test '(2 0) (call-with-values (lambda () (exact-integer-sqrt 4)) list))
 (test '(2 1) (call-with-values (lambda () (exact-integer-sqrt 5)) list))
 
-;; (test \vr (make-rectangular \vri{x} \vrii{x}))
+(test 27 (expt 3 3))
-;; {z}
+(test 1 (expt 0 0))
-;; (test \vr (make-polar \vriii{x} \vriv{x}))
+(test 0 (expt 0 1))
-;; {z}
+(test 1.0 (expt 0.0 0))
-;; (test \vri (real-part \vr{z}))
+(test 0.0 (expt 0 1.0))
-;; {x}
+
-;; (test \vrii (imag-part \vr{z}))
+(test 1+2i (make-rectangular 1 2))
-;; {x}
+
-;; (test $ (magnitude \vr{z}))
+(test 0.54030230586814+0.841470984807897i (make-polar 1 1))
-;; $
+
-;; (test $x_ (angle \vr{z}))
+(test 1 (real-part 1+2i))
-;; (let ((number \vr{number})
+
-;;       (radix \vr{radix}))
+(test 2 (imag-part 1+2i))
-;;   (eqv? number
+
-;;         (string->number (number->string number
+(test 2.23606797749979 (magnitude 1+2i))
-;;                                         radix)
+
-;;                         radix)))
+(test 1.10714871779409 (angle 1+2i))
+
+(test 1.0 (inexact 1))
+(test #t (inexact? (inexact 1)))
+(test 1 (exact 1.0))
+(test #t (exact? (exact 1.0)))
 
 (test 100 (string->number "100"))
 (test 256 (string->number "100" 16))
 (test 100.0 (string->number "1e2"))
 
+;; 6.3 Booleans
+
 (test #t #t)
 (test #f #f)
 (test #f '#f)
@@ -527,16 +628,23 @@
 (test #t (boolean? #f))
 (test #f (boolean? 0))
 (test #f (boolean? '()))
-;; (define y x)
+
-;; (test '(a b c) y)
+(test #t (boolean=? #t #t))
-;; (test #t (list? y))
+(test #t (boolean=? #f #f))
-;; (test \unspecified (set-cdr! x 4))
+(test #f (boolean=? #t #f))
-;; (test '(a . 4) x)
+
-;; (test #t (eqv? x y))
+;; 6.4 Lists
-;; (test '(a . 4) y)
+
-;; (test #f (list? y))
+(let* ((x (list 'a 'b 'c))
-;; (test \unspecified (set-cdr! x x))
+       (y x))
-;; (test #f (list? x))
+  (test '(a b c) (values y))
+  (test #t (list? y))
+  (set-cdr! x 4)
+  (test '(a . 4) (values x))
+  (test #t (eqv? x y))
+  (test #f (list? y))
+  (set-cdr! x x)
+  (test #f (list? x)))
 
 (test #t (pair? '(a . b)))
 (test #t (pair? '(a b c)))
@@ -585,6 +693,8 @@
 (test '(c b a) (reverse '(a b c)))
 (test '((e (f)) d (b c) a) (reverse '(a (b c) d (e (f)))))
 
+(test '(d e) (list-tail '(a b c d e) 3))
+
 (test 'c (list-ref '(a b c d) 2))
 (test 'c (list-ref '(a b c d)
           (exact (round 1.8))))
@@ -622,6 +732,10 @@
 (test '(5 7)    
 (assv 5 '((2 3) (5 7) (11 13))))
 
+(test '(1 2 3) (list-copy '(1 2 3)))
+
+;; 6.5 Symbols
+
 (test #t (symbol? 'foo))
 (test #t (symbol? (car '(a b))))
 (test #f (symbol? "bar"))
@@ -629,6 +743,9 @@
 (test #f (symbol? '()))
 (test #f (symbol? #f))
 
+(test #t (symbol=? 'a 'a))
+(test #f (symbol=? 'a 'A))
+
 (test "flying-fish"     
 (symbol->string 'flying-fish))
 (test "Martin" (symbol->string 'Martin))
@@ -636,26 +753,239 @@
 
 (test 'mISSISSIppi (string->symbol "mISSISSIppi"))
 (test #t (eq? 'bitBlt (string->symbol "bitBlt")))
-(test #t (eq? 'JollyWog (string->symbol (symbol->string 'JollyWog))))
+(test #t (eq? 'LollyPop (string->symbol (symbol->string 'LollyPop))))
 (test #t (string=? "K. Harper, M.D."
                    (symbol->string (string->symbol "K. Harper, M.D."))))
 
-;; (test 3 (digit-value #\backwhack{}3))
+;; 6.6 Characters
-;; (test 4 (digit-value #\backwhack{}x0664))
+
-;; (test 0 (digit-value #\backwhack{}x0EA6))
+(test #t (char? #\a))
-;; (define (g) "***")
+(test #f (char? "a"))
-;; (test \unspecified (string-set! (f) 0 #\backwhack{}?))
+(test #f (char? 'a))
-;; (test \scherror (string-set! (g) 0 #\backwhack{}?))
+(test #f (char? 0))
-;; (test \scherror (string-set! (symbol->string 'immutable)
+
-;;              0
+(test #t (char=? #\a #\a))
-;;              #\backwhack{}?))
+(test #f (char=? #\a #\A))
+(test #t (char<? #\a #\b))
+(test #f (char<? #\a #\a))
+(test #f (char<? #\b #\a))
+(test #f (char>? #\a #\b))
+(test #f (char>? #\a #\a))
+(test #t (char>? #\b #\a))
+(test #t (char<=? #\a #\b))
+(test #t (char<=? #\a #\a))
+(test #f (char<=? #\b #\a))
+(test #f (char>=? #\a #\b))
+(test #t (char>=? #\a #\a))
+(test #t (char>=? #\b #\a))
+
+(test #t (char-ci=? #\a #\a))
+(test #t (char-ci=? #\a #\A))
+(test #f (char-ci=? #\a #\b))
+(test #t (char-ci<? #\a #\B))
+(test #f (char-ci<? #\A #\a))
+(test #f (char-ci<? #\b #\A))
+(test #f (char-ci>? #\A #\b))
+(test #f (char-ci>? #\a #\A))
+(test #t (char-ci>? #\B #\a))
+(test #t (char-ci<=? #\a #\B))
+(test #t (char-ci<=? #\A #\a))
+(test #f (char-ci<=? #\b #\A))
+(test #f (char-ci>=? #\A #\b))
+(test #t (char-ci>=? #\a #\A))
+(test #t (char-ci>=? #\B #\a))
+
+(test #t (char-alphabetic? #\a))
+(test #f (char-alphabetic? #\space))
+(test #t (char-numeric? #\0))
+(test #f (char-numeric? #\.))
+(test #f (char-numeric? #\a))
+(test #t (char-whitespace? #\space))
+(test #t (char-whitespace? #\tab))
+(test #t (char-whitespace? #\newline))
+(test #f (char-whitespace? #\_))
+(test #f (char-whitespace? #\a))
+(test #t (char-upper-case? #\A))
+(test #f (char-upper-case? #\a))
+(test #f (char-upper-case? #\3))
+(test #t (char-lower-case? #\a))
+(test #f (char-lower-case? #\A))
+(test #f (char-lower-case? #\3))
+
+(test 3 (digit-value #\3))
+;; (test 4 (digit-value #\x0664))
+;; (test 0 (digit-value #\x0EA6))
+
+(test 97 (char->integer #\a))
+(test #\a (integer->char 97))
+
+(test #\A (char-upcase #\a))
+(test #\A (char-upcase #\A))
+(test #\a (char-downcase #\a))
+(test #\a (char-downcase #\A))
+(test #\a (char-foldcase #\a))
+(test #\a (char-foldcase #\A))
+
+(test #\Λ (char-upcase #\λ))
+(test #\Λ (char-upcase #\Λ))
+(test #\λ (char-downcase #\λ))
+(test #\λ (char-downcase #\Λ))
+(test #\λ (char-foldcase #\λ))
+(test #\λ (char-foldcase #\Λ))
+
+;; 6.7 Strings
+
+(test #t (string? ""))
+(test #t (string? " "))
+(test #f (string? 'a))
+(test #f (string? #\a))
+
+(test 3 (string-length (make-string 3)))
+(test "---" (make-string 3 #\-))
+
+(test "" (string))
+(test "---" (string #\- #\- #\-))
+(test "kitten" (string #\k #\i #\t #\t #\e #\n))
+
+(test 0 (string-length ""))
+(test 1 (string-length "a"))
+(test 3 (string-length "abc"))
+
+(test #\a (string-ref "abc" 0))
+(test #\b (string-ref "abc" 1))
+(test #\c (string-ref "abc" 2))
+
+(test "a-c" (let ((str (string #\a #\b #\c))) (string-set! str 1 #\-) str))
+
+(test #t (string=? "" ""))
+(test #t (string=? "abc" "abc"))
+(test #f (string=? "" "abc"))
+(test #f (string=? "abc" "aBc"))
+
+(test #f (string<? "" ""))
+(test #f (string<? "abc" "abc"))
+(test #t (string<? "abc" "abcd"))
+(test #f (string<? "abcd" "abc"))
+(test #t (string<? "abc" "bbc"))
+
+(test #f (string>? "" ""))
+(test #f (string>? "abc" "abc"))
+(test #f (string>? "abc" "abcd"))
+(test #t (string>? "abcd" "abc"))
+(test #f (string>? "abc" "bbc"))
+
+(test #t (string<=? "" ""))
+(test #t (string<=? "abc" "abc"))
+(test #t (string<=? "abc" "abcd"))
+(test #f (string<=? "abcd" "abc"))
+(test #t (string<=? "abc" "bbc"))
+
+(test #t (string>=? "" ""))
+(test #t (string>=? "abc" "abc"))
+(test #f (string>=? "abc" "abcd"))
+(test #t (string>=? "abcd" "abc"))
+(test #f (string>=? "abc" "bbc"))
+
+(test #t (string-ci=? "" ""))
+(test #t (string-ci=? "abc" "abc"))
+(test #f (string-ci=? "" "abc"))
+(test #t (string-ci=? "abc" "aBc"))
+(test #f (string-ci=? "abc" "aBcD"))
+
+(test #f (string-ci<? "abc" "aBc"))
+(test #t (string-ci<? "abc" "aBcD"))
+(test #f (string-ci<? "ABCd" "aBc"))
+
+(test #f (string-ci>? "abc" "aBc"))
+(test #f (string-ci>? "abc" "aBcD"))
+(test #t (string-ci>? "ABCd" "aBc"))
+
+(test #t (string-ci<=? "abc" "aBc"))
+(test #t (string-ci<=? "abc" "aBcD"))
+(test #f (string-ci<=? "ABCd" "aBc"))
+
+(test #t (string-ci>=? "abc" "aBc"))
+(test #f (string-ci>=? "abc" "aBcD"))
+(test #t (string-ci>=? "ABCd" "aBc"))
+
+(test "ABC" (string-upcase "abc"))
+(test "ABC" (string-upcase "ABC"))
+(test "abc" (string-downcase "abc"))
+(test "abc" (string-downcase "ABC"))
+(test "abc" (string-foldcase "abc"))
+(test "abc" (string-foldcase "ABC"))
+
+(test "ΑΒΓ" (string-upcase "αβγ"))
+(test "ΑΒΓ" (string-upcase "ΑΒΓ"))
+(test "αβγ" (string-downcase "αβγ"))
+(test "αβγ" (string-downcase "ΑΒΓ"))
+(test "αβγ" (string-foldcase "αβγ"))
+(test "αβγ" (string-foldcase "ΑΒΓ"))
+
+(test "" (substring "" 0 0))
+(test "" (substring "a" 0 0))
+(test "" (substring "abc" 1 1))
+(test "ab" (substring "abc" 0 2))
+(test "bc" (substring "abc" 1 3))
+
+(test "" (string-append ""))
+(test "" (string-append "" ""))
+(test "abc" (string-append "" "abc"))
+(test "abc" (string-append "abc" ""))
+(test "abcde" (string-append "abc" "de"))
+(test "abcdef" (string-append "abc" "de" "f"))
+
+(test '() (string->list ""))
+(test '(#\a) (string->list "a"))
+(test '(#\a #\b #\c) (string->list "abc"))
+(test '(#\a #\b #\c) (string->list "abc" 0))
+(test '(#\b #\c) (string->list "abc" 1))
+(test '(#\b #\c) (string->list "abc" 1 3))
+
+(test "" (list->string '()))
+(test "abc" (list->string '(#\a #\b #\c)))
+
+(test "" (string-copy ""))
+(test "" (string-copy "" 0))
+(test "" (string-copy "" 0 0))
+(test "abc" (string-copy "abc"))
+(test "abc" (string-copy "abc" 0))
+(test "bc" (string-copy "abc" 1))
+(test "b" (string-copy "abc" 1 2))
+(test "bc" (string-copy "abc" 1 3))
+
+(test "-----"
+    (let ((str (make-string 5 #\x))) (string-fill! str #\-) str))
+(test "xx---"
+    (let ((str (make-string 5 #\x))) (string-fill! str #\- 2) str))
+(test "xx-xx"
+    (let ((str (make-string 5 #\x))) (string-fill! str #\- 2 3) str))
+
+(test "a12de"
+    (let ((str (string-copy "abcde"))) (string-copy! str 1 "12345" 0 2) str))
+(test "-----"
+    (let ((str (make-string 5 #\x))) (string-copy! str 0 "-----") str))
+(test "---xx"
+    (let ((str (make-string 5 #\x))) (string-copy! str 0 "-----" 2) str))
+(test "xx---"
+    (let ((str (make-string 5 #\x))) (string-copy! str 2 "-----") str))
+(test "xx-xx"
+    (let ((str (make-string 5 #\x))) (string-copy! str 2 "-----" 2 3) str))
+
+;; 6.8 Vectors
+
+(test #t (vector? #()))
+(test #t (vector? #(1 2 3)))
+(test #t (vector? '#(1 2 3)))
+
+(test 0 (vector-length (make-vector 0)))
+(test 1000 (vector-length (make-vector 1000)))
 
 (test #(0 (2 2 2 2) "Anna") '#(0 (2 2 2 2) "Anna"))
 
 (test #(a b c) (vector 'a 'b 'c))
 
-(test 8 (vector-ref '#(1 1 2 3 5 8 13 21)
+(test 8 (vector-ref '#(1 1 2 3 5 8 13 21) 5))
-            5))
 (test 13 (vector-ref '#(1 1 2 3 5 8 13 21)
             (let ((i (round (* 2 (acos -1)))))
               (if (inexact? i)
@@ -666,18 +996,115 @@
   (vector-set! vec 1 '("Sue" "Sue"))
   vec))
 
-;; (test \scherror (vector-set! '#(0 1 2) 1 "doe"))  ; constant vector%
+(test-error (vector-set! '#(0 1 2) 1 "doe"))  ; constant vector%
 
 (test '(dah dah didah) (vector->list '#(dah dah didah)))
+(test '(dah didah) (vector->list '#(dah dah didah) 1))
+(test '(dah) (vector->list '#(dah dah didah) 1 2))
 (test #(dididit dah) (list->vector '(dididit dah)))
 
-;; (test #(#\backwhack{}A #\backwhack{}B #\backwhack{}C) (string->vector "ABC"))
+(test #() (string->vector ""))
-;; vector->string
+(test #(#\A #\B #\C) (string->vector "ABC"))
-;;   (test "123" #(#\backwhack{}1 #\backwhack{}2 #\backwhack{}3))
+(test #(#\B #\C) (string->vector "ABC" 1))
+(test #(#\B) (string->vector "ABC" 1 2))
+
+(test "" (vector->string #()))
+(test "123" (vector->string #(#\1 #\2 #\3)))
+(test "23" (vector->string #(#\1 #\2 #\3) 1))
+(test "2" (vector->string #(#\1 #\2 #\3) 1 2))
+
+(test #() (vector-copy #()))
+(test #(a b c) (vector-copy #(a b c)))
+(test #(b c) (vector-copy #(a b c) 1))
+(test #(b) (vector-copy #(a b c) 1 2))
+
+(test #() (vector-append #()))
+(test #() (vector-append #() #()))
+(test #(a b c) (vector-append #() #(a b c)))
+(test #(a b c) (vector-append #(a b c) #()))
+(test #(a b c d e) (vector-append #(a b c) #(d e)))
+(test #(a b c d e f) (vector-append #(a b c) #(d e) #(f)))
+
+(test #(1 2 smash smash 5)
+    (let ((vec (vector 1 2 3 4 5))) (vector-fill! vec 'smash 2 4) vec))
+(test #(x x x x x)
+    (let ((vec (vector 1 2 3 4 5))) (vector-fill! vec 'x) vec))
+(test #(1 2 x x x)
+    (let ((vec (vector 1 2 3 4 5))) (vector-fill! vec 'x 2) vec))
+(test #(1 2 x 4 5)
+    (let ((vec (vector 1 2 3 4 5))) (vector-fill! vec 'x 2 3) vec))
+
+(test #(1 a b 4 5)
+    (let ((vec (vector 1 2 3 4 5))) (vector-copy! vec 1 #(a b c d e) 0 2) vec))
+(test #(a b c d e)
+    (let ((vec (vector 1 2 3 4 5))) (vector-copy! vec 0 #(a b c d e)) vec))
+(test #(c d e 4 5)
+    (let ((vec (vector 1 2 3 4 5))) (vector-copy! vec 0 #(a b c d e) 2) vec))
+(test #(1 2 a b c)
+    (let ((vec (vector 1 2 3 4 5))) (vector-copy! vec 2 #(a b c d e)) vec))
+(test #(1 2 c 4 5)
+    (let ((vec (vector 1 2 3 4 5))) (vector-copy! vec 2 #(a b c d e) 2 3) vec))
+
+;; 6.9 Bytevectors
+
+(test #t (bytevector? #u8()))
+(test #t (bytevector? #u8(0 1 2)))
+(test #f (bytevector? #()))
+(test #f (bytevector? #(0 1 2)))
+(test #f (bytevector? '()))
+(test #t (bytevector? (make-bytevector 0)))
+
+(test 0 (bytevector-length (make-bytevector 0)))
+(test 1024 (bytevector-length (make-bytevector 1024)))
+(test 1024 (bytevector-length (make-bytevector 1024 255)))
+
+(test 3 (bytevector-length (bytevector 0 1 2)))
+
+(test 0 (bytevector-u8-ref (bytevector 0 1 2) 0))
+(test 1 (bytevector-u8-ref (bytevector 0 1 2) 1))
+(test 2 (bytevector-u8-ref (bytevector 0 1 2) 2))
+
+(test #u8(0 255 2)
+    (let ((bv (bytevector 0 1 2))) (bytevector-u8-set! bv 1 255) bv))
+
+(test #u8() (bytevector-copy #u8()))
+(test #u8(0 1 2) (bytevector-copy #u8(0 1 2)))
+(test #u8(1 2) (bytevector-copy #u8(0 1 2) 1))
+(test #u8(1) (bytevector-copy #u8(0 1 2) 1 2))
+
+(test #u8(1 6 7 4 5)
+    (let ((bv (bytevector 1 2 3 4 5)))
+      (bytevector-copy! bv 1 #u8(6 7 8 9 10) 0 2)
+      bv))
+(test #u8(6 7 8 9 10)
+    (let ((bv (bytevector 1 2 3 4 5)))
+      (bytevector-copy! bv 0 #u8(6 7 8 9 10))
+      bv))
+(test #u8(8 9 10 4 5)
+    (let ((bv (bytevector 1 2 3 4 5)))
+      (bytevector-copy! bv 0 #u8(6 7 8 9 10) 2)
+      bv))
+(test #u8(1 2 6 7 8)
+    (let ((bv (bytevector 1 2 3 4 5)))
+      (bytevector-copy! bv 2 #u8(6 7 8 9 10))
+      bv))
+(test #u8(1 2 8 4 5)
+    (let ((bv (bytevector 1 2 3 4 5)))
+      (bytevector-copy! bv 2 #u8(6 7 8 9 10) 2 3)
+      bv))
+
+(test #u8() (bytevector-append #u8()))
+(test #u8() (bytevector-append #u8() #u8()))
+(test #u8(0 1 2) (bytevector-append #u8() #u8(0 1 2)))
+(test #u8(0 1 2) (bytevector-append #u8(0 1 2) #u8()))
+(test #u8(0 1 2 3 4) (bytevector-append #u8(0 1 2) #u8(3 4)))
+(test #u8(0 1 2 3 4 5) (bytevector-append #u8(0 1 2) #u8(3 4) #u8(5)))
 
 (test "A" (utf8->string #u8(#x41)))
 (test #u8(#xCE #xBB) (string->utf8 "λ"))
 
+;; 6.10 Control Features
+
 (test #t (procedure? car))
 (test #f (procedure? 'car))
 (test #t (procedure? (lambda (x) (* x x))))
@@ -685,11 +1112,11 @@
 (test #t (call-with-current-continuation procedure?))
 
 (test 7 (apply + (list 3 4)))
+
 (define compose
   (lambda (f g)
     (lambda args
       (f (apply g args)))))
-
 (test 30 ((compose sqrt *) 12 75))
 
 (test '(b e h) (map cadr '((a b) (d e) (g h))))
@@ -699,11 +1126,12 @@
 
 (test '(5 7 9) (map + '(1 2 3) '(4 5 6 7)))
 
-(test '(1 2) (let ((count 0))
+(test '(1 2) ; or '(2 1)
-  (map (lambda (ignored)
+    (let ((count 0))
-         (set! count (+ count 1))
+      (map (lambda (ignored)
-         count)
+             (set! count (+ count 1))
-       '(a b))))
+             count)
+           '(a b))))
 
 (test "abdegh" (string-map char-foldcase "AbdEgH"))
 
@@ -778,39 +1206,199 @@
 ;;     (lambda (cont) (apply cont things))))
 
 (test 5
-(call-with-values (lambda () (values 4 5))
+    (call-with-values (lambda () (values 4 5))
-                  (lambda (a b) b)))
+      (lambda (a b) b)))
 
 (test -1 (call-with-values * -))
 
 (test '(connect talk1 disconnect
-               connect talk2 disconnect)
+        connect talk2 disconnect)
-(let ((path '())
+    (let ((path '())
-      (c #f))
+          (c #f))
-  (let ((add (lambda (s)
+      (let ((add (lambda (s)
-               (set! path (cons s path)))))
+                   (set! path (cons s path)))))
-    (dynamic-wind
+        (dynamic-wind
-      (lambda () (add 'connect))
+          (lambda () (add 'connect))
-      (lambda ()
+          (lambda ()
-        (add (call-with-current-continuation
+            (add (call-with-current-continuation
-               (lambda (c0)
+                  (lambda (c0)
-                 (set! c c0)
+                    (set! c c0)
-                 'talk1))))
+                    'talk1))))
-      (lambda () (add 'disconnect)))
+          (lambda () (add 'disconnect)))
-    (if (< (length path) 4)
+        (if (< (length path) 4)
-        (c 'talk2)
+            (c 'talk2)
-        (reverse path)))))
+            (reverse path)))))
 
-(test 21 (eval '(* 7 3) (scheme-report-environment 7)))
+;; 6.11 Exceptions
+
+(test 65
+    (with-exception-handler
+     (lambda (con) 42)
+     (lambda ()
+       (+ (raise-continuable "should be a number")
+          23))))
+
+(test #t
+    (error-object? (guard (exn (else exn)) (error "BOOM!" 1 2 3))))
+(test "BOOM!"
+    (error-object-message (guard (exn (else exn)) (error "BOOM!" 1 2 3))))
+(test '(1 2 3)
+    (error-object-irritants (guard (exn (else exn)) (error "BOOM!" 1 2 3))))
+
+(test #f
+    (file-error? (guard (exn (else exn)) (error "BOOM!"))))
+(test #t
+    (file-error? (guard (exn (else exn)) (open-input-file " no such file "))))
+
+(test #f
+    (read-error? (guard (exn (else exn)) (error "BOOM!"))))
+(test #t
+    (read-error? (guard (exn (else exn)) (read (open-input-string ")")))))
+
+;; 6.12 Environments and evaluation
+
+(test 21 (eval '(* 7 3) (scheme-report-environment 5)))
 
 (test 20
-(let ((f (eval '(lambda (f x) (f x x))
+    (let ((f (eval '(lambda (f x) (f x x)) (null-environment 5))))
-               (null-environment 7))))
+      (f + 10)))
-  (f + 10)))
+
+;; 6.13 Input and output
+
+(test #t (port? (current-input-port)))
+(test #t (input-port? (current-input-port)))
+(test #t (output-port? (current-output-port)))
+(test #t (output-port? (current-error-port)))
+(test #t (input-port? (open-input-string "abc")))
+(test #t (output-port? (open-output-string)))
+
+(test #t (textual-port? (open-input-string "abc")))
+(test #t (textual-port? (open-output-string)))
+(test #t (binary-port? (open-input-bytevector #u8(0 1 2))))
+(test #t (binary-port? (open-output-bytevector)))
+
+(test #t (input-port-open? (open-input-string "abc")))
+(test #t (output-port-open? (open-output-string)))
+
+(test #f
+    (let ((in (open-input-string "abc")))
+      (close-input-port in)
+      (input-port-open? in)))
+
+(test #f
+    (let ((out (open-output-string)))
+      (close-output-port out)
+      (output-port-open? out)))
+
+(test #f
+    (let ((out (open-output-string)))
+      (close-port out)
+      (output-port-open? out)))
+
+(test #t (eof-object? (read (open-input-string ""))))
+(test 42 (read (open-input-string " 42 ")))
+
+(test #t (eof-object? (read-char (open-input-string ""))))
+(test #\a (read-char (open-input-string "abc")))
+
+(test #t (eof-object? (read-line (open-input-string ""))))
+(test "abc" (read-line (open-input-string "abc")))
+(test "abc" (read-line (open-input-string "abc\ndef\n")))
+
+(test #t (eof-object? (read-string 3 (open-input-string ""))))
+(test "abc" (read-string 3 (open-input-string "abcd")))
+(test "abc" (read-string 3 (open-input-string "abc\ndef\n")))
+
+(test "abc"
+    (let ((out (open-output-string)))
+      (write 'abc out)
+      (get-output-string out)))
+
+(test #t (eof-object? (read-u8 (open-input-bytevector #u8()))))
+(test 1 (read-u8 (open-input-bytevector #u8(1 2 3))))
+
+(test #t (eof-object? (read-bytevector 3 (open-input-bytevector #u8()))))
+(test #u8(1) (read-bytevector 3 (open-input-bytevector #u8(1))))
+(test #u8(1 2) (read-bytevector 3 (open-input-bytevector #u8(1 2))))
+(test #u8(1 2 3) (read-bytevector 3 (open-input-bytevector #u8(1 2 3))))
+(test #u8(1 2 3) (read-bytevector 3 (open-input-bytevector #u8(1 2 3 4))))
+
+(test #u8(6 7 8 9 10)
+  (let ((bv (bytevector 1 2 3 4 5)))
+    (read-bytevector! bv 0 5 (open-input-bytevector #u8(6 7 8 9 10)))
+    bv))
+
+(test #u8(6 7 8 4 5)
+  (let ((bv (bytevector 1 2 3 4 5)))
+    (read-bytevector! bv 0 3 (open-input-bytevector #u8(6 7 8 9 10)))
+    bv))
+
+(test #u8(1 2 3 6 5)
+  (let ((bv (bytevector 1 2 3 4 5)))
+    (read-bytevector! bv 3 4 (open-input-bytevector #u8(6 7 8 9 10)))
+    bv))
+
+(test #u8(1 2 3)
+  (let ((out (open-output-bytevector)))
+    (write-u8 1 out)
+    (write-u8 2 out)
+    (write-u8 3 out)
+    (get-output-bytevector out)))
+
+(test #t (read (open-input-string "#t")))
+(test #t (read (open-input-string "#true")))
+(test #f (read (open-input-string "#f")))
+(test #f (read (open-input-string "#false")))
+
+(test '() (read (open-input-string "()")))
+(test '(1 2) (read (open-input-string "(1 2)")))
+(test '(1 . 2) (read (open-input-string "(1 . 2)")))
+(test '(1 2) (read (open-input-string "(1 . (2))")))
+(test '(1 2 3 4 5) (read (open-input-string "(1 . (2 3 4 . (5)))")))
+
+(test 'abc (read (open-input-string "abc")))
+(test 'abc (read (open-input-string "abc def")))
+(test 'ABC (read (open-input-string "ABC")))
+(test 'Hello (read (open-input-string "|H\\x65;llo|")))
+
+(test #\a (read (open-input-string "#\\a")))
+(test #\space (read (open-input-string "#\\space")))
+(test #\alarm (read (open-input-string "#\\alarm")))
+(test #\λ (read (open-input-string "#\\x03BB")))
+
+(test "abc" (read (open-input-string "\"abc\"")))
+(test "abc" (read (open-input-string "\"abc\" \"def\"")))
+(test "ABC" (read (open-input-string "\"ABC\"")))
+(test "Hello" (read (open-input-string "\"H\\x65;llo\"")))
+(test "line 1\nline 2\n" (read (open-input-string "\"line 1\nline 2\n\"")))
+
+;; 6.14 System interface
 
 ;; (test "/usr/local/bin:/usr/bin:/bin" (get-environment-variable "PATH"))
 
+(test #t (string? (get-environment-variable "PATH")))
+
 ;; (test '(("USER" . "root") ("HOME" . "/")) (get-environment-variables))
+
+(let ((env (get-environment-variables)))
+  (define (env-pair? x)
+    (and (pair? x) (string? (car x)) (string? (cdr x))))
+  (define (all? pred ls)
+    (or (null? ls) (and (pred (car ls)) (all? pred (cdr ls)))))
+  (test #t (list? env))
+  (test #t (all? env-pair? env)))
+
+(test #t (list? (command-line)))
+
+(test #t (real? (current-second)))
+(test #t (inexact? (current-second)))
+(test #t (exact? (current-jiffy)))
+(test #t (exact? (jiffies-per-second)))
+
+(test #t (list? (features)))
+
+;; Definitions
+
 (define add3
   (lambda (x) (+ x 3)))
 (test 6 (add3 3))
@@ -835,6 +1423,9 @@
          (set! b tmp)))))
   (swap! x y)
   (list x y)))
+
+;; Records
+
 (define-record-type <pare>
   (kons x y)
   pare?