S9fES core test suite

Location: util, 2901 Lines

; Scheme 9 from Empty Space Test Suite
; By Nils M Holm, 2007-2018
; In the public domain

(define *Verbose* #f)

(define testfile "test.tmp")

(if (file-exists? testfile)
    (delete-file testfile))

(define Errors 0)

(define (void) (if #f #f))

(define (seq)
  (let ((n 0))
    (lambda ()
      (set! n (+ 1 n))
      n)))

(define (fail expr result expected)
  (display "test failed: ")
  (write expr)
  (newline)
  (display "got result:  ")
  (write result)
  (newline)
  (display "expected:    ")
  (write expected)
  (newline)
  (set! Errors (+ 1 Errors)))

(define (test3 expr result expected)
  (cond (*Verbose*
          (write expr)
          (display " => ")
          (write result)
          (newline)))
  (if (not (equal? result expected))
      (fail expr result expected)))

(define-syntax (test form expected)
  `(test3 ',form ,form ,expected))

;;; Comments

;  This is a comment

#| This is a block comment |#

#| Nested #| block |# comment |#

#| Nested
   #| multi-line |#
   block comment |#

#|#|#||#|# nonsense |#

#| #|#||#|# more nonsense #|## |||#|#

;;; Syntax

; Objects

(test 'x 'x)
(test 'mississippi 'mississippi)
(test 'MIssissiPPi 'mississippi)
(test '!$%&*+-./^_ '!$%&*+-./^_)

; Booleans

(test #t #t)
(test #f #f)

; Chars

(test #\x #\x)
(test #\C #\C)
(test #\( #\()
(test #\) #\))
(test #\; #\;)
(test #\space #\space)
(test #\newline #\newline)

; Strings

(test "test" "test")
(test "TeSt" "TeSt")
(test "TEST" "TEST")
(test "hello, world!" "hello, world!")
(test "\"hello, world!\"" "\"hello, world!\"")
(test "a\\/b" "a\\/b")
(test "(((;)))" "(((;)))")

; Pairs / Lists

(test '() '())
(test '(a b c) '(a b c))
(test '(a (b) c) '(a (b) c))
(test '(((((x))))) '(((((x))))))
(test '((caar . cdar) . (cadr . cddr)) '((caar . cdar) . (cadr . cddr)))
(test '[] '())
(test '[a b c] '(a b c))
(test '(a [b] c) '(a (b) c))
(test '[a (b) c] '(a (b) c))
(test '[a [b] c] '(a (b) c))
(test '(((((x))))) '(((((x))))))
(test '([([(x)])]) '(((((x))))))
(test '[([([x])])] '(((((x))))))
(test '[[[[[x]]]]] '(((((x))))))
(test '([caar . cdar] . [cadr . cddr]) '((caar . cdar) . (cadr . cddr)))

; Vectors

(test '#() '#())
(test '#(a b c) '#(a b c))
(test '#(a (b) c) '#(a (b) c))
(test '#(((((x))))) '#(((((x))))))
(test '#((caar cadar) (caadr  cadadr)) '#((caar cadar) (caadr  cadadr)))
(test '#(#(a b c) #(d e f)) '#(#(a b c) #(d e f)))
(test '#(#(#(#(#(x))))) '#(#(#(#(#(x))))))

; Integers

(test 0 0)
(test 1 1)
(test 1234567 1234567)
(test -0 0)
(test -1 -1)
(test -1234567 -1234567)
(test 123456789012345678901234567890 123456789012345678901234567890)
(test -123456789012345678901234567890 -123456789012345678901234567890)

(test #b10101010100101010101   698709)
(test #b+10101010100101010101 +698709)
(test #b-10101010100101010101 -698709)
(test #d1234567890987654321   1234567890987654321)
(test #d+1234567890987654321 +1234567890987654321)
(test #d-1234567890987654321 -1234567890987654321)
(test #o123456707654321   5744369817809)
(test #o+123456707654321 +5744369817809)
(test #o-123456707654321 -5744369817809)
(test #x123456789abcdef0fedcba98765432   94522879700260683132212139638805554)
(test #x+123456789abcdef0fedcba98765432 +94522879700260683132212139638805554)
(test #x-123456789abcdef0fedcba98765432 -94522879700260683132212139638805554)

; Real Numbers

(test 0.0 0.0)
(test -0.0 -0.0)
(test 1.0 1.0)
(test -1.0 -1.0)
(test 12345.0 12345.0)
(test -12345.0 -12345.0)
(test 1.2345 1.2345)
(test -1.2345 -1.2345)
(test 0.12345 0.12345)
(test -0.12345 -0.12345)
(test -0.00012345 -0.00012345)
(test 0.1 0.1)
(test 0.01 0.01)
(test 0.001 0.001)
(test 0.0000000000001 0.0000000000001)
(test 1e0 1.0)
(test 1e-0 1.0)
(test 1e1 10.0)
(test 1e2 100.0)
(test 1e5 100000.0)
(test 1e10 10000000000.0)
(test 1e-1 0.1)
(test 1e-2 0.01)
(test 1e-5 0.00001)
(test 1e-10 0.0000000001)
(test 123.456e0 123.456)
(test 123.456e1 1234.56)
(test 123.456e2 12345.6)
(test 123.456e3 123456.0)
(test 123.456e4 1234560.0)
(test 123.456e5 12345600.0)
(test 123.456e10 1234560000000.0)
(test -123.456e0 -123.456)
(test -123.456e1 -1234.56)
(test -123.456e2 -12345.6)
(test -123.456e3 -123456.0)
(test -123.456e4 -1234560.0)
(test -123.456e5 -12345600.0)
(test -123.456e10 -1234560000000.0)
(test 123.456e-1 12.3456)
(test 123.456e-2 1.23456)
(test 123.456e-3 0.123456)
(test 123.456e-4 0.0123456)
(test 123.456e-5 0.00123456)
(test 123.456e-10 0.0000000123456)
(test -123.456e-1 -12.3456)
(test -123.456e-2 -1.23456)
(test -123.456e-3 -0.123456)
(test -123.456e-4 -0.0123456)
(test -123.456e-5 -0.00123456)
(test -123.456e-10 -0.0000000123456)
(test +123.45e+678 123.45e678)
(test -123.45e+678 -123.45e678)
(test +123.45e-678 123.45e-678)
(test -123.45e-678 -123.45e-678)
(test 1. 1.0)
(test .1 0.1)
(test 1.e1 10.0)
(test .1e1 1.0)
(test 1000e0 1e3)
(test 100e1 1e3)
(test 10e2 1e3)
(test 1e3 1e3)
(test .1e4 1e3)
(test .01e5 1e3)
(test .001e6 1e3)
(test 12345678.901D10 1.2345678901e+17)
(test 12345678.901E10 1.2345678901e+17)
(test 12345678.901F10 1.2345678901e+17)
(test 12345678.901L10 1.2345678901e+17)
(test 12345678.901S10 1.2345678901e+17)

;;; Syntax

; and

(test (and) #t)
(test (and #f) #f)
(test (and #f #f) #f)
(test (and #f #t) #f)
(test (and #t #f) #f)
(test (and #t #t) #t)
(test (and 1 2 3) 3)
(test (and #f 2 3) #f)
(test (and 1 #f 3) #f)
(test (and 1 2 #f) #f)
(test (and 'foo) 'foo)
(test (and #t) #t)
(test (and 1) 1)
(test (and #\x) #\x)
(test (and "x") "x")
(test (and '(x)) '(x))
(test (and '()) '())
(test (and '#(x)) '#(x))
(test (and (lambda (x) x) #t) #t)

; begin

(test (begin 1) 1)
(test (begin 1 "2") "2")
(test (begin 1 "2" #\3) #\3)
(test (let ((x (seq)) (y 0))
         (begin (set! y (- y (x)))
                (set! y (- y (x)))
                (set! y (- y (x))))
                y)
       -6)

; case

(test (case 'a ((a b) 'first) ((c d) 'second)) 'first)
(test (case 'b ((a b) 'first) ((c d) 'second)) 'first)
(test (case 'c ((a b) 'first) ((c d) 'second)) 'second)
(test (case 'd ((a b) 'first) ((c d) 'second)) 'second)
(test (case 'x ((a b) 'first) ((c d) 'second)) (void))
(test (case 'x ((a b) 'first) (else 'default)) 'default)
(test (case 'd ((a) 'a) ((b) 'b) ((c) 'c) (else 'default)) 'default)
(test (case 'c ((a) 'a) ((b) 'b) ((c) 'c) (else 'default)) 'c)
(test (case 'b ((a) 'a) ((b) 'b) ((c) 'c) (else 'default)) 'b)
(test (case 'a ((a) 'a) ((b) 'b) ((c) 'c) (else 'default)) 'a)
(test (case 'x ((a) 'a) ((b) 'b) ((c) 'c) (else 'default)) 'default)
(test (case 'x ((b) 'b) ((c) 'c) (else 'default)) 'default)
(test (case 'x ((c) 'c) (else 'default)) 'default)
(test (case 'x (else 'default)) 'default)
(test (case 1 ((1) #t)) #t)
(test (case #\c ((#\c) #t)) #t)
(test (case 'x (else 1 2 3)) 3)
(test (case 'x ((y) #f)) (void))

; cond

(test (cond) (void))
(test (cond (#t 1)) 1)
(test (cond (1 1)) 1)
(test (cond ('x 1)) 1)
(test (cond (#\x 1)) 1)
(test (cond ("x" 1)) 1)
(test (cond ('(a b c) 1)) 1)
(test (cond ('() 1)) 1)
(test (cond (#(1 2 3) 1)) 1)
(test (cond (#f 1)) (void))
(test (cond (#f 1) (#t 2)) 2)
(test (cond (#f 1) (else 2)) 2)
(test (cond (else 2)) 2)
(test (cond (#t 1 2 3)) 3)
(test (cond (else 1 2 3)) 3)
(test (cond (#f (#f))) (void))
(test (cond (#f)) (void))
(test (cond (#f) (#t)) #t)
(test (cond (1 => list)) '(1))
(test (cond (#f => list) (#t => list)) '(#t))
(test (cond (1)) 1)
(test (cond ('foo)) 'foo)
(test (cond ('())) '())
(test (cond ('(()))) '(()))

; define

(define x 'foo)
(test (let () (define x 1) x) 1)
(test ((lambda () (define x 0) x)) 0)
(test (begin ((lambda () (define x 0) x)) x) 'foo)
(test (begin (let () (define x 0) x) x) 'foo)
(test (begin (let () (define x 0) x)) 0)
(test (let () (letrec () (define x 0) x) x) 'foo)
(test (let () (letrec () (define x 0) x)) 0)
(test (let () (define (f) 1) (f)) 1)
(test (let () (define (f x) x) (f 1)) 1)
(test (let () (define (f x y) x) (f 1 2)) 1)
(test (let () (define (f x y) y) (f 1 2)) 2)
(test (let () (define (f . x) x) (f)) '())
(test (let () (define (f . x) x) (f 1)) '(1))
(test (let () (define (f . x) x) (f 1 2)) '(1 2))
(test (let () (define (f x . y) y) (f 1 2)) '(2))
(test (let () (define f (lambda () 1)) (f)) 1)
(test (let () (define f (lambda (x) x)) (f 1)) 1)
(test (let () (define f (lambda (x y) x)) (f 1 2)) 1)
(test (let () (define f (lambda (x y) y)) (f 1 2)) 2)
(test (let () (define f (lambda x x)) (f)) '())
(test (let () (define f (lambda x x)) (f 1)) '(1))
(test (let () (define f (lambda x x)) (f 1 2)) '(1 2))
(test (let () (define f (lambda (x . y) y)) (f 1 2)) '(2))
(test ((lambda ()
          (define (e x) (or (zero? x) (o (- x 1))))
          (define (o x) (if (zero? x) #f (e (- x 1))))
          (list (o 5) (e 5))))
      '(#t #f))

; do

(test (do () (#t 123)) 123)
(test (do ((i 1 (+ 1 i))) ((= i 10) i) i) 10)
(test (do ((i 1 (+ 1 i)) (j 17)) ((= i 10) j) i) 17)
(test (do ((i 1 (+ 1 i)) (j 2 (+ 2 j))) ((= i 10) j) i) 20)
(test (do ((i 1 (+ 1 i)) (j 2 (+ 2 j))) ((= i 10) (* i j)) i) 200)
(test (let ((j 1)) (do ((i 0 (+ 1 i))) ((= i 10) j) (set! j (+ j 3)))) 31)
(test (do ((i 1 (+ 1 i)) (j 0)) ((= i 10) j) (set! j 1)) 1)
(test (do ((i 1 (+ 1 i)) (j 0)) ((= i 10) j) 1 2 3 (set! j 1)) 1)

; if

(test (if #f #f) (void))
(test (if #t 1) 1)
(test (if 1 1) 1)
(test (if 'a 1) 1)
(test (if #\a 1) 1)
(test (if "a" 1) 1)
(test (if '(1 2 3) 1) 1)
(test (if '() 1) 1)
(test (if '#(1 2 3) 1) 1)
(test (if #t 1 2) 1)
(test (if #f 1 2) 2)
(test (if #f (#f)) (void))

; if*

(test (if* #t 'else) #t)
(test (if* #f 'else) 'else)
(test (if* 1 2) 1)
(test (if* 'a 2) 'a)
(test (if* #\a 2) #\a)
(test (if* "a" 2) "a")
(test (if* '(1 2 3) 2) '(1 2 3))
(test (if* '() 2) '())
(test (if* '#(1 2 3) 2) '#(1 2 3))
(test (if* #t (#f)) #t) 

; lambda

(test ((lambda () '())) '())
(test ((lambda (x) x) 1) 1)
(test ((lambda (x y z) (list x y z)) 1 2 3) '(1 2 3))

(test (((lambda (x) (lambda (y) (cons x y))) 1) 2) '(1 . 2))

(test ((lambda (a . b) a) 'foo) 'foo)
(test ((lambda (a . b) b) 'foo) '())
(test ((lambda (a . b) b) 'foo 'bar) '(bar))
(test ((lambda (a . b) b) 'foo 'bar 'baz) '(bar baz))

(test ((lambda (a b . c) a) 'foo 'bar) 'foo)
(test ((lambda (a b . c) b) 'foo 'bar) 'bar)
(test ((lambda (a b . c) c) 'foo 'bar) '())
(test ((lambda (a b . c) c) 'foo 'bar 'baz) '(baz))

(test ((lambda a a)) '())
(test ((lambda a a) 'foo) '(foo))
(test ((lambda a a) 'foo 'bar) '(foo bar))
(test ((lambda a a) 'foo 'bar 'baz) '(foo bar baz))

(test ((lambda (x) ((lambda () x))) 1) 1)

(test ((lambda () 1 2 3)) 3)

(test ((lambda (x) ((lambda () (set! x 1))) x) 0) 1)

; regression tests

(define x 1)

(define (g) x)

(define (f0)
  (let ((x 0))
    (set! x (g))
    x))

(define (f1)
  (let ((x 0))
    (let ()
      (set! x (g))
      x)))

(test (f0) 1)
(test (f1) 1)

(define (f2)
  (let ((x 2))
    (let ((r (g)))
      r)))

(test (f2) 1)

(test ((lambda (x)
         ((lambda (x) x)
          (car x)))
       (quote (0)))
      0)

; let

(test (let () 1) 1)
(test (let () 1 2 3) 3)
(test (let ((x 1)) x) 1)
(test (let ((x 1) (y 2) (z 3)) (list x y z)) '(1 2 3))

(test (let ((x 0))
         (let ((x 1)
               (y (* x 1)))
           y))
       0)
(test (let ((x 0))
         (let ((x 1))
           (let ((y (* x 1)))
             y)))
       1)

(test (let ((x 'lexical))
        (let ((f (lambda () x)))
          (let ((x 'dynamic))
            (f))))
      'lexical)

; letrec

(test (letrec () 1) 1)
(test (letrec () 1 2 3) 3)
(test (letrec ((x 1)) x) 1)
(test (letrec ((x 1) (y 2) (z 3)) (list x y z)) '(1 2 3))

(test (letrec
         ((even-p
            (lambda (x)
              (or (null? x) (odd-p (cdr x)))))
          (odd-p
            (lambda (x)
              (if (null? x) #f (even-p (cdr x))))))
          (list (odd-p '(i i i i i))
                (even-p '(i i i i i))))
      '(#t #f))

; let*

(test (let* () 1) 1)
(test (let* () 1 2 3) 3)
(test (let* ((x 'first)) x) 'first)
(test (let* ((x 'first) (y 'second) (z 'third)) (list x y z))
      '(first second third))
(test (let* ((x 0))
         (let* ((x 1)
                (y (* x 5)))
           y))
       5)
(test (let* ((x 3)
             (y (cons 2 x))
             (z (cons 1 y)))
         z)
      '(1 2 . 3))
(test (let* ((x 3)
             (x (cons 2 x))
             (x (cons 1 x)))
         x)
      '(1 2 . 3))

; or

(test (or) #f)
(test (or #f) #f)
(test (or #f #f) #f)
(test (or #f #t) #t)
(test (or #t #f) #t)
(test (or #t #t) #t)
(test (or 1 2 3) 1)
(test (or #f 2 3) 2)
(test (or 1 #f 3) 1)
(test (or #f #f 3) 3)
(test (or 'foo) 'foo)
(test (or #t) #t)
(test (or 1) 1)
(test (or #\x) #\x)
(test (or "x") "x")
(test (or '(x)) '(x))
(test (or '()) '())
(test (or '#(x)) '#(x))

; quote

(test (quote foo) 'foo)
(test (quote quote) 'quote)
(test (quote #t) #t)
(test (quote 1) 1)
(test (quote #\X) #\X)
(test (quote "abc") "abc")
(test (quote ()) '())
(test (quote (1 2 3)) '(1 2 3))
(test (quote #(1 2 3)) '#(1 2 3))
(test (quote (lambda (x) x)) '(lambda (x) x))
(test '1 '1)
(test ''1 ''1)
(test '''1 '''1)
(test '#f #f)
(test '1 1)
(test '#\b #\b)
(test '"abc" "abc")

;;; Mutation

(define x 0)
(test (begin (set! x 1) x) 1)
(test (begin ((lambda (x) (set! x 0)) 'void) x) 1)
(test (begin (let ((x 'void)) (set! x 0)) x) 1)
(test (begin (let* ((x 'void)) (set! x 0)) x) 1)
(test (begin (letrec ((x 'void)) (set! x 0)) x) 1)
(test (begin (set! x 2) x) 2)

(test ((lambda (f)
         ((lambda (x)
            (set! f x)
            (f '(1 2 3 4 5)))
          (lambda (x)
            (if (null? x)
                'done
                (f (cdr x))))))
       #f)
      'done)

(define p (cons 1 2))
(test (begin (set-car! p 'a) p) '(a . 2))
(test (begin (set-cdr! p 'b) p) '(a . b))

;;; Type Predicates

(test (boolean? #f) #t)
(test (boolean? #\c) #f)
(test (boolean? 1) #f)
(test (boolean? 1.1) #f)
(test (boolean? '(pair)) #f)
(test (boolean? (lambda () #f)) #f)
(test (boolean? (catch (lambda (ct) ct))) #f)
(test (boolean? "string") #f)
(test (boolean? 'symbol) #f)
(test (boolean? '#(vector)) #f)
(test (boolean? (current-input-port)) #f)
(test (boolean? (current-output-port)) #f)

(test (catch-tag? #f) #f)
(test (catch-tag? #\c) #f)
(test (catch-tag? 1) #f)
(test (catch-tag? 1.1) #f)
(test (catch-tag? '(pair)) #f)
(test (catch-tag? (lambda () #f)) #f)
(test (catch-tag? (catch (lambda (ct) ct))) #t)
(test (catch-tag? "string") #f)
(test (catch-tag? 'symbol) #f)
(test (catch-tag? '#(vector)) #f)
(test (catch-tag? (current-input-port)) #f)
(test (catch-tag? (current-output-port)) #f)

(test (char? #f) #f)
(test (char? #\c) #t)
(test (char? 1) #f)
(test (char? 1.1) #f)
(test (char? '(pair)) #f)
(test (char? (lambda () #f)) #f)
(test (char? (catch (lambda (ct) ct))) #f)
(test (char? "string") #f)
(test (char? 'symbol) #f)
(test (char? '#(vector)) #f)
(test (char? (current-input-port)) #f)
(test (char? (current-output-port)) #f)

(test (input-port? #f) #f)
(test (input-port? #\c) #f)
(test (input-port? 1) #f)
(test (input-port? 1.1) #f)
(test (input-port? '(pair)) #f)
(test (input-port? (lambda () #f)) #f)
(test (input-port? (catch (lambda (ct) ct))) #f)
(test (input-port? "string") #f)
(test (input-port? 'symbol) #f)
(test (input-port? '#(vector)) #f)
(test (input-port? (current-input-port)) #t)

(test (integer? #f) #f)
(test (integer? #\c) #f)
(test (integer? 1) #t)
(test (integer? 1.0) #t)
(test (integer? 1.1) #f)
(test (integer? '(pair)) #f)
(test (integer? (lambda () #f)) #f)
(test (integer? (catch (lambda (ct) ct))) #f)
(test (integer? "string") #f)
(test (integer? 'symbol) #f)
(test (integer? '#(vector)) #f)
(test (integer? (current-input-port)) #f)
(test (integer? (current-output-port)) #f)

(test (number? #f) #f)
(test (number? #\c) #f)
(test (number? 1) #t)
(test (number? 1.1) #t)
(test (number? '(pair)) #f)
(test (number? (lambda () #f)) #f)
(test (number? (catch (lambda (ct) ct))) #f)
(test (number? "string") #f)
(test (number? 'symbol) #f)
(test (number? '#(vector)) #f)
(test (number? (current-input-port)) #f)
(test (number? (current-output-port)) #f)

(test (output-port? #f) #f)
(test (output-port? #\c) #f)
(test (output-port? 1) #f)
(test (output-port? 1.1) #f)
(test (output-port? '(pair)) #f)
(test (output-port? (lambda () #f)) #f)
(test (output-port? (catch (lambda (ct) ct))) #f)
(test (output-port? "string") #f)
(test (output-port? 'symbol) #f)
(test (output-port? '#(vector)) #f)
(test (output-port? (current-output-port)) #t)

(test (pair? #f) #f)
(test (pair? #\c) #f)
(test (pair? 1) #f)
(test (pair? 1.1) #f)
(test (pair? '(pair)) #t)
(test (pair? (lambda () #f)) #f)
(test (pair? (catch (lambda (ct) ct))) #f)
(test (pair? "string") #f)
(test (pair? 'symbol) #f)
(test (pair? '#(vector)) #f)
(test (pair? (current-input-port)) #f)
(test (pair? (current-output-port)) #f)

(test (procedure? #f) #f)
(test (procedure? #\c) #f)
(test (procedure? 1) #f)
(test (procedure? 1.1) #f)
(test (procedure? '(procedure)) #f)
(test (procedure? (lambda () #f)) #t)
(test (procedure? (catch (lambda (ct) ct))) #f)
(test (procedure? "string") #f)
(test (procedure? 'symbol) #f)
(test (procedure? '#(vector)) #f)
(test (procedure? (current-input-port)) #f)
(test (procedure? (current-output-port)) #f)

(test (real? #f) #f)
(test (real? #\c) #f)
(test (real? 1) #t)
(test (real? 1.1) #t)
(test (real? '(pair)) #f)
(test (real? (lambda () #f)) #f)
(test (real? (catch (lambda (ct) ct))) #f)
(test (real? "string") #f)
(test (real? 'symbol) #f)
(test (real? '#(vector)) #f)
(test (real? (current-input-port)) #f)
(test (real? (current-output-port)) #f)

(test (string? #f) #f)
(test (string? #\c) #f)
(test (string? 1) #f)
(test (string? 1.1) #f)
(test (string? '(pair)) #f)
(test (string? (lambda () #f)) #f)
(test (string? (catch (lambda (ct) ct))) #f)
(test (string? "string") #t)
(test (string? 'symbol) #f)
(test (string? '#(vector)) #f)
(test (string? (current-input-port)) #f)
(test (string? (current-output-port)) #f)

(test (symbol? #f) #f)
(test (symbol? #\c) #f)
(test (symbol? 1) #f)
(test (symbol? 1.1) #f)
(test (symbol? '(pair)) #f)
(test (symbol? (lambda () #f)) #f)
(test (symbol? (catch (lambda (ct) ct))) #f)
(test (symbol? "string") #f)
(test (symbol? 'symbol) #t)
(test (symbol? '#(vector)) #f)
(test (symbol? (current-input-port)) #f)
(test (symbol? (current-output-port)) #f)

(test (vector? #f) #f)
(test (vector? #\c) #f)
(test (vector? 1) #f)
(test (vector? 1.1) #f)
(test (vector? '(pair)) #f)
(test (vector? (lambda () #f)) #f)
(test (vector? (catch (lambda (ct) ct))) #f)
(test (vector? "string") #f)
(test (vector? 'symbol) #f)
(test (vector? '#(vector)) #t)
(test (vector? (current-input-port)) #f)
(test (vector? (current-output-port)) #f)

;;; Conversion Procedures

(test (char->integer #\A) 65)
(test (char->integer #\z) 122)
(test (char->integer #\newline) 10)
(test (char->integer #\space) 32)

(test (integer->char 65) #\A)
(test (integer->char 122) #\z)
(test (integer->char 10) #\newline)
(test (integer->char 32) #\space)

(test (list->string '(#\S #\t #\r #\i #\n #\g)) "String")
(test (list->string '()) "")

(test (list->vector '(#t foo 1 #\c "s" (1 2 3) #(u v)))
      '#(#t foo 1 #\c "s" (1 2 3) #(u v)))
(test (list->vector '()) '#())

(test (string->list "String") '(#\S #\t #\r #\i #\n #\g))
(test (string->list "") '())

(test (string->symbol "foo") 'foo)
(test (string->symbol "string->symbol") 'string->symbol)

(test (symbol->string 'foo) "foo")
(test (symbol->string 'symbol->string) "symbol->string")
(test (symbol->string (string->symbol "miSSissiPPi")) "miSSissiPPi")

(test (eq? (string->symbol "foo") 'foo) #t)

(test (vector->list '#(#t foo 1 #\c "s" (1 2 3) #(u v)))
      '(#t foo 1 #\c "s" (1 2 3) #(u v)))
(test (vector->list '#()) '())

;;; Apply

(test (apply (lambda () 1) '()) 1)
(test (apply car '((a . b))) 'a)
(test (apply cdr '((a . b))) 'b)
(test (apply cons '(1 2)) '(1 . 2))
(test (apply list '(1 2 3)) '(1 2 3))
(test (apply list 1 '(2 3)) '(1 2 3))
(test (apply list 1 2 '(3)) '(1 2 3))
(test (apply list 1 2 3 '()) '(1 2 3))

;;; Call-with-current-continuation

(test (call/cc (lambda (k) 'foo)) 'foo)

(test (cons 'foo (call/cc (lambda (k) (k 'bar)))) '(foo . bar))

(test (cons 'foo (call/cc (lambda (k) (cons 'zzz (k 'bar)))))
      '(foo . bar))

(test (letrec ((x (call/cc (lambda (k) (cons 'a k)))))
        (let ((v (car x))
              (k (cdr x)))
          (cond ((eq? v 'a) (k (cons 'b k)))
                ((eq? v 'b) (k (cons 'c k)))
                ((eq? v 'c) 'foo)
                (else  #f))))
      'foo)

(define (ctak x y z)
  (define (ctak-aux k x y z)
    (if (not (< y x))
        (k z)
        (call-with-current-continuation
          (lambda (k)
            (ctak-aux
              k
              (call-with-current-continuation
                (lambda (k) (ctak-aux k (- x 1) y z)))
              (call-with-current-continuation
                (lambda (k) (ctak-aux k (- y 1) z x)))
              (call-with-current-continuation
                (lambda (k) (ctak-aux k (- z 1) x y))))))))
  (call-with-current-continuation
    (lambda (k) (ctak-aux k x y z))))

(test (ctak 6 4 2) 3)

; Following CALL/CC tests by Al* Petrofsky

(test (letrec ((x (call/cc (lambda (x) x))))
        (if (procedure? x)
            (x 'foo)
            x))
      'foo)

(test ((lambda (x)
         (if (pair? x)
             ((car x) (lambda () x))
             (pair? (x))))
       (call/cc list))
      #t)

(test (letrec ((x (call/cc list))
               (y (call/cc list)))
        (cond ((procedure? x) (x (pair? y)))
              ((procedure? y) (y (pair? x)))
              ((call/cc (car x)) (call/cc (car y)))
              (else #f)))
      #t)

(test (letrec ((x (call/cc (lambda (c) (list #t c)))))
        (if (car x)
            ((cadr x) (list #f (lambda () x)))
            (eq? x ((cadr x)))))
      #t)

;;; Mapping and iteration

(test (let ((a (list (list 'a) (list 'b) (list 'c))))
         (for-each (lambda (x) (set-car! x 'x)) a)
         a)
      '((x) (x) (x)))
(test (let ((a (list (list 'a) (list 'b) (list 'c))))
         (for-each (lambda (x y) (set-car! x y)) a '(x y z))
         a)
      '((x) (y) (z)))

(test (map - '(1 2 3)) '(-1 -2 -3))
(test (map cons '(1 2 3) '(a b c))
      '((1 . a) (2 . b) (3 . c)))
(test (map list '(1 2 3) '(a b c) '(#\x #\y #\z))
      '((1 a #\x) (2 b #\y) (3 c #\z)))

;;; Promises

(define s (seq))
(begin (s) (void))
(define x (delay (s)))
(test (list (force x) (force x) (force x)) '(2 2 2))

;;; Quasiquotation

(define x 'foo)
(test `x 'x)
(test `,x 'foo)
(test `(1 2 3) '(1 2 3))
(test `(y ,x z) '(y foo z))
(test `(1 2 3 ,(list 4 5)) '(1 2 3 (4 5)))
(test `(1 2 3 ,@(list 4 5)) '(1 2 3 4 5))
(test `#(y ,x z) '#(y foo z))
(test `#(1 2 3 ,(list 4 5)) '#(1 2 3 (4 5)))
(test `#(1 2 3 ,@(list 4 5)) '#(1 2 3 4 5))
(test `(a b c (,x y z)) '(a b c (foo y z)))
(test `(a b c (,x ,@(list 'y 'z))) '(a b c (foo y z)))
(test `(+ 1 ,(* 2 `,(* 3 4))) '(+ 1 24))
(test `(+ 1 (car '(,@(memv 2 `,(list 1 (+ 1 1) 3))))) '(+ 1 (car '(2 3))))

; Lists and Pairs

(test (append '() '(a b c)) '(a b c))
(test (append '(a b c) '()) '(a b c))
(test (append '() '()) '())
(test (append) '())
(test (append '(a b)) '(a b))
(test (append '(a b) '(c d)) '(a b c d))
(test (append '(a b) '(c d) '(e f)) '(a b c d e f))
(test (append '(a b) 'c) '(a b . c))
(test (append '(a) 'b) '(a . b))
(test (append 'a) 'a)

(test (assoc 'c '((a . a) (b . b))) #f)
(test (assoc 'b '((a . a) (b . b))) '(b . b))
(test (assoc 'a '((a . a) (b . b))) '(a . a))
(test (assoc 'x '()) #f)
(test (assoc '(x) '(((x) . x))) '((x) . x))
(test (assoc "x" '(("x" . x))) '("x" . x))
(test (assoc 1 '((1 . x))) '(1 . x))
(test (assoc #\x '((#\x . x))) '(#\x . x))

(test (assv 'c '((a . a) (b . b))) #f)
(test (assv 'b '((a . a) (b . b))) '(b . b))
(test (assv 'a '((a . a) (b . b))) '(a . a))
(test (assv 'x '()) #f)
(test (assv 1 '((1 . x))) '(1 . x))
(test (assv #\x '((#\x . x))) '(#\x . x))

(test (assq 'c '((a . a) (b . b))) #f)
(test (assq 'b '((a . a) (b . b))) '(b . b))
(test (assq 'a '((a . a) (b . b))) '(a . a))
(test (assq 'x '()) #f)

(define tree '((((1 . 2) . (3 . 4)) . ((5 . 6) . (7 . 8)))
              .
              (((9 . 10) . (11 . 12)) . ((13 . 14) . (15 . 16)))))
(test (caar tree) '((1 . 2) . (3 . 4)))
(test (cadr tree) '((9 . 10) . (11 . 12)))
(test (cdar tree) '((5 . 6) . (7 . 8)))
(test (cddr tree) '((13 . 14) . (15 . 16)))
(test (caaar tree) '(1 . 2))
(test (caadr tree) '(9 . 10))
(test (cadar tree) '(5 . 6))
(test (caddr tree) '(13 . 14))
(test (cdaar tree) '(3 . 4))
(test (cdadr tree) '(11 . 12))
(test (cddar tree) '(7 . 8))
(test (cdddr tree) '(15 . 16))
(test (caaaar tree) 1)
(test (caaadr tree) 9)
(test (caadar tree) 5)
(test (caaddr tree) 13)
(test (cadaar tree) 3)
(test (cadadr tree) 11)
(test (caddar tree) 7)
(test (cadddr tree) 15)
(test (cdaaar tree) 2)
(test (cdaadr tree) 10)
(test (cdadar tree) 6)
(test (cdaddr tree) 14)
(test (cddaar tree) 4)
(test (cddadr tree) 12)
(test (cdddar tree) 8)
(test (cddddr tree) 16)

(test (car '(1 1)) 1)
(test (car '(1 . 2)) 1)
(test (cdr '(1 2)) '(2))
(test (cdr '(1 . 2)) 2)
(test (cons 1 2) '(1 . 2))
(test (cons 1 '(2)) '(1 2))
(test (cons 1 (cons 2 '())) '(1 2))

(test (length '()) 0)
(test (length '(1)) 1)
(test (length '(1 2 3)) 3)

(test (list) '())
(test (list '()) '(()))
(test (list 'x) '(x))
(test (list (list 'x)) '((x)))
(test (list 'a 'b) '(a b))
(test (list 'a 'b 'c) '(a b c))
(test (list 'a 'b 'c 'd) '(a b c d))
(test (list 'a 'b 'c 'd 'e) '(a b c d e))

(test (list-ref '(1 2 3) 0) 1)
(test (list-ref '(1 2 3) 1) 2)
(test (list-ref '(1 2 3) 2) 3)

(test (list-tail '(1 2 3) 0) '(1 2 3))
(test (list-tail '(1 2 3) 1) '(2 3))
(test (list-tail '(1 2 3) 2) '(3))
(test (list-tail '(1 2 3) 3) '())

(test (list? #f) #f)
(test (list? #\c) #f)
(test (list? 1) #f)
(test (list? '(pair)) #t)
(test (list? (lambda () #f)) #f)
(test (list? "string") #f)
(test (list? 'symbol) #f)
(test (list? '#(vector)) #f)
(test (list? (current-input-port)) #f)
(test (list? (current-output-port)) #f)
(test (list? '()) #t)
(test (list? '(1)) #t)
(test (list? '(1 . ())) #t)
(test (list? '(1 2 3)) #t)
(test (list? '(1 . 2)) #f)
(test (list? '(1 2 . 3)) #f)
(let ((cyclic2 (list 1 2))
      (cyclic3 (list 1 2 3)))
  (set-cdr! (cdr cyclic2) cyclic2)
  (set-cdr! (cddr cyclic3) cyclic3)
  (if (list? cyclic2)
      (fail '(list? cyclic2) #t)
      (test (list? 'cyclic2) #f))
  (if (list? cyclic3)
      (fail '(list? cyclic3) #t)
      (test (list? 'cyclic3) #f)))

(test (member 'c '(a b)) #f)
(test (member 'b '(a b)) '(b))
(test (member 'a '(a b)) '(a b))
(test (member 'x '()) #f)
(test (member '(x) '((x))) '((x)))
(test (member "x" '("x")) '("x"))
(test (member 1 '(1)) '(1))
(test (member #\x '(#\x)) '(#\x))

(test (memv 'c '(a b)) #f)
(test (memv 'b '(a b)) '(b))
(test (memv 'a '(a b)) '(a b))
(test (memv 'x '()) #f)
(test (memv 1 '(1)) '(1))
(test (memv #\x '(#\x)) '(#\x))

(test (memq 'c '(a b)) #f)
(test (memq 'b '(a b)) '(b))
(test (memq 'a '(a b)) '(a b))
(test (memq 'x '()) #f)

(test (null? #f) #f)
(test (null? #\c) #f)
(test (null? 1) #f)
(test (null? '(pair)) #f)
(test (null? (lambda () #f)) #f)
(test (null? "string") #f)
(test (null? 'symbol) #f)
(test (null? '#(vector)) #f)
(test (null? (current-input-port)) #f)
(test (null? (current-output-port)) #f)
(test (null? '()) #t)

(test (reverse '(1)) '(1))
(test (reverse '(1 2 3)) '(3 2 1))
(test (reverse '()) '())

; Integer Arithmetics

(test (+  1234567890  9876543210)  11111111100)
(test (+  1234567890 -9876543210)  -8641975320)
(test (+ -1234567890  9876543210)   8641975320)
(test (+ -1234567890 -9876543210) -11111111100)
(test (+  9876543210  1234567890)  11111111100)
(test (+  9876543210 -1234567890)   8641975320)
(test (+ -9876543210  1234567890)  -8641975320)
(test (+ -9876543210 -1234567890) -11111111100)
(test (+ 1234567890 0) 1234567890)
(test (+ 0 1234567890) 1234567890)
(test (+ 1 2 3 4 5 6 7 8 9 10) 55)
(test (+ 1) 1)
(test (+) 0)

(test (-  1234567890  9876543210)  -8641975320)
(test (-  1234567890 -9876543210)  11111111100)
(test (- -1234567890  9876543210) -11111111100)
(test (- -1234567890 -9876543210)   8641975320)
(test (-  9876543210  1234567890)   8641975320)
(test (-  9876543210 -1234567890)  11111111100)
(test (- -9876543210  1234567890) -11111111100)
(test (- -9876543210 -1234567890)  -8641975320)
(test (- 1234567890 0) 1234567890)
(test (- 0 1234567890) -1234567890)
(test (- 1 2 3 4 5 6 7 8 9 10) -53)
(test (- 1234567890) -1234567890)
(test (- 0) 0)

(test (*  1234567  7654321)  9449772114007)
(test (*  1234567 -7654321) -9449772114007)
(test (* -1234567  7654321) -9449772114007)
(test (* -1234567 -7654321)  9449772114007)
(test (*  7654321  1234567)  9449772114007)
(test (*  7654321 -1234567) -9449772114007)
(test (* -7654321  1234567) -9449772114007)
(test (* -7654321 -1234567)  9449772114007)
(test (* 1234567 1) 1234567)
(test (* 1 1234567) 1234567)
(test (* 1234567 0) 0)
(test (* 0 1234567) 0)
(test (* 1 2 3 4 5 6 7 8 9 10) 3628800)
(test (* 1 2 3 4 5 6 7 8 9) 362880)
(test (* 2) 2)
(test (*) 1)

(test (<  1234567890  9876543210) #t)
(test (<  1234567890 -9876543210) #f)
(test (< -1234567890  9876543210) #t)
(test (< -1234567890 -9876543210) #f)
(test (<  9876543210  1234567890) #f)
(test (<  9876543210 -1234567890) #f)
(test (< -9876543210  1234567890) #t)
(test (< -9876543210 -1234567890) #t)
(test (< -1234567890 -1234567890) #f)
(test (<  1234567890  1234567890) #f)
(test (< 1234567890 0) #f)
(test (< 0 1234567890) #t)
(test (< 1 2 3 4 5 6 7 8 9 10) #t)
(test (< 1 2 3 4 5 6 7 8 9 9) #f)

(test (<=  1234567890  9876543210) #t)
(test (<=  1234567890 -9876543210) #f)
(test (<= -1234567890  9876543210) #t)
(test (<= -1234567890 -9876543210) #f)
(test (<=  9876543210  1234567890) #f)
(test (<=  9876543210 -1234567890) #f)
(test (<= -9876543210  1234567890) #t)
(test (<= -9876543210 -1234567890) #t)
(test (<= -1234567890 -1234567890) #t)
(test (<=  1234567890  1234567890) #t)
(test (<= 1234567890 0) #f)
(test (<= 0 1234567890) #t)
(test (<= 1 2 3 4 5 6 7 8 9 10) #t)
(test (<= 1 2 3 4 5 6 7 8 9 9) #t)

(test (=  1234567890  9876543210) #f)
(test (=  1234567890 -9876543210) #f)
(test (= -1234567890  9876543210) #f)
(test (= -1234567890 -9876543210) #f)
(test (=  9876543210  1234567890) #f)
(test (=  9876543210 -1234567890) #f)
(test (= -9876543210  1234567890) #f)
(test (= -9876543210 -1234567890) #f)
(test (= -1234567890  1234567890) #f)
(test (=  1234567890 -1234567890) #f)
(test (=  1234567890  1234567890) #t)
(test (= -1234567890 -1234567890) #t)
(test (= 0 0) #t)
(test (= 0 1234567890) #f)
(test (= 1234567890 0) #f)
(test (= 1 1 1 1 1 1 1 1 1 1) #t)
(test (= 1 1 1 1 1 1 1 1 1 0) #f)

(test (>  1234567890  9876543210) #f)
(test (>  1234567890 -9876543210) #t)
(test (> -1234567890  9876543210) #f)
(test (> -1234567890 -9876543210) #t)
(test (>  9876543210  1234567890) #t)
(test (>  9876543210 -1234567890) #t)
(test (> -9876543210  1234567890) #f)
(test (> -9876543210 -1234567890) #f)
(test (> -1234567890 -1234567890) #f)
(test (>  1234567890  1234567890) #f)
(test (> 1234567890 0) #t)
(test (> 0 1234567890) #f)
(test (> 9 8 7 6 5 4 3 2 1 0) #t)
(test (> 9 8 7 6 5 4 3 2 1 1) #f)

(test (>=  1234567890  9876543210) #f)
(test (>=  1234567890 -9876543210) #t)
(test (>= -1234567890  9876543210) #f)
(test (>= -1234567890 -9876543210) #t)
(test (>=  9876543210  1234567890) #t)
(test (>=  9876543210 -1234567890) #t)
(test (>= -9876543210  1234567890) #f)
(test (>= -9876543210 -1234567890) #f)
(test (>= -1234567890 -1234567890) #t)
(test (>=  1234567890  1234567890) #t)
(test (>= 1234567890 0) #t)
(test (>= 0 1234567890) #f)
(test (>= 9 8 7 6 5 4 3 2 1 0) #t)
(test (>= 9 8 7 6 5 4 3 2 1 1) #t)

(test (abs 1234567890) 1234567890)
(test (abs -1234567890) 1234567890)
(test (abs 0) 0)

(test (even? -1) #f)
(test (even? 0) #t)
(test (even? 1) #f)
(test (even? 2) #t)
(test (even? 1234567890) #t)
(test (even? 1234567891) #f)

(test (expt 0 2) 0)
(test (expt 2 0) 1)
(test (expt 2 1) 2)
(test (expt 2 2) 4)
(test (expt 2 3) 8)
(test (expt -2 3) -8)
(test (expt -2 4) 16)
(test (expt 2 100) 1267650600228229401496703205376)

(test (gcd) 0)
(test (gcd 17) 17)
(test (gcd 18 12) 6)
(test (gcd 289 85 34) 17)

(test (lcm) 1)
(test (lcm 17) 17)
(test (lcm 12 18) 36)
(test (lcm 5 12 18) 180)

(test (min 1) 1)
(test (min 2 1 3) 1)
(test (min 2 1 -2 -1 3) -2)

(test (max 1) 1)
(test (max 2 3 1) 3)
(test (max 2 -2 5 -1 3) 5)

(test (modulo  1234567890  12345)  6165)
(test (modulo  1234567890 -12345) -6180)
(test (modulo -1234567890  12345)  6180)
(test (modulo -1234567890 -12345) -6165)
(test (modulo  12345  1234567890)  12345)
(test (modulo  12345 -1234567890) -1234555545)
(test (modulo -12345  1234567890)  1234555545)
(test (modulo -12345 -1234567890) -12345)
(test (modulo  12345  12345) 0)
(test (modulo  12345 -12345) 0)
(test (modulo -12345  12345) 0)
(test (modulo -12345 -12345) 0)

(test (negative? -1) #t)
(test (negative?  0) #f)
(test (negative?  1) #f)

(test (not #f) #t)
(test (not #\c) #f)
(test (not 1) #f)
(test (not 1.1) #f)
(test (not '(pair)) #f)
(test (not (lambda () #f)) #f)
(test (not "string") #f)
(test (not 'symbol) #f)
(test (not '#(vector)) #f)
(test (not (current-input-port)) #f)
(test (not (current-output-port)) #f)

(test (odd? -1) #t)
(test (odd? 0) #f)
(test (odd? 1) #t)
(test (odd? 2) #f)
(test (odd? 1234567890) #f)
(test (odd? 1234567891) #t)

(test (positive? -1) #f)
(test (positive?  0) #f)
(test (positive?  1) #t)

(test (quotient  1234567890  12345)  100005)
(test (quotient  1234567890 -12345) -100005)
(test (quotient -1234567890  12345) -100005)
(test (quotient -1234567890 -12345)  100005)
(test (quotient  12345  1234567890)  0)
(test (quotient  12345 -1234567890)  0)
(test (quotient -12345  1234567890)  0)
(test (quotient -12345 -1234567890)  0)
(test (quotient  12345  12345)  1)
(test (quotient  12345 -12345) -1)
(test (quotient -12345  12345) -1)
(test (quotient -12345 -12345)  1)

(test (remainder  1234567890  12345)  6165)
(test (remainder  1234567890 -12345)  6165)
(test (remainder -1234567890  12345) -6165)
(test (remainder -1234567890 -12345) -6165)
(test (remainder  12345  1234567890)  12345)
(test (remainder  12345 -1234567890)  12345)
(test (remainder -12345  1234567890) -12345)
(test (remainder -12345 -1234567890) -12345)
(test (remainder  12345  12345) 0)
(test (remainder  12345 -12345) 0)
(test (remainder -12345  12345) 0)
(test (remainder -12345 -12345) 0)

(test (zero? -1) #f)
(test (zero?  0) #t)
(test (zero?  1) #f)

;;; Equivalence

(test (eq? eq? eq?) #t)
(test (eq? '() '()) #t)
(test (eq? 'x 'y) #f)
(test (eq? 'x '(x . y)) #f)
(test ((lambda (x) (eq? x x)) '(x . y)) #t)
(test (eq? #t #t) #t)
(test (eq? #f #f) #t)
(test (eq? (list 'pair) (list 'pair)) #f)
(test (eq? 'symbol 'symbol) #t)
(test (eq? (vector 'vector) (vector 'vector)) #f)

(test (eqv? 'x 'y) #f)
(test (eqv? #f #f) #t)
(test (eqv? #\c #\c) #t)
(test (eqv? 1 1) #t)
(test (eqv? (list 'pair) (list 'pair)) #f)
(test (eqv? 'symbol 'symbol) #t)
(test (eqv? (vector 'vector) (vector 'vector)) #f)
(test (eqv? 1   1.0) #f)
(test (eqv? 1.0 1  ) #f)
(test (eqv? 1.0 1.0) #t)

(test (equal? 'x 'y) #f)
(test (equal? #f #f) #t)
(test (equal? #\c #\c) #t)
(test (equal? 1 1) #t)
(test (equal? '(pair) '(pair)) #t)
(test (equal? '(pair (1)) '(pair (2))) #f)
(test (equal? (lambda () #f) (lambda () #f)) #f)
(test (equal? "string" "string") #t)
(test (equal? 'symbol 'symbol) #t)
(test (equal? '#(vector) #(vector)) #t)
(test (equal? '#(vector (list) vector) #(vector (list) vector)) #t)
(test (equal? '#(vector #(vector) vector) #(vector #(vector) vector)) #t)
(test (equal? '#(vector #(vec1) vector) #(vector #(vec2) vector)) #f)
(test (equal? tree tree) #t)

(test (equal? #f #\c) #f)
(test (equal? #f 1) #f)
(test (equal? #f '(pair)) #f)
(test (equal? #f (lambda () #f)) #f)
(test (equal? #f "string") #f)
(test (equal? #f 'symbol) #f)
(test (equal? #f '#(vector)) #f)
(test (equal? #f (current-input-port)) #f)
(test (equal? #f (current-output-port)) #f)
(test (equal? #\c 1) #f)
(test (equal? #\c '(pair)) #f)
(test (equal? #\c (lambda () #f)) #f)
(test (equal? #\c "string") #f)
(test (equal? #\c 'symbol) #f)
(test (equal? #\c '#(vector)) #f)
(test (equal? #\c (current-input-port)) #f)
(test (equal? #\c (current-output-port)) #f)
(test (equal? 1 '(pair)) #f)
(test (equal? 1 (lambda () #f)) #f)
(test (equal? 1 "string") #f)
(test (equal? 1 'symbol) #f)
(test (equal? 1 '#(vector)) #f)
(test (equal? 1 (current-input-port)) #f)
(test (equal? 1 (current-output-port)) #f)
(test (equal? '(pair) (lambda () #f)) #f)
(test (equal? '(pair) "string") #f)
(test (equal? '(pair) 'symbol) #f)
(test (equal? '(pair) '#(vector)) #f)
(test (equal? '(pair) (current-input-port)) #f)
(test (equal? '(pair) (current-output-port)) #f)
(test (equal? (lambda () #f) "string") #f)
(test (equal? (lambda () #f) 'symbol) #f)
(test (equal? (lambda () #f) '#(vector)) #f)
(test (equal? (lambda () #f) (current-input-port)) #f)
(test (equal? (lambda () #f) (current-output-port)) #f)
(test (equal? "string" 'symbol) #f)
(test (equal? "string" '#(vector)) #f)
(test (equal? "string" (current-input-port)) #f)
(test (equal? "string" (current-output-port)) #f)
(test (equal? 'symbol '#(vector)) #f)
(test (equal? 'symbol (current-input-port)) #f)
(test (equal? 'symbol (current-output-port)) #f)
(test (equal? '#(vector) (current-input-port)) #f)
(test (equal? '#(vector) (current-output-port)) #f)
(test (equal? (current-input-port) (current-output-port)) #f)
(test (equal? 1   1.0) #f)
(test (equal? 1.0 1  ) #f)
(test (equal? 1.0 1.0) #t)

(test (let ((x (list 1))) (equal? x x)) #t)

(test (equal? '(a (b c) (d (e . f) g)) '(a (b c) (d (e . f) g))) #t)
(test (equal? '(a (b c) (d (e . x) g)) '(a (b c) (d (e . f) g))) #f)
(test (equal? '#(a (b c) (d (e . f) g)) '#(a (b c) (d (e . f) g))) #t)
(test (equal? '#(a (b c) (d (e . x) g)) '#(a (b c) (d (e . f) g))) #f)

;;; Characters

(test (char-alphabetic? #\a) #t)
(test (char-alphabetic? #\A) #t)
(test (char-alphabetic? #\z) #t)
(test (char-alphabetic? #\Z) #t)
(test (char-alphabetic? #\@) #f)
(test (char-alphabetic? #\[) #f)
(test (char-alphabetic? #\`) #f)
(test (char-alphabetic? #\{) #f)

(test (char-ci<? #\+ #\+) #f)
(test (char-ci<? #\+ #\-) #t)
(test (char-ci<? #\A #\A) #f)
(test (char-ci<? #\A #\a) #f)
(test (char-ci<? #\a #\A) #f)
(test (char-ci<? #\a #\a) #f)
(test (char-ci<? #\A #\Z) #t)
(test (char-ci<? #\A #\z) #t)
(test (char-ci<? #\a #\Z) #t)
(test (char-ci<? #\a #\z) #t)
(test (char-ci<? #\Z #\A) #f)
(test (char-ci<? #\Z #\a) #f)
(test (char-ci<? #\z #\A) #f)
(test (char-ci<? #\z #\a) #f)
(test (char-ci<? #\a #\b #\c) #t)
(test (char-ci<? #\a #\b #\b) #f)
(test (char-ci<? #\b #\b #\a) #f)
(test (char-ci<? #\c #\b #\a) #f)

(test (char-ci<=? #\+ #\+) #t)
(test (char-ci<=? #\+ #\-) #t)
(test (char-ci<=? #\A #\A) #t)
(test (char-ci<=? #\A #\a) #t)
(test (char-ci<=? #\a #\A) #t)
(test (char-ci<=? #\a #\a) #t)
(test (char-ci<=? #\A #\Z) #t)
(test (char-ci<=? #\A #\z) #t)
(test (char-ci<=? #\a #\Z) #t)
(test (char-ci<=? #\a #\z) #t)
(test (char-ci<=? #\Z #\A) #f)
(test (char-ci<=? #\Z #\a) #f)
(test (char-ci<=? #\z #\A) #f)
(test (char-ci<=? #\z #\a) #f)
(test (char-ci<=? #\a #\b #\c) #t)
(test (char-ci<=? #\a #\b #\b) #t)
(test (char-ci<=? #\b #\b #\a) #f)
(test (char-ci<=? #\c #\b #\a) #f)

(test (char-ci=? #\+ #\+) #t)
(test (char-ci=? #\+ #\-) #f)
(test (char-ci=? #\A #\A) #t)
(test (char-ci=? #\A #\a) #t)
(test (char-ci=? #\a #\A) #t)
(test (char-ci=? #\a #\a) #t)
(test (char-ci=? #\A #\Z) #f)
(test (char-ci=? #\A #\z) #f)
(test (char-ci=? #\a #\Z) #f)
(test (char-ci=? #\a #\z) #f)
(test (char-ci=? #\a #\A #\a) #t)
(test (char-ci=? #\a #\A #\b) #f)

(test (char-ci>? #\+ #\+) #f)
(test (char-ci>? #\+ #\-) #f)
(test (char-ci>? #\A #\A) #f)
(test (char-ci>? #\A #\a) #f)
(test (char-ci>? #\a #\A) #f)
(test (char-ci>? #\a #\a) #f)
(test (char-ci>? #\A #\Z) #f)
(test (char-ci>? #\A #\z) #f)
(test (char-ci>? #\a #\Z) #f)
(test (char-ci>? #\a #\z) #f)
(test (char-ci>? #\Z #\A) #t)
(test (char-ci>? #\Z #\a) #t)
(test (char-ci>? #\z #\A) #t)
(test (char-ci>? #\z #\a) #t)
(test (char-ci>? #\a #\b #\c) #f)
(test (char-ci>? #\a #\b #\b) #f)
(test (char-ci>? #\b #\b #\a) #f)
(test (char-ci>? #\c #\b #\a) #t)

(test (char-ci>=? #\+ #\+) #t)
(test (char-ci>=? #\+ #\-) #f)
(test (char-ci>=? #\A #\A) #t)
(test (char-ci>=? #\A #\a) #t)
(test (char-ci>=? #\a #\A) #t)
(test (char-ci>=? #\a #\a) #t)
(test (char-ci>=? #\A #\Z) #f)
(test (char-ci>=? #\A #\z) #f)
(test (char-ci>=? #\a #\Z) #f)
(test (char-ci>=? #\a #\z) #f)
(test (char-ci>=? #\Z #\A) #t)
(test (char-ci>=? #\Z #\a) #t)
(test (char-ci>=? #\z #\A) #t)
(test (char-ci>=? #\z #\a) #t)
(test (char-ci>=? #\a #\b #\c) #f)
(test (char-ci>=? #\a #\b #\b) #f)
(test (char-ci>=? #\b #\b #\a) #t)
(test (char-ci>=? #\c #\b #\a) #t)

(test (char-downcase #\a) #\a)
(test (char-downcase #\A) #\a)
(test (char-downcase #\z) #\z)
(test (char-downcase #\Z) #\z)
(test (char-downcase #\@) #\@)
(test (char-downcase #\[) #\[)
(test (char-downcase #\`) #\`)
(test (char-downcase #\{) #\{)

(test (char-lower-case? #\a) #t)
(test (char-lower-case? #\A) #f)
(test (char-lower-case? #\z) #t)
(test (char-lower-case? #\Z) #f)
(test (char-lower-case? #\@) #f)
(test (char-lower-case? #\[) #f)
(test (char-lower-case? #\`) #f)
(test (char-lower-case? #\{) #f)

(test (char-numeric? #\0) #t)
(test (char-numeric? #\9) #t)
(test (char-numeric? #\/) #f)
(test (char-numeric? #\:) #f)

(test (char-upcase #\a) #\A)
(test (char-upcase #\A) #\A)
(test (char-upcase #\z) #\Z)
(test (char-upcase #\Z) #\Z)
(test (char-upcase #\@) #\@)
(test (char-upcase #\[) #\[)
(test (char-upcase #\`) #\`)
(test (char-upcase #\{) #\{)

(test (char-upper-case? #\a) #f)
(test (char-upper-case? #\A) #t)
(test (char-upper-case? #\z) #f)
(test (char-upper-case? #\Z) #t)
(test (char-upper-case? #\@) #f)
(test (char-upper-case? #\[) #f)
(test (char-upper-case? #\`) #f)
(test (char-upper-case? #\{) #f)

(test (char-whitespace? #\0) #f)
(test (char-whitespace? #\9) #f)
(test (char-whitespace? #\a) #f)
(test (char-whitespace? #\z) #f)
(test (char-whitespace? #\ ) #t)
(test (char-whitespace? #\space) #t)
(test (char-whitespace? #\newline) #t)
(test (char-whitespace? (integer->char 9)) #t)
(test (char-whitespace? (integer->char 10)) #t)
(test (char-whitespace? (integer->char 12)) #t)
(test (char-whitespace? (integer->char 13)) #t)

(test (char<? #\+ #\+) #f)
(test (char<? #\+ #\-) #t)
(test (char<? #\A #\A) #f)
(test (char<? #\A #\a) #t)
(test (char<? #\a #\A) #f)
(test (char<? #\a #\a) #f)
(test (char<? #\A #\Z) #t)
(test (char<? #\A #\z) #t)
(test (char<? #\a #\Z) #f)
(test (char<? #\a #\z) #t)
(test (char<? #\Z #\A) #f)
(test (char<? #\Z #\a) #t)
(test (char<? #\z #\A) #f)
(test (char<? #\z #\a) #f)
(test (char<? #\a #\b #\c) #t)
(test (char<? #\a #\a #\b) #f)
(test (char<? #\c #\c #\b) #f)
(test (char<? #\c #\b #\a) #f)

(test (char<=? #\+ #\+) #t)
(test (char<=? #\+ #\-) #t)
(test (char<=? #\A #\A) #t)
(test (char<=? #\A #\a) #t)
(test (char<=? #\a #\A) #f)
(test (char<=? #\a #\a) #t)
(test (char<=? #\A #\Z) #t)
(test (char<=? #\A #\z) #t)
(test (char<=? #\a #\Z) #f)
(test (char<=? #\a #\z) #t)
(test (char<=? #\Z #\A) #f)
(test (char<=? #\Z #\a) #t)
(test (char<=? #\z #\A) #f)
(test (char<=? #\z #\a) #f)
(test (char<=? #\a #\b #\c) #t)
(test (char<=? #\a #\a #\b) #t)
(test (char<=? #\c #\c #\b) #f)
(test (char<=? #\c #\b #\a) #f)

(test (char=? #\+ #\+) #t)
(test (char=? #\+ #\-) #f)
(test (char=? #\A #\A) #t)
(test (char=? #\A #\a) #f)
(test (char=? #\a #\A) #f)
(test (char=? #\a #\a) #t)
(test (char=? #\A #\Z) #f)
(test (char=? #\A #\z) #f)
(test (char=? #\a #\Z) #f)
(test (char=? #\a #\z) #f)
(test (char=? #\Z #\A) #f)
(test (char=? #\Z #\a) #f)
(test (char=? #\z #\A) #f)
(test (char=? #\z #\a) #f)
(test (char=? #\a #\a #\a) #t)
(test (char=? #\a #\a #\b #\a) #f)

(test (char>? #\+ #\+) #f)
(test (char>? #\+ #\-) #f)
(test (char>? #\A #\A) #f)
(test (char>? #\A #\a) #f)
(test (char>? #\a #\A) #t)
(test (char>? #\a #\a) #f)
(test (char>? #\A #\Z) #f)
(test (char>? #\A #\z) #f)
(test (char>? #\a #\Z) #t)
(test (char>? #\a #\z) #f)
(test (char>? #\Z #\A) #t)
(test (char>? #\Z #\a) #f)
(test (char>? #\z #\A) #t)
(test (char>? #\z #\a) #t)
(test (char>? #\a #\b #\c) #f)
(test (char>? #\a #\a #\b) #f)
(test (char>? #\c #\c #\b) #f)
(test (char>? #\c #\b #\a) #t)

(test (char>=? #\+ #\+) #t)
(test (char>=? #\+ #\-) #f)
(test (char>=? #\A #\A) #t)
(test (char>=? #\A #\a) #f)
(test (char>=? #\a #\A) #t)
(test (char>=? #\a #\a) #t)
(test (char>=? #\A #\Z) #f)
(test (char>=? #\A #\z) #f)
(test (char>=? #\a #\Z) #t)
(test (char>=? #\a #\z) #f)
(test (char>=? #\Z #\A) #t)
(test (char>=? #\Z #\a) #f)
(test (char>=? #\z #\A) #t)
(test (char>=? #\z #\a) #t)
(test (char>=? #\a #\b #\c) #f)
(test (char>=? #\a #\a #\b) #f)
(test (char>=? #\c #\c #\b) #t)
(test (char>=? #\c #\b #\a) #t)

;;; Strings

(define (string-downcase s)
  (list->string (map char-downcase (string->list s))))

(test (make-string 0) "")
(test (make-string 1) " ")
(test (make-string 3 #\x) "xxx")

(test (number->string 0) "0")
(test (number->string 123) "123")
(test (number->string 165 2) "10100101")
(test (number->string 375 8) "567")
(test (number->string 789 10) "789")
(test (string-downcase (number->string 11259375 16)) "abcdef")
(test (number->string +165 2) "10100101")
(test (number->string +375 8) "567")
(test (number->string +789 10) "789")
(test (string-downcase (number->string +11259375 16)) "abcdef")
(test (number->string -165 2) "-10100101")
(test (number->string -375 8) "-567")
(test (number->string -789 10) "-789")
(test (string-downcase (number->string -11259375 16)) "-abcdef")

(define (numstr=? a b)
  (<= (abs (- (string->number a)
              (string->number b)))
      *epsilon*))

(test (numstr=? (number->string 1.0) "1.0") #t)
(test (numstr=? (number->string 123.0) "123.0") #t)
(test (numstr=? (number->string 123.4) "123.4") #t)
(test (numstr=? (number->string 1.23e2) "123.0") #t)
(test (numstr=? (number->string 1.23e5) "123000.0") #t)
(test (numstr=? (number->string 3.14159) "3.14159") #t)
(test (numstr=? (number->string 1.23) "1.23") #t)
(test (numstr=? (number->string 0.123) "0.123") #t)
(test (numstr=? (number->string 0.0123) "0.0123") #t)
(test (numstr=? (number->string 0.00123) "0.00123") #t)
(test (numstr=? (number->string 0.000123) "0.000123") #t)
(test (numstr=? (number->string 0.0000123) "1.23e-5") #t)
(test (numstr=? (number->string -1.0) "-1.0") #t)
(test (numstr=? (number->string -123.0) "-123.0") #t)
(test (numstr=? (number->string -123.4) "-123.4") #t)
(test (numstr=? (number->string -3.14159) "-3.14159") #t)
(test (numstr=? (number->string -1.23) "-1.23") #t)
(test (numstr=? (number->string -0.123) "-0.123") #t)
(test (numstr=? (number->string -0.0123) "-0.0123") #t)
(test (numstr=? (number->string -0.00123) "-0.00123") #t)
(test (numstr=? (number->string -0.000123) "-0.000123") #t)
(test (numstr=? (number->string -0.0000123) "-1.23e-5") #t)

(test (string) "")
(test (string #\x) "x")
(test (string #\a #\b #\c) "abc")

(test (string->number "") #f)
(test (string->number "+") #f)
(test (string->number "-") #f)
(test (string->number "0") 0)
(test (string->number "123") 123)
(test (string->number "10100101" 2) 165)
(test (string->number "567" 8) 375)
(test (string->number "789" 10) 789)
(test (string->number "abcdef" 16) 11259375)
(test (string->number "+1010" 2) 10)
(test (string->number "+123" 8) 83)
(test (string->number "+123" 10) 123)
(test (string->number "+123" 16) 291)
(test (string->number "-1010" 2) -10)
(test (string->number "-123" 8) -83)
(test (string->number "-123" 10) -123)
(test (string->number "-123" 16) -291)

(test (string->number "0.0") 0.0)
(test (string->number "1.0") 1.0)
(test (string->number "-1.0") -1.0)
(test (string->number "123.0") 123.0)
(test (string->number "-123.0") -123.0)
(test (string->number "1.23") 1.23)
(test (string->number "-1.23") -1.23)
(test (string->number "0.123") 0.123)
(test (string->number "-0.123") -0.123)
(test (string->number "-0.000123") -0.000123)
(test (string->number "0.1") 0.1)
(test (string->number "0.01") 0.01)
(test (string->number "0.001") 0.001)
(test (string->number "0.00000001") 0.00000001)
(test (string->number "1e0") 1.0)
(test (string->number "1e1") 10.0)
(test (string->number "1e2") 100.0)
(test (string->number "1e5") 100000.0)
(test (string->number "1e-1") 0.1)
(test (string->number "1e-2") 0.01)
(test (string->number "1e-5") 0.00001)
(test (string->number "123.456e0") 123.456)
(test (string->number "123.456e1") 1234.56)
(test (string->number "123.456e5") 12345600.0)
(test (string->number "-123.456e0") -123.456)
(test (string->number "-123.456e1") -1234.56)
(test (string->number "-123.456e5") -12345600.0)
(test (string->number "123.456e-1") 12.3456)
(test (string->number "123.456e-5") 0.00123456)
(test (string->number "-123.456e-1") -12.3456)
(test (string->number "-123.456e-5") -0.00123456)
(test (string->number "1.") 1.0)
(test (string->number ".1") 0.1)
(test (string->number "1.e1") 10.0)
(test (string->number ".1e1") 1.0)
(test (string->number ".1e4") 1e3)
(test (string->number ".01e5") 1e3)
(test (string->number ".001e6") 1e3)
(test (string->number "1.23d5") 1.23e+5)
(test (string->number "1.23e5") 1.23e+5)
(test (string->number "1.23f5") 1.23e+5)
(test (string->number "1.23l5") 1.23e+5)
(test (string->number "1.23s5") 1.23e+5)
(test (string->number "1.23D5") 1.23e+5)
(test (string->number "1.23E5") 1.23e+5)
(test (string->number "1.23F5") 1.23e+5)
(test (string->number "1.23L5") 1.23e+5)
(test (string->number "1.23S5") 1.23e+5)

(test (string->number "02" 2) #f)
(test (string->number "08" 8) #f)
(test (string->number "0a" 10) #f)
(test (string->number "0g" 16) #f)
(test (string->number " 1") #f)
(test (string->number "1 ") #f)
(test (string->number "+1 ") #f)
(test (string->number "-1 ") #f)

(test (string-append "" "") "")
(test (string-append "abc" "") "abc")
(test (string-append "" "def") "def")
(test (string-append) "")
(test (string-append "abc") "abc")
(test (string-append "abc" "def") "abcdef")
(test (string-append "abc" "def" "xyz") "abcdefxyz")

(test (string-ci<? "test" "test") #f)
(test (string-ci<? "test" "tesa") #f)
(test (string-ci<? "test" "tesz") #t)
(test (string-ci<? "TEST" "tesa") #f)
(test (string-ci<? "TEST" "tesz") #t)
(test (string-ci<? "test" "TESA") #f)
(test (string-ci<? "test" "TESZ") #t)
(test (string-ci<? "TEST" "TESA") #f)
(test (string-ci<? "TEST" "TESZ") #t)
(test (string-ci<? "test" "tes") #f)
(test (string-ci<? "test" "test0") #t)
(test (string-ci<? "test0" "test") #f)
(test (string-ci<? "ab" "cd" "ef") #t)
(test (string-ci<? "ab" "ab" "cd") #f)
(test (string-ci<? "cd" "cd" "ab") #f)
(test (string-ci<? "ef" "cd" "ab") #f)

(test (string-ci<=? "test" "test") #t)
(test (string-ci<=? "test" "tesa") #f)
(test (string-ci<=? "test" "tesz") #t)
(test (string-ci<=? "TEST" "tesa") #f)
(test (string-ci<=? "TEST" "tesz") #t)
(test (string-ci<=? "test" "TESA") #f)
(test (string-ci<=? "test" "TESZ") #t)
(test (string-ci<=? "TEST" "TESA") #f)
(test (string-ci<=? "TEST" "TESZ") #t)
(test (string-ci<=? "test" "tes") #f)
(test (string-ci<=? "test" "test0") #t)
(test (string-ci<=? "test0" "test") #f)
(test (string-ci<=? "ab" "cd" "ef") #t)
(test (string-ci<=? "ab" "ab" "cd") #t)
(test (string-ci<=? "cd" "cd" "ab") #f)
(test (string-ci<=? "ef" "cd" "ab") #f)

(test (string-ci=? "abc" "abc") #t)
(test (string-ci=? "abC" "abc") #t)
(test (string-ci=? "aBc" "abc") #t)
(test (string-ci=? "aBC" "abc") #t)
(test (string-ci=? "Abc" "abc") #t)
(test (string-ci=? "AbC" "abc") #t)
(test (string-ci=? "ABc" "abc") #t)
(test (string-ci=? "ABC" "abc") #t)
(test (string-ci=? "aBc" "AbC") #t)
(test (string-ci=? "abc" "abd") #f)
(test (string-ci=? "abc" "abcd") #f)
(test (string-ci=? "abcd" "abc") #f)
(test (string-ci=? "abc" "abc" "abc") #t)
(test (string-ci=? "abc" "abc" "cba") #f)

(test (string-ci>? "test" "test") #f)
(test (string-ci>? "test" "tesa") #t)
(test (string-ci>? "test" "tesz") #f)
(test (string-ci>? "TEST" "tesa") #t)
(test (string-ci>? "TEST" "tesz") #f)
(test (string-ci>? "test" "TESA") #t)
(test (string-ci>? "test" "TESZ") #f)
(test (string-ci>? "TEST" "TESA") #t)
(test (string-ci>? "TEST" "TESZ") #f)
(test (string-ci>? "test" "tes") #t)
(test (string-ci>? "test" "test0") #f)
(test (string-ci>? "test0" "test") #t)
(test (string-ci>? "ab" "cd" "ef") #f)
(test (string-ci>? "ab" "ab" "cd") #f)
(test (string-ci>? "cd" "cd" "ab") #f)
(test (string-ci>? "ef" "cd" "ab") #t)

(test (string-ci>=? "test" "test") #t)
(test (string-ci>=? "test" "tesa") #t)
(test (string-ci>=? "test" "tesz") #f)
(test (string-ci>=? "TEST" "tesa") #t)
(test (string-ci>=? "TEST" "tesz") #f)
(test (string-ci>=? "test" "TESA") #t)
(test (string-ci>=? "test" "TESZ") #f)
(test (string-ci>=? "TEST" "TESA") #t)
(test (string-ci>=? "TEST" "TESZ") #f)
(test (string-ci>=? "test" "tes") #t)
(test (string-ci>=? "test" "test0") #f)
(test (string-ci>=? "test0" "test") #t)
(test (string-ci>=? "ab" "cd" "ef") #f)
(test (string-ci>=? "ab" "ab" "cd") #f)
(test (string-ci>=? "cd" "cd" "ab") #t)
(test (string-ci>=? "ef" "cd" "ab") #t)

(test (string-copy "") "")
(test (string-copy "abcdef") "abcdef")
(test (begin (let ((s "abc"))
                (let ((s2 (string-copy s)))
                  (string-set! s2 1 #\x)
                  s)))
      "abc")

(test (let ((s (make-string 1))) (string-fill! s #\x) s) "x")
(test (let ((s (make-string 3))) (string-fill! s #\z) s) "zzz")

(test (string-length "") 0)
(test (string-length "a") 1)
(test (string-length "ab") 2)
(test (string-length "abc") 3)
(test (string-length "Hello, World!") 13)

(test (string-ref "abc" 0) #\a)
(test (string-ref "abc" 1) #\b)
(test (string-ref "abc" 2) #\c)

(define s (string #\1 #\2 #\3))
(test (begin (string-set! s 0 #\a) s) "a23")
(test (begin (string-set! s 2 #\c) s) "a2c")
(test (begin (string-set! s 1 #\b) s) "abc")

(test (string<? "test" "test") #f)
(test (string<? "test" "tesa") #f)
(test (string<? "test" "tesz") #t)
(test (string<? "TEST" "tesa") #t)
(test (string<? "TEST" "tesz") #t)
(test (string<? "test" "TESA") #f)
(test (string<? "test" "TESZ") #f)
(test (string<? "TEST" "TESA") #f)
(test (string<? "TEST" "TESZ") #t)
(test (string<? "test" "tes") #f)
(test (string<? "test" "test0") #t)
(test (string<? "test0" "test") #f)
(test (string<? "ab" "cd" "ef") #t)
(test (string<? "ab" "ab" "cd") #f)
(test (string<? "cd" "cd" "ab") #f)
(test (string<? "ef" "cd" "ab") #f)

(test (string<=? "test" "test") #t)
(test (string<=? "test" "tesa") #f)
(test (string<=? "test" "tesz") #t)
(test (string<=? "TEST" "tesa") #t)
(test (string<=? "TEST" "tesz") #t)
(test (string<=? "test" "TESA") #f)
(test (string<=? "test" "TESZ") #f)
(test (string<=? "TEST" "TESA") #f)
(test (string<=? "TEST" "TESZ") #t)
(test (string<=? "test" "tes") #f)
(test (string<=? "test" "test0") #t)
(test (string<=? "test0" "test") #f)
(test (string<=? "ab" "cd" "ef") #t)
(test (string<=? "ab" "ab" "cd") #t)
(test (string<=? "cd" "cd" "ab") #f)
(test (string<=? "ef" "cd" "ab") #f)

(test (string=? "abc" "abc") #t)
(test (string=? "aBc" "abc") #f)
(test (string=? "abc" "abd") #f)
(test (string=? "abc" "abcd") #f)
(test (string=? "abcd" "abc") #f)
(test (string=? "abc" "abc" "abc") #t)
(test (string=? "abc" "abc" "cba") #f)

(test (string>? "test" "test") #f)
(test (string>? "test" "tesa") #t)
(test (string>? "test" "tesz") #f)
(test (string>? "TEST" "tesa") #f)
(test (string>? "TEST" "tesz") #f)
(test (string>? "test" "TESA") #t)
(test (string>? "test" "TESZ") #t)
(test (string>? "TEST" "TESA") #t)
(test (string>? "TEST" "TESZ") #f)
(test (string>? "test" "tes") #t)
(test (string>? "test" "test0") #f)
(test (string>? "test0" "test") #t)
(test (string>? "ab" "cd" "ef") #f)
(test (string>? "ab" "ab" "cd") #f)
(test (string>? "cd" "cd" "ab") #f)
(test (string>? "ef" "cd" "ab") #t)

(test (string>=? "test" "test") #t)
(test (string>=? "test" "tesa") #t)
(test (string>=? "test" "tesz") #f)
(test (string>=? "TEST" "tesa") #f)
(test (string>=? "TEST" "tesz") #f)
(test (string>=? "test" "TESA") #t)
(test (string>=? "test" "TESZ") #t)
(test (string>=? "TEST" "TESA") #t)
(test (string>=? "TEST" "TESZ") #f)
(test (string>=? "test" "tes") #t)
(test (string>=? "test" "test0") #f)
(test (string>=? "test0" "test") #t)
(test (string>=? "ab" "cd" "ef") #f)
(test (string>=? "ab" "ab" "cd") #f)
(test (string>=? "cd" "cd" "ab") #t)
(test (string>=? "ef" "cd" "ab") #t)

(test (substring "" 0 0) "")
(test (substring "abc" 0 0) "")
(test (substring "abc" 0 1) "a")
(test (substring "abc" 0 2) "ab")
(test (substring "abc" 0 3) "abc")
(test (substring "abc" 1 1) "")
(test (substring "abc" 1 2) "b")
(test (substring "abc" 1 3) "bc")
(test (substring "abc" 2 2) "")
(test (substring "abc" 2 3) "c")
(test (substring "abc" 3 3) "")

;;; Vectors

(test (make-vector 0) #())
(test (make-vector 1) #(#f))
(test (make-vector 3 'x) #(x x x))

(test (vector) '#())
(test (vector 'x) '#(x))
(test (vector 1 2 3) '#(1 2 3))
(test (vector (vector 'x)) '#(#(x)))

(test (let ((v (vector))) (vector-fill! v 'x) v) '#())
(test (let ((v (vector 1 2 3))) (vector-fill! v 'z) v) '#(z z z))

(test (vector-length #()) 0)
(test (vector-length #(a)) 1)
(test (vector-length #(a b)) 2)
(test (vector-length #(a b c)) 3)
(test (vector-length #(1 2 3 #(4 5 6) 7 8 9)) 7)

(test (vector-ref #(a b c) 0) 'a)
(test (vector-ref #(a b c) 1) 'b)
(test (vector-ref #(a b c) 2) 'c)

(define v (vector 1 2 3))
(test (begin (vector-set! v 0 'a) v) '#(a 2 3))
(test (begin (vector-set! v 2 'c) v) '#(a 2 c))
(test (begin (vector-set! v 1 'b) v) '#(a b c))

;;; Input/Output

(if (file-exists? testfile) (delete-file testfile))

(test (call-with-output-file testfile
        (lambda (out)
          (write '(this is a test) out)
          (close-output-port out)
          (call-with-input-file testfile read)))
      '(this is a test))

(delete-file testfile)

(test (let ((out (open-output-file testfile)))
        (write '(this is a test) out)
        (close-output-port out)
        (let ((in (open-input-file testfile)))
          (let ((x (read in)))
            (close-input-port in)
            x)))
      '(this is a test))

(delete-file testfile)

(test (let ((out (open-output-file testfile)))
        (display "Hello-World" out)
        (close-output-port out)
        (let ((in (open-input-file testfile)))
          (let ((x (read in)))
            (close-input-port in)
            x)))
      'hello-world)

(delete-file testfile)

(test (begin (with-output-to-file testfile
               (lambda () (write '(this is a test))))
             (with-input-from-file testfile read))
      '(this is a test))

(define (visibility-check x)
  (delete-file testfile)
  (let ((out (open-output-file testfile)))
    (write x out)
    (display #\space out)
    (display x out)
    (display #\space out)
    (write 'the-end out)
    (close-output-port out)
    (let ((in (open-input-file testfile)))
      (let ((vis (read in)))
        (let ((invis (read in)))
          (close-input-port in)
          (list vis invis))))))

(test (visibility-check #f) '(#f #f))
(test (visibility-check 1) '(1 1))
(test (visibility-check 12345678901234567890)
                        '(12345678901234567890 12345678901234567890))
(test (visibility-check -12345678901234567890)
                        '(-12345678901234567890 -12345678901234567890))
(test (visibility-check #\A) '(#\A a))
(test (visibility-check "x y") '("x y" x))
(test (visibility-check 'foo) '(foo foo))
(test (visibility-check '(1 2 3)) '((1 2 3) (1 2 3)))
(test (visibility-check '#(1 2 3)) '(#(1 2 3) #(1 2 3)))
(test (visibility-check " ") '(" " the-end))
(test (visibility-check #\space) '(#\space the-end))
(test (visibility-check #\newline) '(#\newline the-end))

(delete-file testfile)

(test (begin (with-output-to-file testfile newline)
               (with-input-from-file testfile read-char))
      #\newline)

(delete-file testfile)

(test (begin (call-with-output-file testfile
               (lambda (out)
                 (newline out)
                 (close-output-port out)))
             (call-with-input-file testfile read-char))
      #\newline)

(delete-file testfile)

(test (begin (close-output-port (open-output-file testfile))
             (let* ((in (open-input-file testfile))
                    (e (read in)))
               (close-input-port in)
               (eof-object? e)))
      #t)

(delete-file testfile)

(define foo 'bar)
(test (let ((out (open-output-file testfile)))
        (write '(define foo 'baz) out)
        (close-output-port out)
        (load testfile)
        foo)
      'baz)

(define (with-range lo hi fn)
  (if (< hi lo)
      '()
      (let ((c (fn lo)))
        (cons c (with-range (+ 1 lo) hi fn)))))

(delete-file testfile)

(test (call-with-output-file testfile
        (lambda (out)
          (with-range 32 126
            (lambda (x)
              (write-char (integer->char x) out)
              (integer->char x)))))
      (with-range 32 126 integer->char))

(define (while-not-eof input fn)
  (let ((c (fn input)))
    (if (eof-object? c)
        '()
        (cons c (while-not-eof input fn)))))

(test (let ((in (open-input-file testfile)))
        (while-not-eof in read-char))
      (with-range 32 126 integer->char))

(test (let ((in (open-input-file testfile)))
        (let ((c (peek-char in)))
          (cons c (while-not-eof in read-char))))
       (cons #\space (with-range 32 126 integer->char)))

; Does GC close unused files?
; Set NFILES to a number that is greater than MAX_PORTS in s9.c
(let ((NFILES 100))
  (test (letrec
          ((open
             (lambda (n)
               (open-input-file testfile)
               (if (< n 1)
                   'okay
                   (open (- n 1))))))
          (open NFILES))
        'okay))

;;; S9fES Extensions

(test (list? (command-line)) #t)
(test (output-port? (current-error-port)) #t)
(test (symbol? (gensym)) #t)
(test (eq? (gensym) (gensym)) #f)
(test (list? (symbols)) #t)

(if (file-exists? testfile) (delete-file testfile))
(test (file-exists? testfile) #f)
(close-output-port (open-output-file testfile))
(test (file-exists? testfile) #t)
(delete-file testfile)
(test (file-exists? testfile) #f)

(test (eval '(+ 1 2 3)) 6)
(eval '(define foo 'barbazgoo))
(test (eval 'foo) 'barbazgoo)

(test (exponent 1.23) -2)
(test (exponent 1) 0)
(test (mantissa 1.23) 123)
(test (mantissa 1) 1)

(let ((of (open-output-file testfile)))
  (write 'append of)
  (close-output-port of))
(let ((af (open-append-file testfile)))
  (write '-to-file af)
  (close-output-port af))
(test (read (open-input-file testfile)) 'append-to-file)

(test (reverse! (list 1 2 3)) '(3 2 1))
(test (reverse! '()) '())
(test (let ((x (list 1 2 3))) (reverse! x) x) '(1))

;set-input-port!
;set-output-port!

(test (car (stats '(cons 1 2))) '(1 . 2))

(test (vector-copy '#(a b c d e f)) '#(a b c d e f))
(test (vector-copy '#(a b c d e f) 2) '#(c d e f))
(test (vector-copy '#(a b c d e f) 2 4) '#(c d))
(test (vector-length (vector-copy '#(a b c d e f) 2 8)) 6)
(test (vector-copy (vector-copy '#(a b c d e f) 0 6)) '#(a b c d e f))
(test (vector-copy '#(a b c d e f) 2 8 'x) '#(c d e f x x))

(define (mask x)
  (bit-op 1 #b1111 x))

(test (mask (bit-op  0 #b0011 #b0101)) 0)
(test (mask (bit-op  1 #b0011 #b0101)) 1)
(test (mask (bit-op  2 #b0011 #b0101)) 2)
(test (mask (bit-op  3 #b0011 #b0101)) 3)
(test (mask (bit-op  4 #b0011 #b0101)) 4)
(test (mask (bit-op  5 #b0011 #b0101)) 5)
(test (mask (bit-op  6 #b0011 #b0101)) 6)
(test (mask (bit-op  7 #b0011 #b0101)) 7)
(test (mask (bit-op  8 #b0011 #b0101)) 8)
(test (mask (bit-op  9 #b0011 #b0101)) 9)
(test (mask (bit-op 10 #b0011 #b0101)) 10)
(test (mask (bit-op 11 #b0011 #b0101)) 11)
(test (mask (bit-op 12 #b0011 #b0101)) 12)
(test (mask (bit-op 13 #b0011 #b0101)) 13)
(test (mask (bit-op 14 #b0011 #b0101)) 14)
(test (mask (bit-op 15 #b0011 #b0101)) 15)

(test (vector-append) '#())
(test (vector-append '#(foo)) '#(foo))
(test (vector-append '#(foo) #(bar)) '#(foo bar))
(test (vector-append '#(foo) #(bar) #(baz)) '#(foo bar baz))

; catch and throw

(test (catch (lambda (k) 'foo)) 'foo)

(test (cons 'foo (catch (lambda (k) (throw k 'bar)))) '(foo . bar))

(test (cons 'foo (catch (lambda (k) (cons 'zzz (throw k 'bar)))))
      '(foo . bar))

(define (ctak x y z)
  (define (ctak-aux k x y z)
    (if (not (< y x))
        (throw k z)
        (catch
          (lambda (k)
            (ctak-aux
              k
              (catch (lambda (k) (ctak-aux k (- x 1) y z)))
              (catch (lambda (k) (ctak-aux k (- y 1) z x)))
              (catch (lambda (k) (ctak-aux k (- z 1) x y))))))))
  (catch (lambda (k) (ctak-aux k x y z))))

(test (ctak 6 4 2) 3)

(define list-length
  (lambda (obj)
    (catch
      (lambda (improper)
        (letrec ((r (lambda (obj)
                      (cond ((null? obj)
                              0)
                            ((pair? obj)
                              (+ (r (cdr obj)) 1))
                            (else
                              (throw improper #f))))))
          (r obj))))))

(test (list-length '(1 2 3 4)) 4)
(test (list-length '(a b . c)) #f)

(test (catch-errors 'failed (cons 1 2)) '(1 . 2))
(test (catch-errors 'failed (car 'x)) 'failed)
(test (catch-errors 'failed (quotient 1 0)) 'failed)

(test (catch-errors 'foo (catch-errors (car 'x) 'bar) 'baz) 'foo)

;;; Macros

(define-macro (kwote x) (list 'quote x))
(test (kwote (list 1 2 3)) '(list 1 2 3))
(define-macro (kwote x) (list 'quote x))  ; redefine
(test (kwote (list 1 2 3)) '(list 1 2 3))

(define-syntax (kwote x) (list 'quote x))
(test (kwote (list 1 2 3)) '(list 1 2 3))

(define-syntax (times n)
  (if (zero? n)
      '()
      `(cons 1 (times ,(- n 1)))))
(test (times 0) '())
(test (times 1) '(1))
(test (times 10) '(1 1 1 1 1 1 1 1 1 1))

(test (macro-expand '(times 3)) '(cons 1 (cons 1 (cons 1 ()))))
(test (macro-expand-1 '(times 3)) '(cons 1 (times 2)))

(define-syntax (letrec* bs x . xs)
  (let ((vs (map car bs))
        (as (map cadr bs)))
    (let ((undefs  (map (lambda (v) (list v #f))
                        vs))
          (updates (map (lambda (v t) (list 'set! v t))
                        vs
                        as)))
      `(let ,undefs
         ,@updates
         (let ()
           ,x
           ,@xs)))))

(test (macro-expand '(letrec* ((a 1) (b 2)) (a b)))
      '((lambda (a b) (set! a 1) (set! b 2) ((lambda () (a b)))) #f #f))
(test (macro-expand-1 '(letrec* ((a 1) (b 2)) (a b)))
      '(let ((a #f) (b #f)) (set! a 1) (set! b 2) (let () (a b))))

;;; APPLY of primitive procedures

(test (list? (apply command-line '())) #t)
(test (input-port? (apply current-input-port '())) #t)
(test (output-port? (apply current-output-port '())) #t)
(test (output-port? (apply current-error-port '())) #t)
(test (symbol? (apply gensym '())) #t)
(test (list? (apply symbols '())) #t)

(test (apply abs '(-1)) 1)
(test (apply boolean? '(#f)) #t)
(test (apply car '((a . b))) 'a)
(test (apply cdr '((a . b))) 'b)
(test (apply caar '(((a . b) . (c . d)))) 'a)
(test (apply cadr '(((a . b) . (c . d)))) 'c)
(test (apply cdar '(((a . b) . (c . d)))) 'b)
(test (apply cddr '(((a . b) . (c . d)))) 'd)
(test (apply caaar (list tree)) '(1 . 2))
(test (apply caadr (list tree)) '(9 . 10))
(test (apply cadar (list tree)) '(5 . 6))
(test (apply caddr (list tree)) '(13 . 14))
(test (apply cdaar (list tree)) '(3 . 4))
(test (apply cdadr (list tree)) '(11 . 12))
(test (apply cddar (list tree)) '(7 . 8))
(test (apply cdddr (list tree)) '(15 . 16))
(test (apply caaaar (list tree)) 1)
(test (apply caaadr (list tree)) 9)
(test (apply caadar (list tree)) 5)
(test (apply caaddr (list tree)) 13)
(test (apply cadaar (list tree)) 3)
(test (apply cadadr (list tree)) 11)
(test (apply caddar (list tree)) 7)
(test (apply cadddr (list tree)) 15)
(test (procedure? (apply call-with-current-continuation (list (lambda (x) x))))
      #t)
(test (procedure? (apply call/cc (list (lambda (x) x)))) #t)
(test (catch-tag? (apply catch (list (lambda (x) x)))) #t)
(test (apply catch-tag? (list (catch (lambda (x) x)))) #t)
(test (apply cdaaar (list tree)) 2)
(test (apply cdaadr (list tree)) 10)
(test (apply cdadar (list tree)) 6)
(test (apply cdaddr (list tree)) 14)
(test (apply cddaar (list tree)) 4)
(test (apply cddadr (list tree)) 12)
(test (apply cdddar (list tree)) 8)
(test (apply cddddr (list tree)) 16)
(test (apply ceiling '(2.3)) 3.0)
(test (apply char->integer '(#\A)) 65)
(test (apply char-alphabetic? '(#\M)) #t)
(test (apply char-downcase '(#\M)) #\m)
(test (apply char-lower-case? '(#\m)) #t)
(test (apply char-numeric? '(#\5)) #t)
(test (apply char-upper-case? '(#\M)) #t)
(test (apply char-upcase '(#\m)) '#\M)
(test (apply char-whitespace? '(#\space)) #t)
(test (apply char? '(#\A)) #t)
; close-input-port
; close-output-port
; delete-file
(test (apply eof-object? '(x)) #f)
; environment-variable
(test (apply eval '((+ 1 2))) 3)
(test (apply even? '(2)) #t)
(test (apply exact->inexact '(5)) 5.0)
(test (apply exact? '(1)) #t)
(test (apply exponent '(1.2)) -1)
; file-exists?
(test (apply floor '(0.5)) 0.0)
(test (apply inexact->exact '(1.0)) 1)
(test (apply inexact? '(1)) #f)
(test (apply input-port? `(,(current-input-port))) #t)
(test (apply integer->char '(65)) #\A)
(test (apply integer? '(5)) #t)
(test (apply length '((1 2 3))) 3)
(test (apply list->string '((#\f #\o #\b))) "fob")
(test (apply list->vector '((1 2 3))) '#(1 2 3))
; load
(test (apply negative? '(-1)) #t)
(test (apply not '(#f)) #t)
(test (apply null? '(())) #t)
(test (apply number? '(5)) #t)
(test (apply odd? '(3)) #t)
; open-append-file
; open-input-file
; open-output-file
(test (apply output-port? `(,(current-output-port))) #t)
(test (apply pair? `((a . b))) #t)
(test (apply positive? '(3)) #t)
(test (apply procedure? `(,(lambda (x) x))) #t)
(test (apply real? '(1.0)) #t)
(test (apply reverse '((1 2 3))) '(3 2 1))
(test (apply reverse! (list (list 1 2 3))) '(3 2 1))
; set-input-port!
; set-output-port!
(test (car (apply stats '((cons 1 2)))) '(1 . 2))
(test (apply string->list '("foo")) '(#\f #\o #\o))
(test (apply string->symbol '("foo")) 'foo)
(test (apply string-copy '("foo")) "foo")
(test (apply string-length '("foo")) 3)
(test (apply string? '("foo")) #t)
(test (apply symbol->string '(foo)) "foo")
(test (apply symbol? '(foo)) #t)
; system-command
(test (apply truncate '(5.7)) 5.0)
(test (apply vector->list '(#(foo bar baz))) '(foo bar baz))
(test (apply vector-length '(#(foo bar baz))) 3)
(test (apply vector? '(#(foo bar baz))) #t)
(test (apply zero? '(0)) #t)

(test (apply assq '(b ((a) (b) (c)))) '(b))
(test (apply assv '(2 ((1) (2) (3)))) '(2))
(test (apply char-ci<? '(#\A #\b)) #t)
(test (apply char-ci<=? '(#\A #\b)) #t)
(test (apply char-ci=? '(#\A #\b)) #f)
(test (apply char-ci>? '(#\A #\b)) #f)
(test (apply char-ci>=? '(#\A #\b)) #f)
(test (apply char<? '(#\a #\b)) #t)
(test (apply char<=? '(#\a #\b)) #t)
(test (apply char=? '(#\a #\b)) #f)
(test (apply char>? '(#\a #\b)) #f)
(test (apply char>=? '(#\a #\b)) #f)
(test (apply cons '(a b)) '(a . b))
(test (apply eq? '(x x)) #t)
(test (apply eqv? '(5 5)) #t)
(test (apply list-ref  '((1 2 3) 1)) 2)
(test (apply list-tail  '((1 2 3) 1)) '(2 3))
(test (apply quotient '(14 4)) 3)
(test (apply remainder '(14 4)) 2)
(test (let () (define x (cons 1 2)) (apply set-car! `(,x 0)) x) '(0 . 2))
(test (let () (define x (cons 1 2)) (apply set-cdr! `(,x 0)) x) '(1 . 0))
(test (apply string-ci<? '("foo" "BAR")) #f)
(test (apply string-ci<=? '("foo" "BAR")) #f)
(test (apply string-ci=? '("foo" "BAR")) #f)
(test (apply string-ci>? '("foo" "BAR")) #t)
(test (apply string-ci>=? '("foo" "BAR")) #t)
(test (apply string<? '("foo" "bar")) #f)
(test (apply string<=? '("foo" "bar")) #f)
(test (apply string=? '("foo" "bar")) #f)
(test (apply string>? '("foo" "bar")) #t)
(test (apply string>=? '("foo" "bar")) #t)
(test (apply string? '("foo")) #t)
(test (let () (define x (string-copy "foo"))
              (apply string-fill! `(,x #\x))
              x)
      "xxx")
(test (apply string-ref '("abc" 1)) #\b)
(test (catch (lambda (x) (apply throw (list x 'foo)))) 'foo)
(test (let () (define x (vector 1 2 3))
              (apply vector-fill! `(,x zzz))
              x)
      '#(zzz zzz zzz))
(test (apply vector-ref '(#(a b c) 1)) 'b)

(test (let () (define x (string-copy "foo"))
              (apply string-set! `(,x 2 #\b))
              x)
      "fob")
(test (let () (define x (vector 'b 'a 'r))
              (apply vector-set! `(,x 2 z))
              x)
      '#(b a z))
(test (apply substring '("abcdef" 2 4)) "cd")

; read
; read-char
; peek-char

; display
; error
; write
; write-char

(test (string-length (apply make-string '(10))) 10)
(test (apply make-string '(10 #\x)) "xxxxxxxxxx")
(test (vector-length (apply make-vector '(10))) 10)
(test (apply make-vector '(10 x)) '#(x x x x x x x x x x))

(test (apply vector-copy '(#(1 2 3))) '#(1 2 3))
(test (apply vector-copy '(#(1 2 3) 2)) '#(3))
(test (vector-length (apply vector-copy '(#(1 2 3) 2 5))) 3)
(test (apply vector-copy '(#(1 2 3) 2 5 x)) '#(3 x x))

(test (apply + '()) 0)
(test (apply + '(1)) 1)
(test (apply + '(1 2)) 3)
(test (apply + '(1 2 3 4 5)) 15)
(test (apply * '()) 1)
(test (apply * '(2)) 2)
(test (apply * '(2 3)) 6)
(test (apply * '(1 2 3 4 5)) 120)
(test (apply append '()) ())
(test (apply append '(foo)) 'foo)
(test (apply append '((foo) (bar))) '(foo bar))
(test (apply append '((foo) (bar) (baz))) '(foo bar baz))
(test (apply string-append '()) "")
(test (apply string-append '("foo")) "foo")
(test (apply string-append '("foo" "bar")) "foobar")
(test (apply string-append '("foo" "-" "bar" "-" "baz")) "foo-bar-baz")
(test (apply vector-append '()) '#())
(test (apply vector-append '(#(foo))) '#(foo))
(test (apply vector-append '(#(foo) #(bar))) '#(foo bar))
(test (apply vector-append '(#(foo) #(bar) #(baz))) '#(foo bar baz))

(test (apply / '(2)) 0.5)
(test (apply / '(2 5)) 0.4)
(test (apply / '(2 5 4)) 0.1)
(test (apply - '(1)) -1)
(test (apply - '(1 2)) -1)
(test (apply - '(1 2 3 4 5)) -13)
(test (apply bit-op '(7 1 2 4 8)) 15)
(test (apply max '(1)) 1)
(test (apply max '(1 2)) 2)
(test (apply max '(1 3 2 5 4)) 5)
(test (apply min '(3)) 3)
(test (apply min '(2 3)) 2)
(test (apply min '(3 2 1 5 4)) 1)

(test (apply = '(1 1)) #t)
(test (apply = '(1 1 1)) #t)
(test (apply = '(1 1 1 1 1)) #t)
(test (apply < '(1 2)) #t)
(test (apply < '(1 2 3)) #t)
(test (apply < '(1 2 3 4 5)) #t)
(test (apply <= '(1 2)) #t)
(test (apply <= '(1 2 2)) #t)
(test (apply <= '(1 2 3 3 5)) #t)
(test (apply > '(2 1)) #t)
(test (apply > '(3 2 1)) #t)
(test (apply > '(5 4 3 2 1)) #t)
(test (apply >= '(2 1)) #t)
(test (apply >= '(3 2 2)) #t)
(test (apply >= '(5 4 4 2 1)) #t)

(test (apply apply `(,cons (a b))) '(a . b))
(test (apply apply `(,list a b (c d))) '(a b c d))

; === Beginning of R4RS tests ===

; R4RS tests, 6.1 booleans

(test #t #t)
(test #f #f)
(test '#f #f)

(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)

; R4RS tests, 6.2 equivalence predicates

(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 (let ((p (lambda (x) x)))
        (eqv? p p))
      #t)

(define gen-counter
  (lambda ()
    (let ((n 0))
      (lambda () (set! n (+ n 1)) n))))
(test (let ((g (gen-counter)))
        (eqv? g g))
      #t)
(test (eqv? (gen-counter) (gen-counter)) #f)

(define gen-loser
  (lambda ()
    (let ((n 0))
      (lambda () (set! n (+ n 1)) 27))))
(test (let ((g (gen-loser)))
        (eqv? g g))
      #t)

(test (letrec ((f (lambda () (if (eqv? f g) 'f 'both)))
               (g (lambda () (if (eqv? f g) 'g 'both))))
        (eqv? (f) (g)))
      #t)

(test (let ((x '(a)))
        (eqv? x x))
      #t)

(test (eq? 'a 'a) #t)
(test (eq? (list 'a) (list 'a)) #f)
(test (eq? '() '()) #t)
(test (eq? car car) #t)
(test (let ((x '(a)))
        (eq? x x))
      #t)
(test (let ((x '#()))
        (eq? x x))
      #t)
(test (let ((p (lambda (x) x)))
        (eq? p p))
      #t)

(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)

; R4RS tests, 6.3 pairs and lists

(test '(a . (b . (c . (d . (e . ()))))) '(a b c d e))

(test '(a . (b . (c . d))) '(a b c . d))

(define x (list 'a 'b 'c))
(define y x)
(test y '(a b c))
(test (list? y) #t)
(set-cdr! x 4)
(test x '(a . 4))
(test (eqv? x y) #t)
(test y '(a . 4))
(test (list? y) #f)
(set-cdr! x x)
(test (list? x) #f)

(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 (cdr '((a) b c d)) '(b c d))
(test (cdr '(1 . 2)) 2)

(define x (list 'not-a-constant-list))
(set-car! x 3)
(test x '(3))

(test (list? '(a b c)) #t)
(test (list? '()) #t)
(test (list? '(a . b)) #f)
(test (let ((x (list 'a)))
        (set-cdr! x x)
        (list? x))
      #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-ref '(a b c d) 2) 'c)

(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 (memv 101 '(100 101 102)) '(101 102))

(define 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 (assv 5 '((2 3) (5 7) (11 13))) '(5 7))

; R4RS tests, 6.4 symbols

(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->string 'flying-fish) "flying-fish")
(test (symbol->string 'Martin) "martin")
(test (symbol->string (string->symbol "Malvina")) "Malvina")

(test (eq? 'mISSISSIppi 'mississippi) #t)
(test (eq? 'bitBlt (string->symbol "bitBlt")) #f)
(test (eq? 'JollyWog (string->symbol (symbol->string 'JollyWog))) #t)
(test (string=? "K. Harper, M.D."
                (symbol->string (string->symbol "K. Harper, M.D.")))
      #t)

; R4RS tests, 6.5 numbers

(test (max 3 4) 4)

(test (+ 3 4) 7)
(test (+ 3) 3)
(test (+) 0)
(test (* 4) 4)
(test (*) 1)

(test (- 3 4) -1)
(test (- 3 4 5) -6)
(test (- 3) -3)

(test (abs -7) 7)

(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 (gcd 32 -36) 4)
(test (gcd) 0)
(test (lcm 32 -36) 288)
(test (lcm) 1)

(test (string->number "100") 100)
(test (string->number "100" 16) 256)

; R4RS tests, 6.6 characters

(test #\a #\a)
(test #\A #\A)
(test #\( #\()
(test #\  #\space)
(test #\space #\space)
(test #\newline #\newline)

; R4RS tests, 6.7 strings

(test "The word \"recursion\" has many meanings."
      "The word \"recursion\" has many meanings.")

(define s (make-string 3 #\*))
(string-set! s 0 #\?)
(test s "?**")

; R4RS tests, 6.8 vectors

(test '#(0 (2 2 2 2) "Anna")  #(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 (vector->list '#(dah dah didah)) '(dah dah didah))
(test (list->vector '(dididit dah)) '#(dididit dah))

; R4RS tests, 6.9 control features

(test (procedure? car) #t)
(test (procedure? 'car) #f)
(test (procedure? (lambda (x) (* x x))) #t)
(test (procedure? '(lambda (x) (* x x))) #f)

(test (apply + (list 3 4)) 7)

(define compose
  (lambda (f g)
    (lambda args
      (f (apply g args)))))

(define (isqrt square)
  (letrec
    ((sqrt2 (lambda (x last)
       (cond ((= last x)
               x)
             ((= last (+ 1 x))
               (if (> (* x x) square) (- x 1) x))
             (else
               (sqrt2 (quotient
                         (+ x (quotient square x))
                         2)
                      x))))))
    (sqrt2 square 0)))

(test ((compose isqrt *) 12 75) 30)

(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 (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 (force (delay (+ 1 2))) 3)
(test (let ((p (delay (+ 1 2))))
        (list (force p) (force p)))  
      '(3 3))

(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))))

(test (head (tail (tail a-stream))) 2)

(define count 0)
(define p
  (delay (begin (set! count (+ count 1))
                (if (> count x)
                    count
                    (force p)))))
(define x 5)
(test (force p) 6)
(test (begin (set! x 10)
             (force p))
      6)

(test (call-with-current-continuation
        (lambda (exit)
          (for-each (lambda (x)
                      (if (negative? x)
                          (exit x)))
                    '(54 0 37 -3 245 19))
          #t))
      -3)

(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))))))

(test (list-length '(1 2 3 4)) 4)
(test (list-length '(a b . c)) #f)

; === End of R4RS tests ===

(cond ((zero? Errors)
        (display "Everything fine!"))
      (else
        (display Errors)
        (if (> Errors 1)
            (display " errors.")
            (display " error."))))
(display #\newline)

(if (file-exists? testfile) (delete-file testfile))