; Scheme 9 from Empty Space
; Test Suite
; By Nils M Holm, 2007-2012

;  This is a comment

#| This is a block comment |#

#| Nested #| block |# comment |#

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

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

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

(define testfile "__testfile__")

(if (file-exists? testfile)
    (error (string-append "Please delete the file \""
                          testfile
                          "\" before running this test.")))

(define Errors 0)

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

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

(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)
;  (write expr) (display " => ") (write result) (newline)
  (if (not (equal? result expected))
      (fail expr result expected)))

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

; --- syntax ---

; symbols

(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 -- erm, well

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

; numbers -- 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)

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

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

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

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

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

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

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

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

; --- setters ---

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

(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? '(pair)) #f)
(test (boolean? (lambda () #f)) #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 (boolean? let) #f)

(test (char? #f) #f)
(test (char? #\c) #t)
(test (char? 1) #f)
(test (char? '(pair)) #f)
(test (char? (lambda () #f)) #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 (char? let) #f)

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

(test (integer? #f) #f)
(test (integer? #\c) #f)
(test (integer? 1) #t)
(test (integer? '(pair)) #f)
(test (integer? (lambda () #f)) #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 (integer? let) #f)

(test (number? #f) #f)
(test (number? #\c) #f)
(test (number? 1) #t)
(test (number? '(pair)) #f)
(test (number? (lambda () #f)) #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 (number? let) #f)

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

(test (pair? #f) #f)
(test (pair? #\c) #f)
(test (pair? 1) #f)
(test (pair? '(pair)) #t)
(test (pair? (lambda () #f)) #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 (pair? let) #f)

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

(test (procedure? #f) #f)
(test (procedure? #\c) #f)
(test (procedure? 1) #f)
(test (procedure? '(procedure)) #f)
(test (procedure? (lambda () #f)) #t)
(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 (procedure? let) #f)

(test (string? #f) #f)
(test (string? #\c) #f)
(test (string? 1) #f)
(test (string? '(pair)) #f)
(test (string? (lambda () #f)) #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 (string? let) #f)

(test (symbol? #f) #f)
(test (symbol? #\c) #f)
(test (symbol? 1) #f)
(test (symbol? '(pair)) #f)
(test (symbol? (lambda () #f)) #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 (symbol? let) #f)

(test (vector? #f) #f)
(test (vector? #\c) #f)
(test (vector? 1) #f)
(test (vector? '(pair)) #f)
(test (vector? (lambda () #f)) #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)
(test (vector? let) #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 '#()) '())

; --- more control ---

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

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

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

; Oops, broke it!
;
;(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)

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

(test (do () (#t 123)) 123)
(test (do () (#t)) (void))
(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)

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

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

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

; --- 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 ---

(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 '(x) '(((x) . x))) #f)
(test (assv "x" '(("x" . 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)
(test (assq '(x) '(((x) . x))) #f)
(test (assq "x" '(("x" . 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 '(x) '((x))) #f)
(test (memv "x" '("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 (memq '(x) '((x))) #f)
(test (memq "x" '("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 '()) '())

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

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

; --- s9fes bit ops ---

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

; --- equivalence ---

(test (eq? 'x 'x) #t)
(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? (lambda () #f) (lambda () #f)) #f)
(test (eq? "string" "string") #f)
(test (eq? 'symbol 'symbol) #t)
(test (eq? (vector 'vector) (vector 'vector)) #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? (lambda () #f) (lambda () #f)) #f)
(test (eqv? "string" "string") #f)
(test (eqv? 'symbol 'symbol) #t)
(test (eqv? (vector 'vector) (vector 'vector)) #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 (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)

; --- chars ---

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

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

; --- I/O ---

(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)
      '()
      (cons (fn lo) (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.h
(let ((NFILES 100))
  (test (letrec
          ((open
             (lambda (n)
               (open-input-file testfile)
               (if (< n 1)
                   'okay
                   (open (- n 1))))))
          (open NFILES))
        'okay))

; === 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))
