r7rs.scm

;; -*- coding: utf-8 -*-

(import (scheme base)
;        (scheme char)
        (scheme lazy)
        (scheme inexact)
;        (scheme complex)
        (scheme time)
        (scheme file)
;        (scheme read)
        (scheme write)
;        (scheme eval)
        (scheme process-context)
;        (scheme case-lambda)
        )

;; R7RS test suite.  Covers all procedures and syntax in the small
;; language except `delete-file'.  Currently assumes full-unicode
;; support, the full numeric tower and all standard libraries
;; provided.
;;
;; Uses the (chibi test) library which is written in portable R7RS.
;; This is mostly a subset of SRFI-64, providing test-begin, test-end
;; and test, which could be defined as something like:
;;
(define (test-begin . o) #f)

(define (test-end . o) #f)

(define counter 1)

(define-syntax test
  (syntax-rules ()
    ((test expected expr)
     (let ((res expr))
       (display "case ")
       (write counter)
       (cond
        ((equal? res expected)
         (display " PASS: ")
         (write 'expr)
         (display " equals ")
         (write expected)
         (display "")
         (newline)
         )
        ((not (equal? res expected))
         (display " FAIL: ")
         (write 'expr)
         (newline)
         (display "   expected ")
         (write expected)
         (display " but got ")
         (write res)
         (display "")
         (newline)))
       (set! counter (+ counter 1))))))
;;
;; however (chibi test) provides nicer output, timings, and
;; approximate equivalence for floating point numbers.

(newline)

(test-begin "R7RS")

(test-begin "4.1 Primitive expression types")

(let ()
  (define x 28)
  (test 28 x))

(test 'a (quote a))
(test #(a b c) (quote #(a b c)))
(test '(+ 1 2) (quote (+ 1 2)))

(test 'a 'a)
(test #(a b c) '#(a b c))
(test '() '())
(test '(+ 1 2) '(+ 1 2))
(test '(quote a) '(quote a))
(test '(quote a) ''a)

(test "abc" '"abc")
(test "abc" "abc")
(test 145932 '145932)
(test 145932 145932)
(test #t '#t)
(test #t #t)

(test 7 (+ 3 4))
(test 12 ((if #f + *) 3 4))

(test 8 ((lambda (x) (+ x x)) 4))
(define reverse-subtract
  (lambda (x y) (- y x)))
(test 3 (reverse-subtract 7 10))
(define add4
  (let ((x 4))
    (lambda (y) (+ x y))))
(test 10 (add4 6))

(test '(3 4 5 6) ((lambda x x) 3 4 5 6))
(test '(5 6) ((lambda (x y . z) z)
 3 4 5 6))

(test 'yes (if (> 3 2) 'yes 'no))
(test 'no (if (> 2 3) 'yes 'no))
(test 1 (if (> 3 2)
    (- 3 2)
    (+ 3 2)))
(let ()
  (define x 2)
  (test 3 (+ x 1)))

(test-end)

(test-begin "4.2 Derived expression types")

(test 'greater
    (cond ((> 3 2) 'greater)
          ((< 3 2) 'less)))

(test 'equal
    (cond ((> 3 3) 'greater)
          ((< 3 3) 'less)
          (else 'equal)))

(test 2
    (cond ((assv 'b '((a 1) (b 2))) => cadr)
          (else #f)))

(test 'composite
    (case (* 2 3)
      ((2 3 5 7) 'prime)
      ((1 4 6 8 9) 'composite)))

(test 'c
    (case (car '(c d))
      ((a e i o u) 'vowel)
      ((w y) 'semivowel)
      (else => (lambda (x) x))))

(test '((other . z) (semivowel . y) (other . x)
        (semivowel . w) (vowel . u))
    (map (lambda (x)
           (case x
             ((a e i o u) => (lambda (w) (cons 'vowel w)))
             ((w y) (cons 'semivowel x))
             (else => (lambda (w) (cons 'other w)))))
         '(z y x w u)))

(test #t (and (= 2 2) (> 2 1)))
(test #f (and (= 2 2) (< 2 1)))
(test '(f g) (and 1 2 'c '(f g)))
(test #t (and))

(test #t (or (= 2 2) (> 2 1)))
(test #t (or (= 2 2) (< 2 1)))
(test #f (or #f #f #f))
(test '(b c) (or (memq 'b '(a b c))
    (/ 3 0)))

(test 6 (let ((x 2) (y 3))
  (* x y)))

(test 35 (let ((x 2) (y 3))
  (let ((x 7)
        (z (+ x y)))
    (* z x))))

(test 70 (let ((x 2) (y 3))
  (let* ((x 7)
         (z (+ x y)))
    (* z x))))

(test #t
    (letrec ((even?
              (lambda (n)
                (if (zero? n)
                    #t
                    (odd? (- n 1)))))
             (odd?
              (lambda (n)
                (if (zero? n)
                    #f
                    (even? (- n 1))))))
      (even? 88)))

(test 5
    (letrec* ((p
               (lambda (x)
                 (+ 1 (q (- x 1)))))
              (q
               (lambda (y)
                 (if (zero? y)
                     0
                     (+ 1 (p (- y 1))))))
              (x (p 5))
              (y x))
             y))

;; By Jussi Piitulainen <jpiitula@ling.helsinki.fi>
;; and John Cowan <cowan@mercury.ccil.org>:
;; http://lists.scheme-reports.org/pipermail/scheme-reports/2013-December/003876.html

(define (means ton)
  (letrec*
     ((mean
        (lambda (f g)
          (f (/ (sum g ton) n))))
      (sum
        (lambda (g ton)
          (if (null? ton)
            (+)
            (if (number? ton)
                (g ton)
                (+ (sum g (car ton))
                   (sum g (cdr ton)))))))
      (n (sum (lambda (x) 1) ton)))
    (values (mean values values)
            (mean exp log)
            (mean / /))))
(let*-values (((a b c) (means '(8 5 99 1 22))))
  (test 27 a)
  (test 9.728 b)
  (test (/ 1800 497) c))

(let*-values (((root rem) (exact-integer-sqrt 32)))
  (test 35 (* root rem)))

(test '(1073741824 0)
    (let*-values (((root rem) (exact-integer-sqrt (expt 2 60))))
      (list root rem)))

(test '(1518500249 3000631951)
    (let*-values (((root rem) (exact-integer-sqrt (expt 2 61))))
      (list root rem)))

(test '(815238614083298888 443242361398135744)
    (let*-values (((root rem) (exact-integer-sqrt (expt 2 119))))
      (list root rem)))

(test '(1152921504606846976 0)
    (let*-values (((root rem) (exact-integer-sqrt (expt 2 120))))
      (list root rem)))

(test '(1630477228166597776 1772969445592542976)
    (let*-values (((root rem) (exact-integer-sqrt (expt 2 121))))
      (list root rem)))

(test '(31622776601683793319 62545769258890964239)
    (let*-values (((root rem) (exact-integer-sqrt (expt 10 39))))
      (list root rem)))

(let*-values (((root rem) (exact-integer-sqrt (expt 2 140))))
  (test 0 rem)
  (test (expt 2 140) (square root)))

(test '(x y x y) (let ((a 'a) (b 'b) (x 'x) (y 'y))
  (let*-values (((a b) (values x y))
                ((x y) (values a b)))
    (list a b x y))))

(let ()
  (define x 0)
  (set! x 5)
  (test 6 (+ x 1)))

(test #(0 1 2 3 4) (do ((vec (make-vector 5))
     (i 0 (+ i 1)))
    ((= i 5) vec)
  (vector-set! vec i i)))

(test 25 (let ((x '(1 3 5 7 9)))
  (do ((x x (cdr x))
       (sum 0 (+ sum (car x))))
      ((null? x) sum))))

(test '((6 1 3) (-5 -2))
    (let loop ((numbers '(3 -2 1 6 -5))
               (nonneg '())
               (neg '()))
      (cond ((null? numbers) (list nonneg neg))
            ((>= (car numbers) 0)
             (loop (cdr numbers)
                   (cons (car numbers) nonneg)
                   neg))
            ((< (car numbers) 0)
             (loop (cdr numbers)
                   nonneg
                   (cons (car numbers) neg))))))

(test 3 (force (delay (+ 1 2))))

(test '(3 3)  
    (let ((p (delay (+ 1 2))))
      (list (force p) (force p))))

(define integers
  (letrec ((next
            (lambda (n)
              (delay (cons n (next (+ n 1)))))))
    (next 0)))
(define head
  (lambda (stream) (car (force stream))))
(define tail
  (lambda (stream) (cdr (force stream))))

(test 2 (head (tail (tail integers))))

(define (stream-filter p? s)
  (delay-force
   (if (null? (force s)) 
       (delay '())
       (let ((h (car (force s)))
             (t (cdr (force s))))
         (if (p? h)
             (delay (cons h (stream-filter p? t)))
             (stream-filter p? t))))))

(test 5 (head (tail (tail (stream-filter odd? integers)))))

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

(test #t (promise? (delay (+ 2 2))))
(test #t (promise? (make-promise (+ 2 2))))
(test #t
    (let ((x (delay (+ 2 2))))
      (force x)
      (promise? x)))

(test #t
      (let ((x (make-promise (+ 2 2))))
        (force x)
        (promise? x)))




;; (define radix
;;   (make-parameter
;;    10
;;    (lambda (x)
;;      (if (and (integer? x) (<= 2 x 16))
;;          x
;;          (error "invalid radix")))))
;; (define (f n) (number->string n (radix)))
;; (test "12" (f 12))
;; (test "1100" (parameterize ((radix 2))
;;                            (f 12)))
;; (test "12" (f 12))
(test '(list 3 4) `(list ,(+ 1 2) 4))
(let ((name 'a)) (test '(list a (quote a)) `(list ,name ',name)))
(test '(a 3 4 5 6 b) `(a ,(+ 1 2) ,@(map abs '(4 -5 6)) b))
(test #(10 5 4 16 9 8)
    `#(10 5 ,(square 2) ,@(map square '(4 3)) 8))
(test '(a `(b ,(+ 1 2) ,(foo 4 d) e) f)
    `(a `(b ,(+ 1 2) ,(foo ,(+ 1 3) d) e) f) )
(let ((name1 'x)
      (name2 'y))
   (test '(a `(b ,x ,'y d) e) `(a `(b ,,name1 ,',name2 d) e)))
(test '(list 3 4) (quasiquote (list (unquote (+ 1 2)) 4)) )
(test `(list ,(+ 1 2) 4) (quasiquote (list (unquote (+ 1 2)) 4)))

;; (define plus
;;   (case-lambda 
;;    (() 0)
;;    ((x) x)
;;    ((x y) (+ x y))
;;    ((x y z) (+ (+ x y) z))
;;    (args (apply + args))))

;; (test 0 (plus))
;; (test 1 (plus 1))
;; (test 3 (plus 1 2))
;; (test 6 (plus 1 2 3))
;; (test 10 (plus 1 2 3 4))

;; (define mult
;;   (case-lambda 
;;    (() 1)
;;    ((x) x)
;;    ((x y) (* x y))
;;    ((x y . z) (apply mult (* x y) z))))

;; (test 1 (mult))
;; (test 1 (mult 1))
;; (test 2 (mult 1 2))
;; (test 6 (mult 1 2 3))
;; (test 24 (mult 1 2 3 4))

(test-end)

(test-begin "4.3 Macros")

;; (test 'now (let-syntax
;;                ((when (syntax-rules ()
;;                         ((when test stmt1 stmt2 ...)
;;                          (if test
;;                              (begin stmt1
;;                                     stmt2 ...))))))
;;              (let ((if #t))
;;                (when if (set! if 'now))
;;                if)))

;; (test 'outer (let ((x 'outer))
;;   (let-syntax ((m (syntax-rules () ((m) x))))
;;     (let ((x 'inner))
;;       (m)))))

;; (test 7 (letrec-syntax
;;   ((my-or (syntax-rules ()
;;             ((my-or) #f)
;;             ((my-or e) e)
;;             ((my-or e1 e2 ...)
;;              (let ((temp e1))
;;                (if temp
;;                    temp
;;                    (my-or e2 ...)))))))
;;   (let ((x #f)
;;         (y 7)
;;         (temp 8)
;;         (let odd?)
;;         (if even?))
;;     (my-or x
;;            (let temp)
;;            (if y)
;;            y))))

(define-syntax be-like-begin
  (syntax-rules ()
    ((be-like-begin name)
     (define-syntax name
       (syntax-rules ()
         ((name expr (... ...))
          (begin expr (... ...))))))))
(be-like-begin sequence)
(test 4 (sequence 1 2 3 4))

(define-syntax jabberwocky
  (syntax-rules ()
    ((_ hatter)
     (begin
       (define march-hare 42)
       (define-syntax hatter
         (syntax-rules ()
           ((_) march-hare)))))))
(jabberwocky mad-hatter)
(test 42 (mad-hatter))

(test 'ok (let ((=> #f)) (cond (#t => 'ok))))

(test-end)

(test-begin "5 Program structure")

(define add3
  (lambda (x) (+ x 3)))
(test 6 (add3 3))
(define first car)
(test 1 (first '(1 2)))

;; (test 45 (let ((x 5))
;;   (define foo (lambda (y) (bar x y)))
;;   (define bar (lambda (a b) (+ (* a b) a)))
;;   (foo (+ x 3))))

(test 'ok
    (let ()
      (define-values () (values))
      'ok))
(test 1
    (let ()
      (define-values (x) (values 1))
      x))
;; (test 3
;;     (let ()
;;       (define-values x (values 1 2))
;;       (apply + x)))
(test 3
    (let ()
      (define-values (x y) (values 1 2))
      (+ x y)))
(test 6
    (let ()
      (define-values (x y z) (values 1 2 3))
      (+ x y z)))
;; (test 10
;;     (let ()
;;       (define-values (x y . z) (values 1 2 3 4))
;;       (+ x y (car z) (cadr z))))

(test '(2 1) (let ((x 1) (y 2))
  (define-syntax swap!
    (syntax-rules ()
      ((swap! a b)
       (let ((tmp a))
         (set! a b)
         (set! b tmp)))))
  (swap! x y)
  (list x y)))

;; Records

(define-record-type <pare>
  (kons x y)
  pare?
  (x kar set-kar!)
  (y kdr))

(test #t (pare? (kons 1 2)))
(test #f (pare? (cons 1 2)))
(test 1 (kar (kons 1 2)))
(test 2 (kdr (kons 1 2)))
(test 3 (let ((k (kons 1 2)))
          (set-kar! k 3)
          (kar k)))

(test-end)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; 6 Standard Procedures

(test-begin "6.1 Equivalence Predicates")

(test #t (eqv? 'a 'a))
(test #f (eqv? 'a 'b))
(test #t (eqv? 2 2))
(test #t (eqv? '() '()))
(test #t (eqv? 100000000 100000000))
(test #f (eqv? (cons 1 2) (cons 1 2)))
(test #f (eqv? (lambda () 1)
               (lambda () 2)))
(test #f (eqv? #f 'nil))

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

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

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

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

(test #t (equal? 'a 'a))
(test #t (equal? '(a) '(a)))
(test #t (equal? '(a (b) c)
                 '(a (b) c)))
(test #t (equal? "abc" "abc"))
(test #t (equal? 2 2))
(test #t (equal? (make-vector 5 'a)
                 (make-vector 5 'a)))

(test-end)

(test-begin "6.2 Numbers")

;; (test #t (complex? 3+4i))
(test #t (complex? 3))
(test #t (real? 3))
;; (test #t (real? -2.5+0i))
;; (test #f (real? -2.5+0.0i))
;; (test #t (real? #e1e10))
(test #t (real? +inf.0))
(test #f (rational? -inf.0))
;; (test #t (rational? 6/10))
;; (test #t (rational? 6/3))
;; (test #t (integer? 3+0i))
(test #t (integer? 3.0))
;; (test #t (integer? 8/4))

(test #f (exact? 3.0))
;; (test #t (exact? #e3.0))
;; (test #t (inexact? 3.))

(test #t (exact-integer? 32))
(test #f (exact-integer? 32.0))
;; (test #f (exact-integer? 32/5))

(test #t (finite? 3))
(test #f (finite? +inf.0))
;; (test #f (finite? 3.0+inf.0i))

(test #f (infinite? 3))
(test #t (infinite? +inf.0))
(test #f (infinite? +nan.0))
;; (test #t (infinite? 3.0+inf.0i))

(test #t (nan? +nan.0))
(test #f (nan? 32))
;; (test #t (nan? +nan.0+5.0i))
;; (test #f (nan? 1+2i))

;; (test #t (= 1 1.0 1.0+0.0i))
;; (test #f (= 1.0 1.0+1.0i))
;; (test #t (< 1 2 3))
;; (test #f (< 1 1 2))
;; (test #t (> 3.0 2.0 1.0))
;; (test #f (> -3.0 2.0 1.0))
;; (test #t (<= 1 1 2))
;; (test #f (<= 1 2 1))
;; (test #t (>= 2 1 1))
;; (test #f (>= 1 2 1))

;; From R7RS 6.2.6 Numerical operations:
;;
;; These predicates are required to be transitive.
;;
;; _Note:_ The traditional implementations of these predicates in
;; Lisp-like languages, which involve converting all arguments to inexact
;; numbers if any argument is inexact, are not transitive.

;; Example from Alan Bawden
(let ((a (- (expt 2 1000) 1))
      (b (inexact (expt 2 1000))) ; assuming > single-float-epsilon
      (c (+ (expt 2 1000) 1)))
  (test #t (if (and (= a b) (= b c))
               (= a c)
               #t)))

;; From CLtL 12.3. Comparisons on Numbers:
;;
;;  Let _a_ be the result of (/ 10.0 single-float-epsilon), and let
;;  _j_ be the result of (floor a). ..., all of (<= a j), (< j (+ j
;;  1)), and (<= (+ j 1) a) would be true; transitivity would then
;;  imply that (< a a) ought to be true ...

;; Transliteration from Jussi Piitulainen
(define single-float-epsilon
  (do ((eps 1.0 (* eps 2.0)))
      ((= eps (+ eps 1.0)) eps)))

(let* ((a (/ 10.0 single-float-epsilon))
       (j (exact a)))
  (test #t (if (and (<= a j) (< j (+ j 1)))
               (not (<= (+ j 1) a))
               #t)))

(test #t (zero? 0))
(test #t (zero? 0.0))
;; (test #t (zero? 0.0+0.0i))
(test #f (zero? 1))
(test #f (zero? -1))

(test #f (positive? 0))
(test #f (positive? 0.0))
(test #t (positive? 1))
(test #t (positive? 1.0))
(test #f (positive? -1))
(test #f (positive? -1.0))
(test #t (positive? +inf.0))
(test #f (positive? -inf.0))

(test #f (negative? 0))
(test #f (negative? 0.0))
(test #f (negative? 1))
(test #f (negative? 1.0))
(test #t (negative? -1))
(test #t (negative? -1.0))
(test #f (negative? +inf.0))
(test #t (negative? -inf.0))

(test #f (odd? 0))
(test #t (odd? 1))
(test #t (odd? -1))
(test #f (odd? 102))

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

(test 3 (max 3))
(test 4 (max 3 4))
(test 4.0 (max 3.9 4))
(test 5.0 (max 5 3.9 4))
(test +inf.0 (max 100 +inf.0))
(test 3 (min 3))
(test 3 (min 3 4))
(test 3.0 (min 3 3.1))
(test -inf.0 (min -inf.0 -100))

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

(test -1 (- 3 4))
(test -6 (- 3 4 5))
(test -3 (- 3))
;; (test 3/20 (/ 3 4 5))
;; (test 1/3 (/ 3))

(test 7 (abs -7))
(test 7 (abs 7))

;; (test-values (values 2 1) (floor/ 5 2))
;; (test-values (values -3 1) (floor/ -5 2))
;; (test-values (values -3 -1) (floor/ 5 -2))
;; (test-values (values 2 -1) (floor/ -5 -2))
;; (test-values (values 2 1) (truncate/ 5 2))
;; (test-values (values -2 -1) (truncate/ -5 2))
;; (test-values (values -2 1) (truncate/ 5 -2))
;; (test-values (values 2 -1) (truncate/ -5 -2))
;; (test-values (values 2.0 -1.0) (truncate/ -5.0 -2))

(test 1 (modulo 13 4))
(test 1 (remainder 13 4))

(test 3 (modulo -13 4))
(test -1 (remainder -13 4))

(test -3 (modulo 13 -4))
(test 1 (remainder 13 -4))

(test -1 (modulo -13 -4))
(test -1 (remainder -13 -4))

(test -1.0 (remainder -13 -4.0))

(test 4 (gcd 32 -36))
(test 0 (gcd))
(test 288 (lcm 32 -36))
(test 288.0 (lcm 32.0 -36))
(test 1 (lcm))

;; (test 3 (numerator (/ 6 4)))
;; (test 2 (denominator (/ 6 4)))
;; (test 2.0 (denominator (inexact (/ 6 4))))
;; (test 11.0 (numerator 5.5))
;; (test 2.0 (denominator 5.5))
;; (test 5.0 (numerator 5.0))
;; (test 1.0 (denominator 5.0))

(test -5.0 (floor -4.3))
(test -4.0 (ceiling -4.3))
(test -4.0 (truncate -4.3))
(test -4.0 (round -4.3))

(test 3.0 (floor 3.5))
(test 4.0 (ceiling 3.5))
(test 3.0 (truncate 3.5))
(test 4.0 (round 3.5))

;; (test 4 (round 7/2))
(test 7 (round 7))

;; (test 1/3 (rationalize (exact .3) 1/10))
;; (test #i1/3 (rationalize .3 1/10))

(test 1.0 (inexact (exp 0))) ;; may return exact number
(test 20.0855369231877 (exp 3))

(test 0.0 (inexact (log 1))) ;; may return exact number
(test 1.0 (log (exp 1)))
(test 42.0 (log (exp 42)))
(test 2.0 (log 100 10))
(test 12.0 (log 4096 2))

(test 0.0 (inexact (sin 0))) ;; may return exact number
(test 1.0 (sin 1.5707963267949))
(test 1.0 (inexact (cos 0))) ;; may return exact number
(test -1.0 (cos 3.14159265358979))
(test 0.0 (inexact (tan 0))) ;; may return exact number
(test 1.5574077246549 (tan 1))

(test 0.0 (asin 0))
(test 1.5707963267949 (asin 1))
(test 0.0 (acos 1))
(test 3.14159265358979 (acos -1))

(test 0.0 (atan 0.0 1.0))
(test -0.0 (atan -0.0 1.0))
(test 0.785398163397448 (atan 1.0 1.0))
(test 1.5707963267949 (atan 1.0 0.0))
(test 2.35619449019234 (atan 1.0 -1.0))
(test 3.14159265358979 (atan 0.0 -1.0))
(test -3.14159265358979 (atan -0.0 -1.0)) ;
(test -2.35619449019234 (atan -1.0 -1.0))
(test -1.5707963267949 (atan -1.0 0.0))
(test -0.785398163397448 (atan -1.0 1.0))
;; (test undefined (atan 0.0 0.0))

(test 1764 (square 42))
(test 4 (square 2))

(test 3.0 (inexact (sqrt 9)))
(test 1.4142135623731 (sqrt 2))
;; (test 0.0+1.0i (inexact (sqrt -1)))

(test '(2 0) (call-with-values (lambda () (exact-integer-sqrt 4)) list))
(test '(2 1) (call-with-values (lambda () (exact-integer-sqrt 5)) list))

(test 27 (expt 3 3))
(test 1 (expt 0 0))
(test 0 (expt 0 1))
(test 1.0 (expt 0.0 0))
(test 0.0 (expt 0 1.0))

;; (test 1+2i (make-rectangular 1 2))

;; (test 0.54030230586814+0.841470984807897i (make-polar 1 1))

;; (test 1 (real-part 1+2i))

;; (test 2 (imag-part 1+2i))

;; (test 2.23606797749979 (magnitude 1+2i))

;; (test 1.10714871779409 (angle 1+2i))

(test 1.0 (inexact 1))
(test #t (inexact? (inexact 1)))
(test 1 (exact 1.0))
(test #t (exact? (exact 1.0)))

(test 100 (string->number "100"))
(test 256 (string->number "100" 16))
(test 100.0 (string->number "1e2"))

(test-end)

(test-begin "6.3 Booleans")

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

(test #f (not #t))
(test #f (not 3))
(test #f (not (list 3)))
(test #t (not #f))
(test #f (not '()))
(test #f (not (list)))
(test #f (not 'nil))

(test #t (boolean? #f))
(test #f (boolean? 0))
(test #f (boolean? '()))

(test #t (boolean=? #t #t))
(test #t (boolean=? #f #f))
(test #f (boolean=? #t #f))
(test #t (boolean=? #f #f #f))
(test #f (boolean=? #t #t #f))

(test-end)

(test-begin "6.4 Lists")

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

(test #t (pair? '(a . b)))
(test #t (pair? '(a b c)))
(test #f (pair? '()))
(test #f (pair? '#(a b)))

(test '(a) (cons 'a '()))
(test '((a) b c d) (cons '(a) '(b c d)))
(test '("a" b c) (cons "a" '(b c)))
(test '(a . 3) (cons 'a 3))
(test '((a b) . c) (cons '(a b) 'c))

(test 'a (car '(a b c)))
(test '(a) (car '((a) b c d)))
(test 1 (car '(1 . 2)))

(test '(b c d) (cdr '((a) b c d)))
(test 2 (cdr '(1 . 2)))
(define (g) '(constant-list))

(test #t (list? '(a b c)))
(test #t (list? '()))
(test #f (list? '(a . b)))
(test #f (let ((x (list 'a))) (set-cdr! x x) (list? x)))

(test '(3 3) (make-list 2 3))

(test '(a 7 c) (list 'a (+ 3 4) 'c))
(test '() (list))

(test 3 (length '(a b c)))
(test 3 (length '(a (b) (c d e))))
(test 0 (length '()))

(test '(x y) (append '(x) '(y)))
(test '(a b c d) (append '(a) '(b c d)))
(test '(a (b) (c)) (append '(a (b)) '((c))))

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

(test '(c b a) (reverse '(a b c)))
(test '((e (f)) d (b c) a) (reverse '(a (b c) d (e (f)))))

(test '(d e) (list-tail '(a b c d e) 3))

(test 'c (list-ref '(a b c d) 2))
(test 'c (list-ref '(a b c d)
          (exact (round 1.8))))

(test '(0 ("Sue" "Sue") "Anna")
    (let ((lst (list 0 '(2 2 2 2) "Anna")))
      (list-set! lst 1 '("Sue" "Sue"))
      lst))

(test '(a b c) (memq 'a '(a b c)))
(test '(b c) (memq 'b '(a b c)))
(test #f (memq 'a '(b c d)))
(test #f (memq (list 'a) '(b (a) c)))
(test '((a) c) (member (list 'a) '(b (a) c)))
;; (test '("b" "c") (member "B" '("a" "b" "c") string-ci=?))
(test '(101 102) (memv 101 '(100 101 102)))

(let ()
  (define e '((a 1) (b 2) (c 3)))
  (test '(a 1) (assq 'a e))
  (test '(b 2) (assq 'b e))
  (test #f (assq 'd e)))

(test #f (assq (list 'a) '(((a)) ((b)) ((c)))))
(test '((a)) (assoc (list 'a) '(((a)) ((b)) ((c)))))
(test '(2 4) (assoc 2.0 '((1 1) (2 4) (3 9)) =))
(test '(5 7) (assv 5 '((2 3) (5 7) (11 13))))

(test '(1 2 3) (list-copy '(1 2 3)))
(test "foo" (list-copy "foo"))
(test '() (list-copy '()))
(test '(3 . 4) (list-copy '(3 . 4)))
(test '(6 7 8 . 9) (list-copy '(6 7 8 . 9)))
(let* ((l1 '((a b) (c d) e))
       (l2 (list-copy l1)))
  (test l2 '((a b) (c d) e))
  (test #t (eq? (car l1) (car l2)))
  (test #t (eq? (cadr l1) (cadr l2)))
  (test #f (eq? (cdr l1) (cdr l2)))
  (test #f (eq? (cddr l1) (cddr l2))))

(test-end)

(test-begin "6.5 Symbols")

(test #t (symbol? 'foo))
(test #t (symbol? (car '(a b))))
(test #f (symbol? "bar"))
(test #t (symbol? 'nil))
(test #f (symbol? '()))
(test #f (symbol? #f))

(test #t (symbol=? 'a 'a))
(test #f (symbol=? 'a 'A))
(test #t (symbol=? 'a 'a 'a))
(test #f (symbol=? 'a 'a 'A))

(test "flying-fish"     
(symbol->string 'flying-fish))
(test "Martin" (symbol->string 'Martin))
(test "Malvina" (symbol->string (string->symbol "Malvina")))

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

(test-end)

(test-begin "6.6 Characters")

(test #t (char? #\a))
(test #f (char? "a"))
(test #f (char? 'a))
(test #f (char? 0))

(test #t (char=? #\a #\a #\a))
(test #f (char=? #\a #\A))
(test #t (char<? #\a #\b #\c))
(test #f (char<? #\a #\a))
(test #f (char<? #\b #\a))
(test #f (char>? #\a #\b))
(test #f (char>? #\a #\a))
(test #t (char>? #\c #\b #\a))
(test #t (char<=? #\a #\b #\b))
(test #t (char<=? #\a #\a))
(test #f (char<=? #\b #\a))
(test #f (char>=? #\a #\b))
(test #t (char>=? #\a #\a))
(test #t (char>=? #\b #\b #\a))

;; (test #t (char-ci=? #\a #\a))
;; (test #t (char-ci=? #\a #\A #\a))
;; (test #f (char-ci=? #\a #\b))
;; (test #t (char-ci<? #\a #\B #\c))
;; (test #f (char-ci<? #\A #\a))
;; (test #f (char-ci<? #\b #\A))
;; (test #f (char-ci>? #\A #\b))
;; (test #f (char-ci>? #\a #\A))
;; (test #t (char-ci>? #\c #\B #\a))
;; (test #t (char-ci<=? #\a #\B #\b))
;; (test #t (char-ci<=? #\A #\a))
;; (test #f (char-ci<=? #\b #\A))
;; (test #f (char-ci>=? #\A #\b))
;; (test #t (char-ci>=? #\a #\A))
;; (test #t (char-ci>=? #\b #\B #\a))

;; (test #t (char-alphabetic? #\a))
;; (test #f (char-alphabetic? #\space))
;; (test #t (char-numeric? #\0))
;; (test #f (char-numeric? #\.))
;; (test #f (char-numeric? #\a))
;; (test #t (char-whitespace? #\space))
;; (test #t (char-whitespace? #\tab))
;; (test #t (char-whitespace? #\newline))
;; (test #f (char-whitespace? #\_))
;; (test #f (char-whitespace? #\a))
;; (test #t (char-upper-case? #\A))
;; (test #f (char-upper-case? #\a))
;; (test #f (char-upper-case? #\3))
;; (test #t (char-lower-case? #\a))
;; (test #f (char-lower-case? #\A))
;; (test #f (char-lower-case? #\3))

;; (test #t (char-alphabetic? #\Λ))
;; (test #f (char-alphabetic? #\x0E50))
;; (test #t (char-upper-case? #\Λ))
;; (test #f (char-upper-case? #\λ))
;; (test #f (char-lower-case? #\Λ))
;; (test #t (char-lower-case? #\λ))
;; (test #f (char-numeric? #\Λ))
;; (test #t (char-numeric? #\x0E50))
;; (test #t (char-whitespace? #\x1680))

;; (test 0 (digit-value #\0))
;; (test 3 (digit-value #\3))
;; (test 9 (digit-value #\9))
;; (test 4 (digit-value #\x0664))
;; (test 0 (digit-value #\x0AE6))
;; (test #f (digit-value #\.))
;; (test #f (digit-value #\-))

(test 97 (char->integer #\a))
(test #\a (integer->char 97))

;; (test #\A (char-upcase #\a))
;; (test #\A (char-upcase #\A))
;; (test #\a (char-downcase #\a))
;; (test #\a (char-downcase #\A))
;; (test #\a (char-foldcase #\a))
;; (test #\a (char-foldcase #\A))

;; (test #\Λ (char-upcase #\λ))
;; (test #\Λ (char-upcase #\Λ))
;; (test #\λ (char-downcase #\λ))
;; (test #\λ (char-downcase #\Λ))
;; (test #\λ (char-foldcase #\λ))
;; (test #\λ (char-foldcase #\Λ))

(test-end)

(test-begin "6.7 Strings")

(test #t (string? ""))
(test #t (string? " "))
(test #f (string? 'a))
(test #f (string? #\a))

(test 3 (string-length (make-string 3)))
(test "---" (make-string 3 #\-))

(test "" (string))
(test "---" (string #\- #\- #\-))
(test "kitten" (string #\k #\i #\t #\t #\e #\n))

(test 0 (string-length ""))
(test 1 (string-length "a"))
(test 3 (string-length "abc"))

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

(test "a-c" (let ((str (string #\a #\b #\c))) (string-set! str 1 #\-) str))

;; (test (string #\a #\x1F700 #\c)
;;     (let ((s (string #\a #\b #\c)))
;;       (string-set! s 1 #\x1F700)
;;       s))

#;(test #t (string=? "" ""))
(test #t (string=? "abc" "abc" "abc"))
(test #f (string=? "" "abc"))
(test #f (string=? "abc" "aBc"))

(test #f (string<? "" ""))
(test #f (string<? "abc" "abc"))
(test #t (string<? "abc" "abcd" "acd"))
(test #f (string<? "abcd" "abc"))
(test #t (string<? "abc" "bbc"))

(test #f (string>? "" ""))
(test #f (string>? "abc" "abc"))
(test #f (string>? "abc" "abcd"))
(test #t (string>? "acd" "abcd" "abc"))
(test #f (string>? "abc" "bbc"))

(test #t (string<=? "" ""))
(test #t (string<=? "abc" "abc"))
(test #t (string<=? "abc" "abcd" "abcd"))
(test #f (string<=? "abcd" "abc"))
(test #t (string<=? "abc" "bbc"))

(test #t (string>=? "" ""))
(test #t (string>=? "abc" "abc"))
(test #f (string>=? "abc" "abcd"))
(test #t (string>=? "abcd" "abcd" "abc"))
(test #f (string>=? "abc" "bbc"))

;; (test #t (string-ci=? "" ""))
;; (test #t (string-ci=? "abc" "abc"))
;; (test #f (string-ci=? "" "abc"))
;; (test #t (string-ci=? "abc" "aBc"))
;; (test #f (string-ci=? "abc" "aBcD"))

;; (test #f (string-ci<? "abc" "aBc"))
;; (test #t (string-ci<? "abc" "aBcD"))
;; (test #f (string-ci<? "ABCd" "aBc"))

;; (test #f (string-ci>? "abc" "aBc"))
;; (test #f (string-ci>? "abc" "aBcD"))
;; (test #t (string-ci>? "ABCd" "aBc"))

;; (test #t (string-ci<=? "abc" "aBc"))
;; (test #t (string-ci<=? "abc" "aBcD"))
;; (test #f (string-ci<=? "ABCd" "aBc"))

;; (test #t (string-ci>=? "abc" "aBc"))
;; (test #f (string-ci>=? "abc" "aBcD"))
;; (test #t (string-ci>=? "ABCd" "aBc"))

;; (test #t (string-ci=? "ΑΒΓ" "αβγ" "αβγ"))
;; (test #f (string-ci<? "ΑΒΓ" "αβγ"))
;; (test #f (string-ci>? "ΑΒΓ" "αβγ"))
;; (test #t (string-ci<=? "ΑΒΓ" "αβγ"))
;; (test #t (string-ci>=? "ΑΒΓ" "αβγ"))

;; ;; latin
;; (test "ABC" (string-upcase "abc"))
;; (test "ABC" (string-upcase "ABC"))
;; (test "abc" (string-downcase "abc"))
;; (test "abc" (string-downcase "ABC"))
;; (test "abc" (string-foldcase "abc"))
;; (test "abc" (string-foldcase "ABC"))

;; ;; cyrillic
;; (test "ΑΒΓ" (string-upcase "αβγ"))
;; (test "ΑΒΓ" (string-upcase "ΑΒΓ"))
;; (test "αβγ" (string-downcase "αβγ"))
;; (test "αβγ" (string-downcase "ΑΒΓ"))
;; (test "αβγ" (string-foldcase "αβγ"))
;; (test "αβγ" (string-foldcase "ΑΒΓ"))

;; ;; special cases
;; (test "SSA" (string-upcase "ßa"))
;; (test "ßa" (string-downcase "ßa"))
;; (test "ssa" (string-downcase "SSA"))
;; (test "İ" (string-upcase "İ"))
;; (test "i\x0307;" (string-downcase "İ"))
;; (test "i\x0307;" (string-foldcase "İ"))
;; (test "J̌" (string-upcase "ǰ"))

;; ;; context-sensitive (final sigma)
;; (test "ΓΛΏΣΣΑ" (string-upcase "γλώσσα"))
;; (test "γλώσσα" (string-downcase "ΓΛΏΣΣΑ"))
;; (test "γλώσσα" (string-foldcase "ΓΛΏΣΣΑ"))
;; (test "ΜΈΛΟΣ" (string-upcase "μέλος"))
;; (test #t (and (member (string-downcase "ΜΈΛΟΣ") '("μέλος" "μέλοσ")) #t))
;; (test "μέλοσ" (string-foldcase "ΜΈΛΟΣ"))
;; (test #t (and (member (string-downcase "ΜΈΛΟΣ ΕΝΌΣ")
;;                       '("μέλος ενός" "μέλοσ ενόσ"))
;;               #t))

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

(test "" (string-append ""))
(test "" (string-append "" ""))
(test "abc" (string-append "" "abc"))
(test "abc" (string-append "abc" ""))
(test "abcde" (string-append "abc" "de"))
(test "abcdef" (string-append "abc" "de" "f"))

(test '() (string->list ""))
(test '(#\a) (string->list "a"))
(test '(#\a #\b #\c) (string->list "abc"))
(test '(#\a #\b #\c) (string->list "abc" 0))
(test '(#\b #\c) (string->list "abc" 1))
(test '(#\b #\c) (string->list "abc" 1 3))
(test "" (list->string '()))
(test "abc" (list->string '(#\a #\b #\c)))

(test "" (string-copy ""))
(test "" (string-copy "" 0))
(test "" (string-copy "" 0 0))
(test "abc" (string-copy "abc"))
(test "abc" (string-copy "abc" 0))
(test "bc" (string-copy "abc" 1))
(test "b" (string-copy "abc" 1 2))
(test "bc" (string-copy "abc" 1 3))

;; (test "-----"
;;     (let ((str (make-string 5 #\x))) (string-fill! str #\-) str))
;; (test "xx---"
;;     (let ((str (make-string 5 #\x))) (string-fill! str #\- 2) str))
;; (test "xx-xx"
;;     (let ((str (make-string 5 #\x))) (string-fill! str #\- 2 3) str))

;; (test "a12de"
;;     (let ((str (string-copy "abcde"))) (string-copy! str 1 "12345" 0 2) str))
;; (test "-----"
;;     (let ((str (make-string 5 #\x))) (string-copy! str 0 "-----") str))
;; (test "---xx"
;;     (let ((str (make-string 5 #\x))) (string-copy! str 0 "-----" 2) str))
;; (test "xx---"
;;     (let ((str (make-string 5 #\x))) (string-copy! str 2 "-----" 0 3) str))
;; (test "xx-xx"
;;     (let ((str (make-string 5 #\x))) (string-copy! str 2 "-----" 2 3) str))

;; same source and dest
;; (test "aabde"
;;     (let ((str (string-copy "abcde"))) (string-copy! str 1 str 0 2) str))
;; (test "abcab"
;;     (let ((str (string-copy "abcde"))) (string-copy! str 3 str 0 2) str))

(test-end)

(test-begin "6.8 Vectors")

(test #t (vector? #()))
(test #t (vector? #(1 2 3)))
(test #t (vector? '#(1 2 3)))

(test 0 (vector-length (make-vector 0)))
(test 1000 (vector-length (make-vector 1000)))

(test #(0 (2 2 2 2) "Anna") '#(0 (2 2 2 2) "Anna"))

(test #(a b c) (vector 'a 'b 'c))

(test 8 (vector-ref '#(1 1 2 3 5 8 13 21) 5))
(test 13 (vector-ref '#(1 1 2 3 5 8 13 21)
            (let ((i (round (* 2 (acos -1)))))
              (if (inexact? i)
                  (exact i)
                  i))))

(test #(0 ("Sue" "Sue") "Anna") (let ((vec (vector 0 '(2 2 2 2) "Anna")))
  (vector-set! vec 1 '("Sue" "Sue"))
  vec))

(test '(dah dah didah) (vector->list '#(dah dah didah)))
(test '(dah didah) (vector->list '#(dah dah didah) 1))
(test '(dah) (vector->list '#(dah dah didah) 1 2))
(test #(dididit dah) (list->vector '(dididit dah)))

(test #() (string->vector ""))
(test #(#\A #\B #\C) (string->vector "ABC"))
(test #(#\B #\C) (string->vector "ABC" 1))
(test #(#\B) (string->vector "ABC" 1 2))

(test "" (vector->string #()))
(test "123" (vector->string #(#\1 #\2 #\3)))
(test "23" (vector->string #(#\1 #\2 #\3) 1))
(test "2" (vector->string #(#\1 #\2 #\3) 1 2))

(test #() (vector-copy #()))
(test #(a b c) (vector-copy #(a b c)))
(test #(b c) (vector-copy #(a b c) 1))
(test #(b) (vector-copy #(a b c) 1 2))

(test #() (vector-append #()))
(test #() (vector-append #() #()))
(test #(a b c) (vector-append #() #(a b c)))
(test #(a b c) (vector-append #(a b c) #()))
(test #(a b c d e) (vector-append #(a b c) #(d e)))
(test #(a b c d e f) (vector-append #(a b c) #(d e) #(f)))

(test #(1 2 smash smash 5)
    (let ((vec (vector 1 2 3 4 5))) (vector-fill! vec 'smash 2 4) vec))
(test #(x x x x x)
    (let ((vec (vector 1 2 3 4 5))) (vector-fill! vec 'x) vec))
(test #(1 2 x x x)
    (let ((vec (vector 1 2 3 4 5))) (vector-fill! vec 'x 2) vec))
(test #(1 2 x 4 5)
    (let ((vec (vector 1 2 3 4 5))) (vector-fill! vec 'x 2 3) vec))

(test #(1 a b 4 5)
    (let ((vec (vector 1 2 3 4 5))) (vector-copy! vec 1 #(a b c d e) 0 2) vec))
(test #(a b c d e)
    (let ((vec (vector 1 2 3 4 5))) (vector-copy! vec 0 #(a b c d e)) vec))
(test #(c d e 4 5)
    (let ((vec (vector 1 2 3 4 5))) (vector-copy! vec 0 #(a b c d e) 2) vec))
(test #(1 2 a b c)
    (let ((vec (vector 1 2 3 4 5))) (vector-copy! vec 2 #(a b c d e) 0 3) vec))
(test #(1 2 c 4 5)
    (let ((vec (vector 1 2 3 4 5))) (vector-copy! vec 2 #(a b c d e) 2 3) vec))

;; same source and dest
(test #(1 1 2 4 5)
    (let ((vec (vector 1 2 3 4 5))) (vector-copy! vec 1 vec 0 2) vec))
(test #(1 2 3 1 2)
    (let ((vec (vector 1 2 3 4 5))) (vector-copy! vec 3 vec 0 2) vec))

(test-end)

(test-begin "6.9 Bytevectors")

(test #t (bytevector? #u8()))
(test #t (bytevector? #u8(0 1 2)))
(test #f (bytevector? #()))
(test #f (bytevector? #(0 1 2)))
(test #f (bytevector? '()))
(test #t (bytevector? (make-bytevector 0)))

(test 0 (bytevector-length (make-bytevector 0)))
(test 1024 (bytevector-length (make-bytevector 1024)))
(test 1024 (bytevector-length (make-bytevector 1024 255)))

(test 3 (bytevector-length (bytevector 0 1 2)))

(test 0 (bytevector-u8-ref (bytevector 0 1 2) 0))
(test 1 (bytevector-u8-ref (bytevector 0 1 2) 1))
(test 2 (bytevector-u8-ref (bytevector 0 1 2) 2))

(test #u8(0 255 2)
    (let ((bv (bytevector 0 1 2))) (bytevector-u8-set! bv 1 255) bv))

(test #u8() (bytevector-copy #u8()))
(test #u8(0 1 2) (bytevector-copy #u8(0 1 2)))
(test #u8(1 2) (bytevector-copy #u8(0 1 2) 1))
(test #u8(1) (bytevector-copy #u8(0 1 2) 1 2))

(test #u8(1 6 7 4 5)
    (let ((bv (bytevector 1 2 3 4 5)))
      (bytevector-copy! bv 1 #u8(6 7 8 9 10) 0 2)
      bv))
(test #u8(6 7 8 9 10)
    (let ((bv (bytevector 1 2 3 4 5)))
      (bytevector-copy! bv 0 #u8(6 7 8 9 10))
      bv))
(test #u8(8 9 10 4 5)
    (let ((bv (bytevector 1 2 3 4 5)))
      (bytevector-copy! bv 0 #u8(6 7 8 9 10) 2)
      bv))
(test #u8(1 2 6 7 8)
    (let ((bv (bytevector 1 2 3 4 5)))
      (bytevector-copy! bv 2 #u8(6 7 8 9 10) 0 3)
      bv))
(test #u8(1 2 8 4 5)
    (let ((bv (bytevector 1 2 3 4 5)))
      (bytevector-copy! bv 2 #u8(6 7 8 9 10) 2 3)
      bv))

;; same source and dest
(test #u8(1 1 2 4 5)
    (let ((bv (bytevector 1 2 3 4 5)))
      (bytevector-copy! bv 1 bv 0 2)
      bv))
(test #u8(1 2 3 1 2)
    (let ((bv (bytevector 1 2 3 4 5)))
      (bytevector-copy! bv 3 bv 0 2)
      bv))

(test #u8() (bytevector-append #u8()))
(test #u8() (bytevector-append #u8() #u8()))
(test #u8(0 1 2) (bytevector-append #u8() #u8(0 1 2)))
(test #u8(0 1 2) (bytevector-append #u8(0 1 2) #u8()))
(test #u8(0 1 2 3 4) (bytevector-append #u8(0 1 2) #u8(3 4)))
(test #u8(0 1 2 3 4 5) (bytevector-append #u8(0 1 2) #u8(3 4) #u8(5)))

(test "ABC" (utf8->string #u8(#x41 #x42 #x43)))
(test "ABC" (utf8->string #u8(0 #x41 #x42 #x43) 1))
(test "ABC" (utf8->string #u8(0 #x41  #x42 #x43 0) 1 4))
;; (test "λ" (utf8->string #u8(0 #xCE #xBB 0) 1 3))
;; (test #u8(#x41 #x42 #x43) (string->utf8 "ABC"))
;; (test #u8(#x42 #x43) (string->utf8 "ABC" 1))
;; (test #u8(#x42) (string->utf8 "ABC" 1 2))
;; (test #u8(#xCE #xBB) (string->utf8 "λ"))

(test-end)

(test-begin "6.10 Control Features")

(test #t (procedure? car))
(test #f (procedure? 'car))
(test #t (procedure? (lambda (x) (* x x))))
(test #f (procedure? '(lambda (x) (* x x))))
(test #t (call-with-current-continuation procedure?))

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

(define compose
  (lambda (f g)
    (lambda args
      (f (apply g args)))))
(test '(30 0)
    (call-with-values (lambda () ((compose exact-integer-sqrt *) 12 75))
      list))

(test '(b e h) (map cadr '((a b) (d e) (g h))))

(test '(1 4 27 256 3125) (map (lambda (n) (expt n n)) '(1 2 3 4 5)))

(test '(5 7 9) (map + '(1 2 3) '(4 5 6 7)))

(test #t
    (let ((res (let ((count 0))
                 (map (lambda (ignored)
                        (set! count (+ count 1))
                        count)
                      '(a b)))))
      (or (equal? res '(1 2))
          (equal? res '(2 1)))))

(test '(10 200 3000 40 500 6000)
    (let ((ls1 (list 10 100 1000))
          (ls2 (list 1 2 3 4 5 6)))
      (set-cdr! (cddr ls1) ls1)
      (map * ls1 ls2)))

;; (test "abdegh" (string-map char-foldcase "AbdEgH"))

(test "IBM" (string-map
 (lambda (c)
   (integer->char (+ 1 (char->integer c))))
 "HAL"))

;; (test "StUdLyCaPs"
;;     (string-map
;;      (lambda (c k) (if (eqv? k #\u) (char-upcase c) (char-downcase c)))
;;      "studlycaps xxx"
;;      "ululululul"))

(test #(b e h) (vector-map cadr '#((a b) (d e) (g h))))

(test #(1 4 27 256 3125)
    (vector-map (lambda (n) (expt n n))
                '#(1 2 3 4 5)))

(test #(5 7 9) (vector-map + '#(1 2 3) '#(4 5 6 7)))

(test #t
    (let ((res (let ((count 0))
                 (vector-map
                  (lambda (ignored)
                    (set! count (+ count 1))
                    count)
                  '#(a b)))))
      (or (equal? res #(1 2))
          (equal? res #(2 1)))))

(test #(0 1 4 9 16)
    (let ((v (make-vector 5)))
      (for-each (lambda (i)
                  (vector-set! v i (* i i)))
                '(0 1 2 3 4))
      v))

(test 9750
    (let ((ls1 (list 10 100 1000))
          (ls2 (list 1 2 3 4 5 6))
          (count 0))
      (set-cdr! (cddr ls1) ls1)
      (for-each (lambda (x y) (set! count (+ count (* x y)))) ls2 ls1)
      count))

(test '(101 100 99 98 97)
    (let ((v '()))
      (string-for-each
       (lambda (c) (set! v (cons (char->integer c) v)))
       "abcde")
      v))

(test '(0 1 4 9 16) (let ((v (make-list 5)))
  (vector-for-each
   (lambda (i) (list-set! v i (* i i)))
   '#(0 1 2 3 4))
  v))

(test -3 (call-with-current-continuation
  (lambda (exit)
    (for-each (lambda (x)
                (if (negative? x)
                    (exit x)))
              '(54 0 37 -3 245 19))
    #t)))
(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 4 (list-length '(1 2 3 4)))

(test #f (list-length '(a b . c)))

(test 5
    (call-with-values (lambda () (values 4 5))
      (lambda (a b) b)))

(test -1 (call-with-values * -))

#;
(test '(connect talk1 disconnect
                connect talk2 disconnect)
      (let ((path '())
            (c #f))
        (let ((add (lambda (s)
                     (set! path (cons s path)))))
          (dynamic-wind
              (lambda () (add 'connect))
              (lambda ()
                (add (call-with-current-continuation
                      (lambda (c0)
                        (set! c c0)
                        'talk1))))
              (lambda () (add 'disconnect)))
          (if (< (length path) 4)
              (c 'talk2)
              (reverse path)))))

(test-end)

(test-begin "6.11 Exceptions")

;; (test 65
;;     (with-exception-handler
;;      (lambda (con) 42)
;;      (lambda ()
;;        (+ (raise-continuable "should be a number")
;;           23))))

;; (test #t
;;     (error-object? (guard (exn (else exn)) (error "BOOM!" 1 2 3))))
;; (test "BOOM!"
;;     (error-object-message (guard (exn (else exn)) (error "BOOM!" 1 2 3))))
;; (test '(1 2 3)
;;     (error-object-irritants (guard (exn (else exn)) (error "BOOM!" 1 2 3))))

;; (test #f
;;     (file-error? (guard (exn (else exn)) (error "BOOM!"))))
;; (test #t
;;     (file-error? (guard (exn (else exn)) (open-input-file " no such file "))))

;; (test #f
;;     (read-error? (guard (exn (else exn)) (error "BOOM!"))))
;; (test #t
;;     (read-error? (guard (exn (else exn)) (read (open-input-string ")")))))

(define something-went-wrong #f)
(define (test-exception-handler-1 v)
  (call-with-current-continuation
   (lambda (k)
     (with-exception-handler
      (lambda (x)
        (set! something-went-wrong (list "condition: " x))
        (k 'exception))
      (lambda ()
        (+ 1 (if (> v 0) (+ v 100) (raise 'an-error))))))))
(test 106 (test-exception-handler-1 5))
(test #f something-went-wrong)
(test 'exception (test-exception-handler-1 -1))
(test '("condition: " an-error) something-went-wrong)

(set! something-went-wrong #f)
;; (define (test-exception-handler-2 v)
;;   (guard (ex (else 'caught-another-exception))
;;     (with-exception-handler
;;      (lambda (x)
;;        (set! something-went-wrong #t)
;;        (list "exception:" x))
;;      (lambda ()
;;        (+ 1 (if (> v 0) (+ v 100) (raise 'an-error)))))))
;; (test 106 (test-exception-handler-2 5))
;; (test #f something-went-wrong)
;; (test 'caught-another-exception (test-exception-handler-2 -1))
;; (test #t something-went-wrong)

;; Based on an example from R6RS-lib section 7.1 Exceptions.
;; R7RS section 6.11 Exceptions has a simplified version.
;; (let* ((out (open-output-string))
;;        (value (with-exception-handler
;;                (lambda (con)
;;                  (cond
;;                   ((not (list? con))
;;                    (raise con))
;;                   ((list? con)
;;                    (display (car con) out))
;;                   (else
;;                    (display "a warning has been issued" out)))
;;                  42)
;;                (lambda ()
;;                  (+ (raise-continuable
;;                      (list "should be a number"))
;;                     23)))))
;;   (test "should be a number" (get-output-string out))
;;   (test 65 value))

;; From SRFI-34 "Examples" section - #3
;; (define (test-exception-handler-3 v out)
;;   (guard (condition
;;           (else
;;            (display "condition: " out)
;;            (write condition out)
;;            (display #\! out)
;;            'exception))
;;          (+ 1 (if (= v 0) (raise 'an-error) (/ 10 v)))))
;; (let* ((out (open-output-string))
;;        (value (test-exception-handler-3 0 out)))
;;   (test 'exception value)
;;   (test "condition: an-error!" (get-output-string out)))

;; (define (test-exception-handler-4 v out)
;;   (call-with-current-continuation
;;    (lambda (k)
;;      (with-exception-handler
;;       (lambda (x)
;;         (display "reraised " out)
;;         (write x out) (display #\! out)
;;         (k 'zero))
;;       (lambda ()
;;         (guard (condition
;;                 ((positive? condition)
;;                  'positive)
;;                 ((negative? condition)
;;                  'negative))
;;           (raise v)))))))

;; From SRFI-34 "Examples" section - #5
;; (let* ((out (open-output-string))
;;        (value (test-exception-handler-4 1 out)))
;;   (test "" (get-output-string out))
;;   (test 'positive value))
;; ;; From SRFI-34 "Examples" section - #6
;; (let* ((out (open-output-string))
;;        (value (test-exception-handler-4 -1 out)))
;;   (test "" (get-output-string out))
;;   (test 'negative value))
;; ;; From SRFI-34 "Examples" section - #7
;; (let* ((out (open-output-string))
;;        (value (test-exception-handler-4 0 out)))
;;   (test "reraised 0!" (get-output-string out))
;;   (test 'zero value))

;; From SRFI-34 "Examples" section - #8
;; (test 42
;;     (guard (condition
;;             ((assq 'a condition) => cdr)
;;             ((assq 'b condition)))
;;       (raise (list (cons 'a 42)))))

;; ;; From SRFI-34 "Examples" section - #9
;; (test '(b . 23)
;;     (guard (condition
;;             ((assq 'a condition) => cdr)
;;             ((assq 'b condition)))
;;       (raise (list (cons 'b 23)))))

;; (test 'caught-d
;;     (guard (condition
;;             ((assq 'c condition) 'caught-c)
;;             ((assq 'd condition) 'caught-d))
;;       (list
;;        (sqrt 8)
;;        (guard (condition
;;                ((assq 'a condition) => cdr)
;;                ((assq 'b condition)))
;;          (raise (list (cons 'd 24)))))))

(test-end)

(test-begin "6.12 Environments and evaluation")

;; (test 21 (eval '(* 7 3) (scheme-report-environment 5)))

;; (test 20
;;     (let ((f (eval '(lambda (f x) (f x x)) (null-environment 5))))
;;       (f + 10)))

;; (test 1024 (eval '(expt 2 10) (environment '(scheme base))))
;; ;; (sin 0) may return exact number
;; (test 0.0 (inexact (eval '(sin 0) (environment '(scheme inexact)))))
;; ;; ditto
;; (test 1024.0 (eval '(+ (expt 2 10) (inexact (sin 0)))
;;                    (environment '(scheme base) '(scheme inexact))))

(test-end)

(test-begin "6.13 Input and output")

(test #t (port? (current-input-port)))
(test #t (input-port? (current-input-port)))
(test #t (output-port? (current-output-port)))
(test #t (output-port? (current-error-port)))
(test #t (input-port? (open-input-string "abc")))
(test #t (output-port? (open-output-string)))

(test #t (textual-port? (open-input-string "abc")))
(test #t (textual-port? (open-output-string)))
(test #t (binary-port? (open-input-bytevector #u8(0 1 2))))
(test #t (binary-port? (open-output-bytevector)))

(test #t (input-port-open? (open-input-string "abc")))
(test #t (output-port-open? (open-output-string)))

(test #f
    (let ((in (open-input-string "abc")))
      (close-input-port in)
      (input-port-open? in)))

(test #f
    (let ((out (open-output-string)))
      (close-output-port out)
      (output-port-open? out)))

(test #f
    (let ((out (open-output-string)))
      (close-port out)
      (output-port-open? out)))

(test #t (eof-object? (eof-object)))
;; (test #t (eof-object? (read (open-input-string ""))))
(test #t (char-ready? (open-input-string "42")))
;; (test 42 (read (open-input-string " 42 ")))

(test #t (eof-object? (read-char (open-input-string ""))))
(test #\a (read-char (open-input-string "abc")))

(test #t (eof-object? (read-line (open-input-string ""))))
(test "abc" (read-line (open-input-string "abc")))
(test "abc" (read-line (open-input-string "abc\ndef\n")))

(test #t (eof-object? (read-string 3 (open-input-string ""))))
(test "abc" (read-string 3 (open-input-string "abcd")))
(test "abc" (read-string 3 (open-input-string "abc\ndef\n")))

;; (let ((in (open-input-string (string #\x10F700 #\x10F701 #\x10F702))))
;;   (let* ((c1 (read-char in))
;;          (c2 (read-char in))
;;          (c3 (read-char in)))
;;     (test #\x10F700 c1)
;;     (test #\x10F701 c2)
;;     (test #\x10F702 c3)))

;; (test (string #\x10F700)
;;     (let ((out (open-output-string)))
;;       (write-char #\x10F700 out)
;;       (get-output-string out)))

(test "abc"
    (let ((out (open-output-string)))
      (write 'abc out)
      (get-output-string out)))

(test "abc def"
    (let ((out (open-output-string)))
      (display "abc def" out)
      (get-output-string out)))

(test "abc"
    (let ((out (open-output-string)))
      (display #\a out)
      (display "b" out)
      (display #\c out)
      (get-output-string out)))

(test #t
      (let* ((out (open-output-string))
             (r (begin (newline out) (get-output-string out))))
        (or (equal? r "\n") (equal? r "\r\n"))))

(test "abc def"
    (let ((out (open-output-string)))
      (write-string "abc def" out)
      (get-output-string out)))

(test "def"
    (let ((out (open-output-string)))
      (write-string "abc def" out 4)
      (get-output-string out)))

(test "c d"
    (let ((out (open-output-string)))
      (write-string "abc def" out 2 5)
      (get-output-string out)))

(test ""
  (let ((out (open-output-string)))
    (flush-output-port out)
    (get-output-string out)))

(test #t (eof-object? (read-u8 (open-input-bytevector #u8()))))
(test 1 (read-u8 (open-input-bytevector #u8(1 2 3))))

(test #t (eof-object? (read-bytevector 3 (open-input-bytevector #u8()))))
(test #t (u8-ready? (open-input-bytevector #u8(1))))
(test #u8(1) (read-bytevector 3 (open-input-bytevector #u8(1))))
(test #u8(1 2) (read-bytevector 3 (open-input-bytevector #u8(1 2))))
(test #u8(1 2 3) (read-bytevector 3 (open-input-bytevector #u8(1 2 3))))
(test #u8(1 2 3) (read-bytevector 3 (open-input-bytevector #u8(1 2 3 4))))

(test #t
    (let ((bv (bytevector 1 2 3 4 5)))
      (eof-object? (read-bytevector! bv (open-input-bytevector #u8())))))

(test #u8(6 7 8 9 10)
  (let ((bv (bytevector 1 2 3 4 5)))
    (read-bytevector! bv (open-input-bytevector #u8(6 7 8 9 10)) 0 5)
    bv))

(test #u8(6 7 8 4 5)
  (let ((bv (bytevector 1 2 3 4 5)))
    (read-bytevector! bv (open-input-bytevector #u8(6 7 8 9 10)) 0 3)
    bv))

(test #u8(1 2 3 6 5)
  (let ((bv (bytevector 1 2 3 4 5)))
    (read-bytevector! bv (open-input-bytevector #u8(6 7 8 9 10)) 3 4)
    bv))

(test #u8(1 2 3)
  (let ((out (open-output-bytevector)))
    (write-u8 1 out)
    (write-u8 2 out)
    (write-u8 3 out)
    (get-output-bytevector out)))

(test #u8(1 2 3 4 5)
  (let ((out (open-output-bytevector)))
    (write-bytevector #u8(1 2 3 4 5) out)
    (get-output-bytevector out)))

(test #u8(3 4 5)
  (let ((out (open-output-bytevector)))
    (write-bytevector #u8(1 2 3 4 5) out 2)
    (get-output-bytevector out)))

(test #u8(3 4)
  (let ((out (open-output-bytevector)))
    (write-bytevector #u8(1 2 3 4 5) out 2 4)
    (get-output-bytevector out)))

(test #u8()
  (let ((out (open-output-bytevector)))
    (flush-output-port out)
    (get-output-bytevector out)))

(test #t
    (and (member
          (let ((out (open-output-string))
                (x (list 1)))
            (set-cdr! x x)
            (write x out)
            (get-output-string out))
          ;; labels not guaranteed to be 0 indexed, spacing may differ
          '("#0=(1 . #0#)" "#1=(1 . #1#)"))
         #t))

(test "((1 2 3) (1 2 3))"
    (let ((out (open-output-string))
          (x (list 1 2 3)))
      (write (list x x) out)
      (get-output-string out)))

(test "((1 2 3) (1 2 3))"
    (let ((out (open-output-string))
          (x (list 1 2 3)))
      (write-simple (list x x) out)
      (get-output-string out)))

(test #t
    (and (member (let ((out (open-output-string))
                       (x (list 1 2 3)))
                   (write-shared (list x x) out)
                   (get-output-string out))
                 '("(#0=(1 2 3) #0#)" "(#1=(1 2 3) #1#)"))
         #t))

(test-begin "Read syntax")

;; check reading boolean followed by eof
;; (test #t (read (open-input-string "#t")))
;; (test #t (read (open-input-string "#true")))
;; (test #f (read (open-input-string "#f")))
;; (test #f (read (open-input-string "#false")))
;; (define (read2 port)
;;   (let* ((o1 (read port)) (o2 (read port)))
;;     (cons o1 o2)))
;; ;; check reading boolean followed by delimiter
;; (test '(#t . (5)) (read2 (open-input-string "#t(5)")))
;; (test '(#t . 6) (read2 (open-input-string "#true 6 ")))
;; (test '(#f . 7) (read2 (open-input-string "#f 7")))
;; (test '(#f . "8") (read2 (open-input-string "#false\"8\"")))

;; (test '() (read (open-input-string "()")))
;; (test '(1 2) (read (open-input-string "(1 2)")))
;; (test '(1 . 2) (read (open-input-string "(1 . 2)")))
;; (test '(1 2) (read (open-input-string "(1 . (2))")))
;; (test '(1 2 3 4 5) (read (open-input-string "(1 . (2 3 4 . (5)))")))
;; (test '1 (cadr (read (open-input-string "#0=(1 . #0#)"))))
;; (test '(1 2 3) (cadr (read (open-input-string "(#0=(1 2 3) #0#)"))))

;; (test '(quote (1 2)) (read (open-input-string "'(1 2)")))
;; (test '(quote (1 (unquote 2))) (read (open-input-string "'(1 ,2)")))
;; (test '(quote (1 (unquote-splicing 2))) (read (open-input-string "'(1 ,@2)")))
;; (test '(quasiquote (1 (unquote 2))) (read (open-input-string "`(1 ,2)")))

;; (test #() (read (open-input-string "#()")))
;; (test #(a b) (read (open-input-string "#(a b)")))

;; (test #u8() (read (open-input-string "#u8()")))
;; (test #u8(0 1) (read (open-input-string "#u8(0 1)")))

;; (test 'abc (read (open-input-string "abc")))
;; (test 'abc (read (open-input-string "abc def")))
;; (test 'ABC (read (open-input-string "ABC")))
;; (test 'Hello (read (open-input-string "|H\\x65;llo|")))

;; (test 'abc (read (open-input-string "#!fold-case ABC")))
;; (test 'ABC (read (open-input-string "#!fold-case #!no-fold-case ABC")))

;; (test 'def (read (open-input-string "#; abc def")))
;; (test 'def (read (open-input-string "; abc \ndef")))
;; (test 'def (read (open-input-string "#| abc |# def")))
;; (test 'ghi (read (open-input-string "#| abc #| def |# |# ghi")))
;; (test 'ghi (read (open-input-string "#; ; abc\n def ghi")))
;; (test '(abs -16) (read (open-input-string "(#;sqrt abs -16)")))
;; (test '(a d) (read (open-input-string "(a #; #;b c d)")))
;; (test '(a e) (read (open-input-string "(a #;(b #;c d) e)")))
;; (test '(a . c) (read (open-input-string "(a . #;b c)")))
;; (test '(a . b) (read (open-input-string "(a . b #;c)")))

;; (define (test-read-error str)
;;   (test-assert
;;       (guard (exn (else #t))
;;         (read (open-input-string str))
;;         #f)))

;; (test-read-error "(#;a . b)")
;; (test-read-error "(a . #;b)")
;; (test-read-error "(a #;. b)")
;; (test-read-error "(#;x #;y . z)")
;; (test-read-error "(#; #;x #;y . z)")
;; (test-read-error "(#; #;x . z)")

;; (test #\a (read (open-input-string "#\\a")))
;; (test #\space (read (open-input-string "#\\space")))
;; (test 0 (char->integer (read (open-input-string "#\\null"))))
;; (test 7 (char->integer (read (open-input-string "#\\alarm"))))
;; (test 8 (char->integer (read (open-input-string "#\\backspace"))))
;; (test 9 (char->integer (read (open-input-string "#\\tab"))))
;; (test 10 (char->integer (read (open-input-string "#\\newline"))))
;; (test 13 (char->integer (read (open-input-string "#\\return"))))
;; (test #x7F (char->integer (read (open-input-string "#\\delete"))))
;; (test #x1B (char->integer (read (open-input-string "#\\escape"))))
;; (test #x03BB (char->integer (read (open-input-string "#\\λ"))))
;; (test #x03BB (char->integer (read (open-input-string "#\\x03BB"))))

;; (test "abc" (read (open-input-string "\"abc\"")))
;; (test "abc" (read (open-input-string "\"abc\" \"def\"")))
;; (test "ABC" (read (open-input-string "\"ABC\"")))
;; (test "Hello" (read (open-input-string "\"H\\x65;llo\"")))
;; (test 7 (char->integer (string-ref (read (open-input-string "\"\\a\"")) 0)))
;; (test 8 (char->integer (string-ref (read (open-input-string "\"\\b\"")) 0)))
;; (test 9 (char->integer (string-ref (read (open-input-string "\"\\t\"")) 0)))
;; (test 10 (char->integer (string-ref (read (open-input-string "\"\\n\"")) 0)))
;; (test 13 (char->integer (string-ref (read (open-input-string "\"\\r\"")) 0)))
;; (test #x22 (char->integer (string-ref (read (open-input-string "\"\\\"\"")) 0)))
;; (test #x7C (char->integer (string-ref (read (open-input-string "\"\\|\"")) 0)))
;; (test "line 1\nline 2\n" (read (open-input-string "\"line 1\nline 2\n\"")))
;; (test "line 1continued\n" (read (open-input-string "\"line 1\\\ncontinued\n\"")))
;; (test "line 1continued\n" (read (open-input-string "\"line 1\\ \ncontinued\n\"")))
;; (test "line 1continued\n" (read (open-input-string "\"line 1\\\n continued\n\"")))
;; (test "line 1continued\n" (read (open-input-string "\"line 1\\ \t \n \t continued\n\"")))
;; (test "line 1\n\nline 3\n" (read (open-input-string "\"line 1\\ \t \n \t \n\nline 3\n\"")))
;; (test #x03BB (char->integer (string-ref (read (open-input-string "\"\\x03BB;\"")) 0)))

;; (test-end)

(test-begin "Numeric syntax")

;; Numeric syntax adapted from Peter Bex's tests.
;;
;; These are updated to R7RS, using string ports instead of
;; string->number, and "error" tests removed because implementations
;; are free to provide their own numeric extensions.  Currently all
;; tests are run by default - need to cond-expand and test for
;; infinities and -0.0.

;; (define-syntax test-numeric-syntax
;;   (syntax-rules ()
;;     ((test-numeric-syntax str expect strs ...)
;;      (let* ((z (read (open-input-string str)))
;;             (out (open-output-string))
;;             (z-str (begin (write z out) (get-output-string out))))
;;        (test expect (values z))
;;        (test #t (and (member z-str '(str strs ...)) #t))))))

;; Each test is of the form:
;;
;;   (test-numeric-syntax input-str expected-value expected-write-values ...)
;;
;; where the input should be eqv? to the expected-value, and the
;; written output the same as any of the expected-write-values.  The
;; form
;;
;;   (test-numeric-syntax input-str expected-value)
;;
;; is a shorthand for
;;
;;   (test-numeric-syntax input-str expected-value (input-str))

;; Simple
;; (test-numeric-syntax "1" 1)
;; (test-numeric-syntax "+1" 1 "1")
;; (test-numeric-syntax "-1" -1)
;; (test-numeric-syntax "#i1" 1.0 "1.0" "1.")
;; (test-numeric-syntax "#I1" 1.0 "1.0" "1.")
;; (test-numeric-syntax "#i-1" -1.0 "-1.0" "-1.")
;; ;; Decimal
;; (test-numeric-syntax "1.0" 1.0 "1.0" "1.")
;; (test-numeric-syntax "1." 1.0 "1.0" "1.")
;; (test-numeric-syntax ".1" 0.1 "0.1" "100.0e-3")
;; (test-numeric-syntax "-.1" -0.1 "-0.1" "-100.0e-3")
;; ;; Some Schemes don't allow negative zero. This is okay with the standard
;; (test-numeric-syntax "-.0" -0.0 "-0." "-0.0" "0.0" "0." ".0")
;; (test-numeric-syntax "-0." -0.0 "-.0" "-0.0" "0.0" "0." ".0")
;; (test-numeric-syntax "#i1.0" 1.0 "1.0" "1.")
;; (test-numeric-syntax "#e1.0" 1 "1")
;; (test-numeric-syntax "#e-.0" 0 "0")
;; (test-numeric-syntax "#e-0." 0 "0")
;; ;; Decimal notation with suffix
;; (test-numeric-syntax "1e2" 100.0 "100.0" "100.")
;; (test-numeric-syntax "1E2" 100.0 "100.0" "100.")
;; (test-numeric-syntax "1s2" 100.0 "100.0" "100.")
;; (test-numeric-syntax "1S2" 100.0 "100.0" "100.")
;; (test-numeric-syntax "1f2" 100.0 "100.0" "100.")
;; (test-numeric-syntax "1F2" 100.0 "100.0" "100.")
;; (test-numeric-syntax "1d2" 100.0 "100.0" "100.")
;; (test-numeric-syntax "1D2" 100.0 "100.0" "100.")
;; (test-numeric-syntax "1l2" 100.0 "100.0" "100.")
;; (test-numeric-syntax "1L2" 100.0 "100.0" "100.")
;; ;; NaN, Inf
;; (test-numeric-syntax "+nan.0" +nan.0 "+nan.0" "+NaN.0")
;; (test-numeric-syntax "+NAN.0" +nan.0 "+nan.0" "+NaN.0")
;; (test-numeric-syntax "+inf.0" +inf.0 "+inf.0" "+Inf.0")
;; (test-numeric-syntax "+InF.0" +inf.0 "+inf.0" "+Inf.0")
;; (test-numeric-syntax "-inf.0" -inf.0 "-inf.0" "-Inf.0")
;; (test-numeric-syntax "-iNF.0" -inf.0 "-inf.0" "-Inf.0")
;; (test-numeric-syntax "#i+nan.0" +nan.0 "+nan.0" "+NaN.0")
;; (test-numeric-syntax "#i+inf.0" +inf.0 "+inf.0" "+Inf.0")
;; (test-numeric-syntax "#i-inf.0" -inf.0 "-inf.0" "-Inf.0")
;; ;; Exact ratios
;; (test-numeric-syntax "1/2" (/ 1 2))
;; (test-numeric-syntax "#e1/2" (/ 1 2) "1/2")
;; (test-numeric-syntax "10/2" 5 "5")
;; (test-numeric-syntax "-1/2" (- (/ 1 2)))
;; (test-numeric-syntax "0/10" 0 "0")
;; (test-numeric-syntax "#e0/10" 0 "0")
;; (test-numeric-syntax "#i3/2" (/ 3.0 2.0) "1.5")
;; ;; Exact complex
;; (test-numeric-syntax "1+2i" (make-rectangular 1 2))
;; (test-numeric-syntax "1+2I" (make-rectangular 1 2) "1+2i")
;; (test-numeric-syntax "1-2i" (make-rectangular 1 -2))
;; (test-numeric-syntax "-1+2i" (make-rectangular -1 2))
;; (test-numeric-syntax "-1-2i" (make-rectangular -1 -2))
;; (test-numeric-syntax "+i" (make-rectangular 0 1) "+i" "+1i" "0+i" "0+1i")
;; (test-numeric-syntax "0+i" (make-rectangular 0 1) "+i" "+1i" "0+i" "0+1i")
;; (test-numeric-syntax "0+1i" (make-rectangular 0 1) "+i" "+1i" "0+i" "0+1i")
;; (test-numeric-syntax "-i" (make-rectangular 0 -1) "-i" "-1i" "0-i" "0-1i")
;; (test-numeric-syntax "0-i" (make-rectangular 0 -1) "-i" "-1i" "0-i" "0-1i")
;; (test-numeric-syntax "0-1i" (make-rectangular 0 -1) "-i" "-1i" "0-i" "0-1i")
;; (test-numeric-syntax "+2i" (make-rectangular 0 2) "2i" "+2i" "0+2i")
;; (test-numeric-syntax "-2i" (make-rectangular 0 -2) "-2i" "0-2i")
;; ;; Decimal-notation complex numbers (rectangular notation)
;; (test-numeric-syntax "1.0+2i" (make-rectangular 1.0 2) "1.0+2.0i" "1.0+2i" "1.+2i" "1.+2.i")
;; (test-numeric-syntax "1+2.0i" (make-rectangular 1 2.0) "1.0+2.0i" "1+2.0i" "1.+2.i" "1+2.i")
;; (test-numeric-syntax "1e2+1.0i" (make-rectangular 100.0 1.0) "100.0+1.0i" "100.+1.i")
;; (test-numeric-syntax "1s2+1.0i" (make-rectangular 100.0 1.0) "100.0+1.0i" "100.+1.i")
;; (test-numeric-syntax "1.0+1e2i" (make-rectangular 1.0 100.0) "1.0+100.0i" "1.+100.i")
;; (test-numeric-syntax "1.0+1s2i" (make-rectangular 1.0 100.0) "1.0+100.0i" "1.+100.i")
;; ;; Fractional complex numbers (rectangular notation)
;; (test-numeric-syntax "1/2+3/4i" (make-rectangular (/ 1 2) (/ 3 4)))
;; ;; Mixed fractional/decimal notation complex numbers (rectangular notation)
;; (test-numeric-syntax "0.5+3/4i" (make-rectangular 0.5 (/ 3 4))
;;   "0.5+0.75i" ".5+.75i" "0.5+3/4i" ".5+3/4i" "500.0e-3+750.0e-3i")
;; ;; Complex NaN, Inf (rectangular notation)
;; ;;(test-numeric-syntax "+nan.0+nan.0i" (make-rectangular the-nan the-nan) "+NaN.0+NaN.0i") 
;; (test-numeric-syntax "+inf.0+inf.0i" (make-rectangular +inf.0 +inf.0) "+Inf.0+Inf.0i")
;; (test-numeric-syntax "-inf.0+inf.0i" (make-rectangular -inf.0 +inf.0) "-Inf.0+Inf.0i")
;; (test-numeric-syntax "-inf.0-inf.0i" (make-rectangular -inf.0 -inf.0) "-Inf.0-Inf.0i")
;; (test-numeric-syntax "+inf.0-inf.0i" (make-rectangular +inf.0 -inf.0) "+Inf.0-Inf.0i")
;; ;; Complex numbers (polar notation)
;; ;; Need to account for imprecision in write output.
;; ;;(test-numeric-syntax "1@2" -0.416146836547142+0.909297426825682i "-0.416146836547142+0.909297426825682i")
;; ;; Base prefixes
;; (test-numeric-syntax "#x11" 17 "17")
;; (test-numeric-syntax "#X11" 17 "17")
;; (test-numeric-syntax "#d11" 11 "11")
;; (test-numeric-syntax "#D11" 11 "11")
;; (test-numeric-syntax "#o11" 9 "9")
;; (test-numeric-syntax "#O11" 9 "9")
;; (test-numeric-syntax "#b11" 3 "3")
;; (test-numeric-syntax "#B11" 3 "3")
;; (test-numeric-syntax "#o7" 7 "7")
;; (test-numeric-syntax "#xa" 10 "10")
;; (test-numeric-syntax "#xA" 10 "10")
;; (test-numeric-syntax "#xf" 15 "15")
;; (test-numeric-syntax "#x-10" -16 "-16")
;; (test-numeric-syntax "#d-10" -10 "-10")
;; (test-numeric-syntax "#o-10" -8 "-8")
;; (test-numeric-syntax "#b-10" -2 "-2")
;; ;; Combination of prefixes
;; (test-numeric-syntax "#e#x10" 16 "16")
;; (test-numeric-syntax "#i#x10" 16.0 "16.0" "16.")
;; ;; (Attempted) decimal notation with base prefixes
;; (test-numeric-syntax "#d1." 1.0 "1.0" "1.")
;; (test-numeric-syntax "#d.1" 0.1 "0.1" ".1" "100.0e-3")
;; (test-numeric-syntax "#x1e2" 482 "482")
;; (test-numeric-syntax "#d1e2" 100.0 "100.0" "100.")
;; ;; Fractions with prefixes
;; (test-numeric-syntax "#x10/2" 8 "8")
;; (test-numeric-syntax "#x11/2" (/ 17 2) "17/2")
;; (test-numeric-syntax "#d11/2" (/ 11 2) "11/2")
;; (test-numeric-syntax "#o11/2" (/ 9 2) "9/2")
;; (test-numeric-syntax "#b11/10" (/ 3 2) "3/2")
;; ;; Complex numbers with prefixes
;; ;;(test-numeric-syntax "#x10+11i" (make-rectangular 16 17) "16+17i")
;; (test-numeric-syntax "#d1.0+1.0i" (make-rectangular 1.0 1.0) "1.0+1.0i" "1.+1.i")
;; (test-numeric-syntax "#d10+11i" (make-rectangular 10 11) "10+11i")
;; ;;(test-numeric-syntax "#o10+11i" (make-rectangular 8 9) "8+9i")
;; ;;(test-numeric-syntax "#b10+11i" (make-rectangular 2 3) "2+3i")
;; ;;(test-numeric-syntax "#e1.0+1.0i" (make-rectangular 1 1) "1+1i" "1+i")
;; ;;(test-numeric-syntax "#i1.0+1.0i" (make-rectangular 1.0 1.0) "1.0+1.0i" "1.+1.i")

(test-end)

(test-end)

(test-begin "6.14 System interface")

;; 6.14 System interface

;; (test "/usr/local/bin:/usr/bin:/bin" (get-environment-variable "PATH"))

;; (test #t (string? (get-environment-variable "PATH")))

;; (test '(("USER" . "root") ("HOME" . "/")) (get-environment-variables))

;; (let ((env (get-environment-variables)))
;;   (define (env-pair? x)
;;     (and (pair? x) (string? (car x)) (string? (cdr x))))
;;   (define (all? pred ls)
;;     (or (null? ls) (and (pred (car ls)) (all? pred (cdr ls)))))
;;   (test #t (list? env))
;;   (test #t (all? env-pair? env)))

(test #t (list? (command-line)))

(test #t (real? (current-second)))
(test #t (inexact? (current-second)))
(test #t (exact? (current-jiffy)))
(test #t (exact? (jiffies-per-second)))

(test #t (list? (features)))
(test #t (and (memq 'r7rs (features)) #t))

(test #t (file-exists? "."))
(test #f (file-exists? " no such file "))

;; (test #t (file-error?
;;           (guard (exn (else exn))
;;             (delete-file " no such file "))))

(test-end)

(test-end)

test-result

#x#x#x#x#x#x#x#x#x
case 1 PASS: x equals 28
case 2 PASS: 'a equals a
case 3 PASS: '#(a b c) equals #(a b c)
case 4 PASS: '(+ 1 2) equals (+ 1 2)
case 5 PASS: 'a equals a
case 6 PASS: '#(a b c) equals #(a b c)
case 7 PASS: '() equals ()
case 8 PASS: '(+ 1 2) equals (+ 1 2)
case 9 PASS: ''a equals 'a
case 10 PASS: ''a equals 'a
case 11 PASS: '"abc" equals "abc"
case 12 PASS: "abc" equals "abc"
case 13 PASS: '145932 equals 145932
case 14 PASS: 145932 equals 145932
case 15 PASS: '#t equals #t
case 16 PASS: #t equals #t
case 17 PASS: (+ 3 4) equals 7
case 18 PASS: ((if #f + *) 3 4) equals 12
case 19 PASS: ((lambda (x) (+ x x)) 4) equals 8
case 20 PASS: (reverse-subtract 7 10) equals 3
case 21 PASS: (add4 6) equals 10
case 22 PASS: ((lambda x x) 3 4 5 6) equals (3 4 5 6)
case 23 PASS: ((lambda (x y . z) z) 3 4 5 6) equals (5 6)
case 24 PASS: (if (> 3 2) 'yes 'no) equals yes
case 25 PASS: (if (> 2 3) 'yes 'no) equals no
case 26 PASS: (if (> 3 2) (- 3 2) (+ 3 2)) equals 1
case 27 PASS: (+ x 1) equals 3
case 28 PASS: (cond ((> 3 2) 'greater) ((< 3 2) 'less)) equals greater
case 29 PASS: (cond ((> 3 3) 'greater) ((< 3 3) 'less) (else 'equal)) equals equal
case 30 PASS: (cond ((assv 'b '((a 1) (b 2))) => cadr) (else #f)) equals 2
case 31 PASS: (case (* 2 3) ((2 3 5 7) 'prime) ((1 4 6 8 9) 'composite)) equals composite
case 32 PASS: (case (car '(c d)) ((a e i o u) 'vowel) ((w y) 'semivowel) (else => (lambda (x) x))) equals c
case 33 PASS: (map (lambda (x) (case x ((a e i o u) => (lambda (w) (cons 'vowel w))) ((w y) (cons 'semivowel x)) (else => (lambda (w) (cons 'other w))))) '(z y x w u)) equals ((other . z) (semivowel . y) (other . x) (semivowel . w) (vowel . u))
case 34 PASS: (and (= 2 2) (> 2 1)) equals #t
case 35 PASS: (and (= 2 2) (< 2 1)) equals #f
case 36 PASS: (and 1 2 'c '(f g)) equals (f g)
case 37 PASS: (and) equals #t
case 38 PASS: (or (= 2 2) (> 2 1)) equals #t
case 39 PASS: (or (= 2 2) (< 2 1)) equals #t
case 40 PASS: (or #f #f #f) equals #f
case 41 PASS: (or (memq 'b '(a b c)) (/ 3 0)) equals (b c)
case 42 PASS: (let ((x 2) (y 3)) (* x y)) equals 6
case 43 PASS: (let ((x 2) (y 3)) (let ((x 7) (z (+ x y))) (* z x))) equals 35
case 44 PASS: (let ((x 2) (y 3)) (let* ((x 7) (z (+ x y))) (* z x))) equals 70
case 45 PASS: (letrec ((even? (lambda (n) (if (zero? n) #t (odd? (- n 1))))) (odd? (lambda (n) (if (zero? n) #f (even? (- n 1)))))) (even? 88)) equals #t
case 46 PASS: (letrec* ((p (lambda (x) (+ 1 (q (- x 1))))) (q (lambda (y) (if (zero? y) 0 (+ 1 (p (- y 1)))))) (x (p 5)) (y x)) y) equals 5
case 47 PASS: a equals 27
case 48 FAIL: b
   expected 9.728000 but got 9.728000
case 49 PASS: c equals 3.621730
case 50 PASS: (* root rem) equals 35
case 51 FAIL: (let*-values (((root rem) (exact-integer-sqrt (expt 2 60)))) (list root rem))
   expected (1073741824 0) but got (1073741824 0.000000)
case 52 FAIL: (let*-values (((root rem) (exact-integer-sqrt (expt 2 61)))) (list root rem))
   expected (1518500249 -1294335345) but got (1518500249 3000632064.000000)
case 53 FAIL: (let*-values (((root rem) (exact-integer-sqrt (expt 2 119)))) (list root rem))
   expected (1067312712 1284148160) but got (-2147483648 664613997892457936451903530140172288.000000)
case 54 FAIL: (let*-values (((root rem) (exact-integer-sqrt (expt 2 120)))) (list root rem))
   expected (0 0) but got (-2147483648 1329227995784915872903807060280344576.000000)
case 55 FAIL: (let*-values (((root rem) (exact-integer-sqrt (expt 2 121)))) (list root rem))
   expected (2134625424 841625344) but got (-2147483648 2658455991569831745807614120560689152.000000)
case 56 FAIL: (let*-values (((root rem) (exact-integer-sqrt (expt 10 39)))) (list root rem))
   expected (-1 -1) but got (-2147483648 999999999999999939709166371603178586112.000000)
case 57 FAIL: rem
   expected 0 but got 1393796574908163946345982392040522594123776.000000
case 58 FAIL: (square root)
   expected 1393796574908163946345982392040522594123776.000000 but got 4611686018427387904.000000
case 59 PASS: (let ((a 'a) (b 'b) (x 'x) (y 'y)) (let*-values (((a b) (values x y)) ((x y) (values a b))) (list a b x y))) equals (x y x y)
case 60 PASS: (+ x 1) equals 6
case 61 PASS: (do ((vec (make-vector 5)) (i 0 (+ i 1))) ((= i 5) vec) (vector-set! vec i i)) equals #(0 1 2 3 4)
case 62 PASS: (let ((x '(1 3 5 7 9))) (do ((x x (cdr x)) (sum 0 (+ sum (car x)))) ((null? x) sum))) equals 25
case 63 PASS: (let loop ((numbers '(3 -2 1 6 -5)) (nonneg '()) (neg '())) (cond ((null? numbers) (list nonneg neg)) ((>= (car numbers) 0) (loop (cdr numbers) (cons (car numbers) nonneg) neg)) ((< (car numbers) 0) (loop (cdr numbers) nonneg (cons (car numbers) neg))))) equals ((6 1 3) (-5 -2))
case 64 PASS: (force (delay (+ 1 2))) equals 3
case 65 PASS: (let ((p (delay (+ 1 2)))) (list (force p) (force p))) equals (3 3)
case 66 PASS: (head (tail (tail integers))) equals 2
case 67 PASS: (head (tail (tail (stream-filter odd? integers)))) equals 5
case 68 PASS: (force p) equals 6
case 69 PASS: (begin (set! x 10) (force p)) equals 6
case 70 PASS: (promise? (delay (+ 2 2))) equals #t
case 71 PASS: (promise? (make-promise (+ 2 2))) equals #t
case 72 PASS: (let ((x (delay (+ 2 2)))) (force x) (promise? x)) equals #t
case 73 PASS: (let ((x (make-promise (+ 2 2)))) (force x) (promise? x)) equals #t
case 74 PASS: `(list ,(+ 1 2) 4) equals (list 3 4)
case 75 PASS: `(list ,name ',name) equals (list a 'a)
case 76 PASS: `(a ,(+ 1 2) ,@(map abs '(4 -5 6)) b) equals (a 3 4 5 6 b)
case 77 FAIL: `#(10 5 ,(square 2) ,@(map square '(4 3)) 8)
   expected #(10 5 4 16 9 8) but got #(10 5 ,(square 2) ,@(map square '(4 3)) 8)
case 78 PASS: `(a `(b ,(+ 1 2) ,(foo ,(+ 1 3) d) e) f) equals (a `(b ,(+ 1 2) ,(foo 4 d) e) f)
case 79 PASS: `(a `(b ,,name1 ,',name2 d) e) equals (a `(b ,x ,'y d) e)
case 80 PASS: `(list ,(+ 1 2) 4) equals (list 3 4)
case 81 PASS: `(list ,(+ 1 2) 4) equals (list 3 4)
case 82 PASS: (sequence 1 2 3 4) equals 4
case 83 PASS: (mad-hatter) equals 42
case 84 PASS: (let ((=> #f)) (cond (#t => 'ok))) equals ok
case 85 PASS: (add3 3) equals 6
case 86 PASS: (first '(1 2)) equals 1
case 87 PASS: (let () (define-values () (values)) 'ok) equals ok
case 88 PASS: (let () (define-values (x) (values 1)) x) equals 1
case 89 PASS: (let () (define-values (x y) (values 1 2)) (+ x y)) equals 3
case 90 PASS: (let () (define-values (x y z) (values 1 2 3)) (+ x y z)) equals 6
case 91 PASS: (let ((x 1) (y 2)) (define-syntax swap! (syntax-rules () ((swap! a b) (let ((tmp a)) (set! a b) (set! b tmp))))) (swap! x y) (list x y)) equals (2 1)
case 92 PASS: (pare? (kons 1 2)) equals #t
case 93 PASS: (pare? (cons 1 2)) equals #f
case 94 PASS: (kar (kons 1 2)) equals 1
case 95 PASS: (kdr (kons 1 2)) equals 2
case 96 PASS: (let ((k (kons 1 2))) (set-kar! k 3) (kar k)) equals 3
case 97 PASS: (eqv? 'a 'a) equals #t
case 98 PASS: (eqv? 'a 'b) equals #f
case 99 PASS: (eqv? 2 2) equals #t
case 100 PASS: (eqv? '() '()) equals #t
case 101 PASS: (eqv? 100000000 100000000) equals #t
case 102 PASS: (eqv? (cons 1 2) (cons 1 2)) equals #f
case 103 PASS: (eqv? (lambda () 1) (lambda () 2)) equals #f
case 104 PASS: (eqv? #f 'nil) equals #f
case 105 PASS: (let ((g (gen-counter))) (eqv? g g)) equals #t
case 106 PASS: (eqv? (gen-counter) (gen-counter)) equals #f
case 107 PASS: (let ((g (gen-loser))) (eqv? g g)) equals #t
case 108 PASS: (letrec ((f (lambda () (if (eqv? f g) 'f 'both))) (g (lambda () (if (eqv? f g) 'g 'both)))) (eqv? f g)) equals #f
case 109 PASS: (let ((x '(a))) (eqv? x x)) equals #t
case 110 PASS: (eq? 'a 'a) equals #t
case 111 PASS: (eq? (list 'a) (list 'a)) equals #f
case 112 PASS: (eq? '() '()) equals #t
case 113 PASS: (let ((x '(a))) (eq? x x)) equals #t
case 114 PASS: (let ((x '#())) (eq? x x)) equals #t
case 115 PASS: (let ((p (lambda (x) x))) (eq? p p)) equals #t
case 116 PASS: (equal? 'a 'a) equals #t
case 117 PASS: (equal? '(a) '(a)) equals #t
case 118 PASS: (equal? '(a (b) c) '(a (b) c)) equals #t
case 119 PASS: (equal? "abc" "abc") equals #t
case 120 PASS: (equal? 2 2) equals #t
case 121 PASS: (equal? (make-vector 5 'a) (make-vector 5 'a)) equals #t
case 122 PASS: (complex? 3) equals #t
case 123 PASS: (real? 3) equals #t
case 124 PASS: (real? inf) equals #t
case 125 FAIL: (rational? -inf)
   expected #f but got #t
case 126 PASS: (integer? 3.000000) equals #t
case 127 PASS: (exact? 3.000000) equals #f
case 128 PASS: (exact-integer? 32) equals #t
case 129 PASS: (exact-integer? 32.000000) equals #f
case 130 PASS: (finite? 3) equals #t
case 131 PASS: (finite? inf) equals #f
case 132 PASS: (infinite? 3) equals #f
case 133 PASS: (infinite? inf) equals #t
case 134 PASS: (infinite? nan) equals #f
case 135 PASS: (nan? nan) equals #t
case 136 PASS: (nan? 32) equals #f
case 137 PASS: (if (and (= a b) (= b c)) (= a c) #t) equals #t
case 138 PASS: (if (and (<= a j) (< j (+ j 1))) (not (<= (+ j 1) a)) #t) equals #t
case 139 PASS: (zero? 0) equals #t
case 140 PASS: (zero? 0.000000) equals #t
case 141 PASS: (zero? 1) equals #f
case 142 PASS: (zero? -1) equals #f
case 143 PASS: (positive? 0) equals #f
case 144 PASS: (positive? 0.000000) equals #f
case 145 PASS: (positive? 1) equals #t
case 146 PASS: (positive? 1.000000) equals #t
case 147 PASS: (positive? -1) equals #f
case 148 PASS: (positive? -1.000000) equals #f
case 149 PASS: (positive? inf) equals #t
case 150 PASS: (positive? -inf) equals #f
case 151 PASS: (negative? 0) equals #f
case 152 PASS: (negative? 0.000000) equals #f
case 153 PASS: (negative? 1) equals #f
case 154 PASS: (negative? 1.000000) equals #f
case 155 PASS: (negative? -1) equals #t
case 156 PASS: (negative? -1.000000) equals #t
case 157 PASS: (negative? inf) equals #f
case 158 PASS: (negative? -inf) equals #t
case 159 PASS: (odd? 0) equals #f
case 160 PASS: (odd? 1) equals #t
case 161 PASS: (odd? -1) equals #t
case 162 PASS: (odd? 102) equals #f
case 163 PASS: (even? 0) equals #t
case 164 PASS: (even? 1) equals #f
case 165 PASS: (even? -2) equals #t
case 166 PASS: (even? 102) equals #t
case 167 PASS: (max 3) equals 3
case 168 PASS: (max 3 4) equals 4
case 169 PASS: (max 3.900000 4) equals 4.000000
case 170 PASS: (max 5 3.900000 4) equals 5.000000
case 171 PASS: (max 100 inf) equals inf
case 172 PASS: (min 3) equals 3
case 173 PASS: (min 3 4) equals 3
case 174 PASS: (min 3 3.100000) equals 3.000000
case 175 PASS: (min -inf -100) equals -inf
case 176 PASS: (+ 3 4) equals 7
case 177 PASS: (+ 3) equals 3
case 178 PASS: (+) equals 0
case 179 PASS: (* 4) equals 4
case 180 PASS: (*) equals 1
case 181 PASS: (- 3 4) equals -1
case 182 PASS: (- 3 4 5) equals -6
case 183 PASS: (- 3) equals -3
case 184 PASS: (abs -7) equals 7
case 185 PASS: (abs 7) equals 7
case 186 PASS: (modulo 13 4) equals 1
case 187 PASS: (remainder 13 4) equals 1
case 188 PASS: (modulo -13 4) equals 3
case 189 PASS: (remainder -13 4) equals -1
case 190 PASS: (modulo 13 -4) equals -3
case 191 PASS: (remainder 13 -4) equals 1
case 192 PASS: (modulo -13 -4) equals -1
case 193 PASS: (remainder -13 -4) equals -1
case 194 PASS: (remainder -13 -4.000000) equals -1.000000
case 195 PASS: (gcd 32 -36) equals 4
case 196 PASS: (gcd) equals 0
case 197 PASS: (lcm 32 -36) equals 288
case 198 PASS: (lcm 32.000000 -36) equals 288.000000
case 199 PASS: (lcm) equals 1
case 200 PASS: (floor -4.300000) equals -5.000000
case 201 PASS: (ceiling -4.300000) equals -4.000000
case 202 PASS: (truncate -4.300000) equals -4.000000
case 203 PASS: (round -4.300000) equals -4.000000
case 204 PASS: (floor 3.500000) equals 3.000000
case 205 PASS: (ceiling 3.500000) equals 4.000000
case 206 PASS: (truncate 3.500000) equals 3.000000
case 207 PASS: (round 3.500000) equals 4.000000
case 208 PASS: (round 7) equals 7
case 209 PASS: (inexact (exp 0)) equals 1.000000
case 210 FAIL: (exp 3)
   expected 20.085537 but got 20.085537
case 211 PASS: (inexact (log 1)) equals 0.000000
case 212 PASS: (log (exp 1)) equals 1.000000
case 213 PASS: (log (exp 42)) equals 42.000000
case 214 PASS: (log 100 10) equals 2.000000
case 215 PASS: (log 4096 2) equals 12.000000
case 216 PASS: (inexact (sin 0)) equals 0.000000
case 217 PASS: (sin 1.570796) equals 1.000000
case 218 PASS: (inexact (cos 0)) equals 1.000000
case 219 PASS: (cos 3.141593) equals -1.000000
case 220 PASS: (inexact (tan 0)) equals 0.000000
case 221 FAIL: (tan 1)
   expected 1.557408 but got 1.557408
case 222 PASS: (asin 0) equals 0.000000
case 223 FAIL: (asin 1)
   expected 1.570796 but got 1.570796
case 224 PASS: (acos 1) equals 0.000000
case 225 FAIL: (acos -1)
   expected 3.141593 but got 3.141593
case 226 PASS: (atan 0.000000 1.000000) equals 0.000000
case 227 PASS: (atan -0.000000 1.000000) equals -0.000000
case 228 FAIL: (atan 1.000000 1.000000)
   expected 0.785398 but got 0.785398
case 229 FAIL: (atan 1.000000 0.000000)
   expected 1.570796 but got 1.570796
case 230 FAIL: (atan 1.000000 -1.000000)
   expected 2.356194 but got 2.356194
case 231 FAIL: (atan 0.000000 -1.000000)
   expected 3.141593 but got 3.141593
case 232 FAIL: (atan -0.000000 -1.000000)
   expected -3.141593 but got -3.141593
case 233 FAIL: (atan -1.000000 -1.000000)
   expected -2.356194 but got -2.356194
case 234 FAIL: (atan -1.000000 0.000000)
   expected -1.570796 but got -1.570796
case 235 FAIL: (atan -1.000000 1.000000)
   expected -0.785398 but got -0.785398
case 236 PASS: (square 42) equals 1764
case 237 PASS: (square 2) equals 4
case 238 PASS: (inexact (sqrt 9)) equals 3.000000
case 239 FAIL: (sqrt 2)
   expected 1.414214 but got 1.414214
case 240 PASS: (call-with-values (lambda () (exact-integer-sqrt 4)) list) equals (2 0)
case 241 PASS: (call-with-values (lambda () (exact-integer-sqrt 5)) list) equals (2 1)
case 242 PASS: (expt 3 3) equals 27
case 243 PASS: (expt 0 0) equals 1
case 244 PASS: (expt 0 1) equals 0
case 245 PASS: (expt 0.000000 0) equals 1.000000
case 246 PASS: (expt 0 1.000000) equals 0.000000
case 247 PASS: (inexact 1) equals 1.000000
case 248 PASS: (inexact? (inexact 1)) equals #t
case 249 PASS: (exact 1.000000) equals 1
case 250 PASS: (exact? (exact 1.000000)) equals #t
case 251 PASS: (string->number "100") equals 100
case 252 PASS: (string->number "100" 16) equals 256
case 253 PASS: (string->number "1e2") equals 100.000000
case 254 PASS: #t equals #t
case 255 PASS: #f equals #f
case 256 PASS: '#f equals #f
case 257 PASS: (not #t) equals #f
case 258 PASS: (not 3) equals #f
case 259 PASS: (not (list 3)) equals #f
case 260 PASS: (not #f) equals #t
case 261 PASS: (not '()) equals #f
case 262 PASS: (not (list)) equals #f
case 263 PASS: (not 'nil) equals #f
case 264 PASS: (boolean? #f) equals #t
case 265 PASS: (boolean? 0) equals #f
case 266 PASS: (boolean? '()) equals #f
case 267 PASS: (boolean=? #t #t) equals #t
case 268 PASS: (boolean=? #f #f) equals #t
case 269 PASS: (boolean=? #t #f) equals #f
case 270 PASS: (boolean=? #f #f #f) equals #t
case 271 PASS: (boolean=? #t #t #f) equals #f
case 272 PASS: (values y) equals (a b c)
case 273 PASS: (list? y) equals #t
case 274 PASS: (values x) equals (a . 4)
case 275 PASS: (eqv? x y) equals #t
case 276 PASS: (list? y) equals #f
case 277 PASS: (list? x) equals #f
case 278 PASS: (pair? '(a . b)) equals #t
case 279 PASS: (pair? '(a b c)) equals #t
case 280 PASS: (pair? '()) equals #f
case 281 PASS: (pair? '#(a b)) equals #f
case 282 PASS: (cons 'a '()) equals (a)
case 283 PASS: (cons '(a) '(b c d)) equals ((a) b c d)
case 284 PASS: (cons "a" '(b c)) equals ("a" b c)
case 285 PASS: (cons 'a 3) equals (a . 3)
case 286 PASS: (cons '(a b) 'c) equals ((a b) . c)
case 287 PASS: (car '(a b c)) equals a
case 288 PASS: (car '((a) b c d)) equals (a)
case 289 PASS: (car '(1 . 2)) equals 1
case 290 PASS: (cdr '((a) b c d)) equals (b c d)
case 291 PASS: (cdr '(1 . 2)) equals 2
case 292 PASS: (list? '(a b c)) equals #t
case 293 PASS: (list? '()) equals #t
case 294 PASS: (list? '(a . b)) equals #f
case 295 PASS: (let ((x (list 'a))) (set-cdr! x x) (list? x)) equals #f
case 296 PASS: (make-list 2 3) equals (3 3)
case 297 PASS: (list 'a (+ 3 4) 'c) equals (a 7 c)
case 298 PASS: (list) equals ()
case 299 PASS: (length '(a b c)) equals 3
case 300 PASS: (length '(a (b) (c d e))) equals 3
case 301 PASS: (length '()) equals 0
case 302 PASS: (append '(x) '(y)) equals (x y)
case 303 PASS: (append '(a) '(b c d)) equals (a b c d)
case 304 PASS: (append '(a (b)) '((c))) equals (a (b) (c))
case 305 PASS: (append '(a b) '(c . d)) equals (a b c . d)
case 306 PASS: (append '() 'a) equals a
case 307 PASS: (reverse '(a b c)) equals (c b a)
case 308 PASS: (reverse '(a (b c) d (e (f)))) equals ((e (f)) d (b c) a)
case 309 PASS: (list-tail '(a b c d e) 3) equals (d e)
case 310 PASS: (list-ref '(a b c d) 2) equals c
case 311 PASS: (list-ref '(a b c d) (exact (round 1.800000))) equals c
case 312 PASS: (let ((lst (list 0 '(2 2 2 2) "Anna"))) (list-set! lst 1 '("Sue" "Sue")) lst) equals (0 ("Sue" "Sue") "Anna")
case 313 PASS: (memq 'a '(a b c)) equals (a b c)
case 314 PASS: (memq 'b '(a b c)) equals (b c)
case 315 PASS: (memq 'a '(b c d)) equals #f
case 316 PASS: (memq (list 'a) '(b (a) c)) equals #f
case 317 PASS: (member (list 'a) '(b (a) c)) equals ((a) c)
case 318 PASS: (memv 101 '(100 101 102)) equals (101 102)
case 319 PASS: (assq 'a e) equals (a 1)
case 320 PASS: (assq 'b e) equals (b 2)
case 321 PASS: (assq 'd e) equals #f
case 322 PASS: (assq (list 'a) '(((a)) ((b)) ((c)))) equals #f
case 323 PASS: (assoc (list 'a) '(((a)) ((b)) ((c)))) equals ((a))
case 324 PASS: (assoc 2.000000 '((1 1) (2 4) (3 9)) =) equals (2 4)
case 325 PASS: (assv 5 '((2 3) (5 7) (11 13))) equals (5 7)
case 326 PASS: (list-copy '(1 2 3)) equals (1 2 3)
case 327 PASS: (list-copy "foo") equals "foo"
case 328 PASS: (list-copy '()) equals ()
case 329 PASS: (list-copy '(3 . 4)) equals (3 . 4)
case 330 PASS: (list-copy '(6 7 8 . 9)) equals (6 7 8 . 9)
case 331 PASS: '((a b) (c d) e) equals ((a b) (c d) e)
case 332 PASS: (eq? (car l1) (car l2)) equals #t
case 333 PASS: (eq? (cadr l1) (cadr l2)) equals #t
case 334 PASS: (eq? (cdr l1) (cdr l2)) equals #f
case 335 PASS: (eq? (cddr l1) (cddr l2)) equals #f
case 336 PASS: (symbol? 'foo) equals #t
case 337 PASS: (symbol? (car '(a b))) equals #t
case 338 PASS: (symbol? "bar") equals #f
case 339 PASS: (symbol? 'nil) equals #t
case 340 PASS: (symbol? '()) equals #f
case 341 PASS: (symbol? #f) equals #f
case 342 PASS: (symbol=? 'a 'a) equals #t
case 343 PASS: (symbol=? 'a 'A) equals #f
case 344 PASS: (symbol=? 'a 'a 'a) equals #t
case 345 PASS: (symbol=? 'a 'a 'A) equals #f
case 346 PASS: (symbol->string 'flying-fish) equals "flying-fish"
case 347 PASS: (symbol->string 'Martin) equals "Martin"
case 348 PASS: (symbol->string (string->symbol "Malvina")) equals "Malvina"
case 349 PASS: (string->symbol "mISSISSIppi") equals mISSISSIppi
case 350 PASS: (eq? 'bitBlt (string->symbol "bitBlt")) equals #t
case 351 PASS: (eq? 'LollyPop (string->symbol (symbol->string 'LollyPop))) equals #t
case 352 PASS: (string=? "K. Harper, M.D." (symbol->string (string->symbol "K. Harper, M.D."))) equals #t
case 353 PASS: (char? #\a) equals #t
case 354 PASS: (char? "a") equals #f
case 355 PASS: (char? 'a) equals #f
case 356 PASS: (char? 0) equals #f
case 357 PASS: (char=? #\a #\a #\a) equals #t
case 358 PASS: (char=? #\a #\A) equals #f
case 359 PASS: (char<? #\a #\b #\c) equals #t
case 360 PASS: (char<? #\a #\a) equals #f
case 361 PASS: (char<? #\b #\a) equals #f
case 362 PASS: (char>? #\a #\b) equals #f
case 363 PASS: (char>? #\a #\a) equals #f
case 364 PASS: (char>? #\c #\b #\a) equals #t
case 365 PASS: (char<=? #\a #\b #\b) equals #t
case 366 PASS: (char<=? #\a #\a) equals #t
case 367 PASS: (char<=? #\b #\a) equals #f
case 368 PASS: (char>=? #\a #\b) equals #f
case 369 PASS: (char>=? #\a #\a) equals #t
case 370 PASS: (char>=? #\b #\b #\a) equals #t
case 371 PASS: (char->integer #\a) equals 97
case 372 PASS: (integer->char 97) equals #\a
case 373 PASS: (string? "") equals #t
case 374 PASS: (string? " ") equals #t
case 375 PASS: (string? 'a) equals #f
case 376 PASS: (string? #\a) equals #f
case 377 PASS: (string-length (make-string 3)) equals 3
case 378 PASS: (make-string 3 #\-) equals "---"
case 379 PASS: (string) equals ""
case 380 PASS: (string #\- #\- #\-) equals "---"
case 381 PASS: (string #\k #\i #\t #\t #\e #\n) equals "kitten"
case 382 PASS: (string-length "") equals 0
case 383 PASS: (string-length "a") equals 1
case 384 PASS: (string-length "abc") equals 3
case 385 PASS: (string-ref "abc" 0) equals #\a
case 386 PASS: (string-ref "abc" 1) equals #\b
case 387 PASS: (string-ref "abc" 2) equals #\c
case 388 PASS: (let ((str (string #\a #\b #\c))) (string-set! str 1 #\-) str) equals "a-c"
case 389 PASS: (string=? "abc" "abc" "abc") equals #t
case 390 PASS: (string=? "" "abc") equals #f
case 391 PASS: (string=? "abc" "aBc") equals #f
case 392 PASS: (string<? "" "") equals #f
case 393 PASS: (string<? "abc" "abc") equals #f
case 394 PASS: (string<? "abc" "abcd" "acd") equals #t
case 395 PASS: (string<? "abcd" "abc") equals #f
case 396 PASS: (string<? "abc" "bbc") equals #t
case 397 PASS: (string>? "" "") equals #f
case 398 PASS: (string>? "abc" "abc") equals #f
case 399 PASS: (string>? "abc" "abcd") equals #f
case 400 PASS: (string>? "acd" "abcd" "abc") equals #t
case 401 PASS: (string>? "abc" "bbc") equals #f
case 402 PASS: (string<=? "" "") equals #t
case 403 PASS: (string<=? "abc" "abc") equals #t
case 404 PASS: (string<=? "abc" "abcd" "abcd") equals #t
case 405 PASS: (string<=? "abcd" "abc") equals #f
case 406 PASS: (string<=? "abc" "bbc") equals #t
case 407 PASS: (string>=? "" "") equals #t
case 408 PASS: (string>=? "abc" "abc") equals #t
case 409 PASS: (string>=? "abc" "abcd") equals #f
case 410 PASS: (string>=? "abcd" "abcd" "abc") equals #t
case 411 PASS: (string>=? "abc" "bbc") equals #f
case 412 PASS: (substring "" 0 0) equals ""
case 413 PASS: (substring "a" 0 0) equals ""
case 414 PASS: (substring "abc" 1 1) equals ""
case 415 PASS: (substring "abc" 0 2) equals "ab"
case 416 PASS: (substring "abc" 1 3) equals "bc"
case 417 PASS: (string-append "") equals ""
case 418 PASS: (string-append "" "") equals ""
case 419 PASS: (string-append "" "abc") equals "abc"
case 420 PASS: (string-append "abc" "") equals "abc"
case 421 PASS: (string-append "abc" "de") equals "abcde"
case 422 PASS: (string-append "abc" "de" "f") equals "abcdef"
case 423 PASS: (string->list "") equals ()
case 424 PASS: (string->list "a") equals (#\a)
case 425 PASS: (string->list "abc") equals (#\a #\b #\c)
case 426 PASS: (string->list "abc" 0) equals (#\a #\b #\c)
case 427 PASS: (string->list "abc" 1) equals (#\b #\c)
case 428 PASS: (string->list "abc" 1 3) equals (#\b #\c)
case 429 PASS: (list->string '()) equals ""
case 430 PASS: (list->string '(#\a #\b #\c)) equals "abc"
case 431 PASS: (string-copy "") equals ""
case 432 PASS: (string-copy "" 0) equals ""
case 433 PASS: (string-copy "" 0 0) equals ""
case 434 PASS: (string-copy "abc") equals "abc"
case 435 PASS: (string-copy "abc" 0) equals "abc"
case 436 PASS: (string-copy "abc" 1) equals "bc"
case 437 PASS: (string-copy "abc" 1 2) equals "b"
case 438 PASS: (string-copy "abc" 1 3) equals "bc"
case 439 PASS: (vector? #()) equals #t
case 440 PASS: (vector? #(1 2 3)) equals #t
case 441 PASS: (vector? '#(1 2 3)) equals #t
case 442 PASS: (vector-length (make-vector 0)) equals 0
case 443 PASS: (vector-length (make-vector 1000)) equals 1000
case 444 PASS: '#(0 (2 2 2 2) "Anna") equals #(0 (2 2 2 2) "Anna")
case 445 PASS: (vector 'a 'b 'c) equals #(a b c)
case 446 PASS: (vector-ref '#(1 1 2 3 5 8 13 21) 5) equals 8
case 447 PASS: (vector-ref '#(1 1 2 3 5 8 13 21) (let ((i (round (* 2 (acos -1))))) (if (inexact? i) (exact i) i))) equals 13
case 448 PASS: (let ((vec (vector 0 '(2 2 2 2) "Anna"))) (vector-set! vec 1 '("Sue" "Sue")) vec) equals #(0 ("Sue" "Sue") "Anna")
case 449 PASS: (vector->list '#(dah dah didah)) equals (dah dah didah)
case 450 PASS: (vector->list '#(dah dah didah) 1) equals (dah didah)
case 451 PASS: (vector->list '#(dah dah didah) 1 2) equals (dah)
case 452 PASS: (list->vector '(dididit dah)) equals #(dididit dah)
case 453 PASS: (string->vector "") equals #()
case 454 PASS: (string->vector "ABC") equals #(#\A #\B #\C)
case 455 PASS: (string->vector "ABC" 1) equals #(#\B #\C)
case 456 PASS: (string->vector "ABC" 1 2) equals #(#\B)
case 457 PASS: (vector->string #()) equals ""
case 458 PASS: (vector->string #(#\1 #\2 #\3)) equals "123"
case 459 PASS: (vector->string #(#\1 #\2 #\3) 1) equals "23"
case 460 PASS: (vector->string #(#\1 #\2 #\3) 1 2) equals "2"
case 461 PASS: (vector-copy #()) equals #()
case 462 PASS: (vector-copy #(a b c)) equals #(a b c)
case 463 PASS: (vector-copy #(a b c) 1) equals #(b c)
case 464 PASS: (vector-copy #(a b c) 1 2) equals #(b)
case 465 PASS: (vector-append #()) equals #()
case 466 PASS: (vector-append #() #()) equals #()
case 467 PASS: (vector-append #() #(a b c)) equals #(a b c)
case 468 PASS: (vector-append #(a b c) #()) equals #(a b c)
case 469 PASS: (vector-append #(a b c) #(d e)) equals #(a b c d e)
case 470 PASS: (vector-append #(a b c) #(d e) #(f)) equals #(a b c d e f)
case 471 PASS: (let ((vec (vector 1 2 3 4 5))) (vector-fill! vec 'smash 2 4) vec) equals #(1 2 smash smash 5)
case 472 PASS: (let ((vec (vector 1 2 3 4 5))) (vector-fill! vec 'x) vec) equals #(x x x x x)
case 473 PASS: (let ((vec (vector 1 2 3 4 5))) (vector-fill! vec 'x 2) vec) equals #(1 2 x x x)
case 474 PASS: (let ((vec (vector 1 2 3 4 5))) (vector-fill! vec 'x 2 3) vec) equals #(1 2 x 4 5)
case 475 PASS: (let ((vec (vector 1 2 3 4 5))) (vector-copy! vec 1 #(a b c d e) 0 2) vec) equals #(1 a b 4 5)
case 476 PASS: (let ((vec (vector 1 2 3 4 5))) (vector-copy! vec 0 #(a b c d e)) vec) equals #(a b c d e)
case 477 PASS: (let ((vec (vector 1 2 3 4 5))) (vector-copy! vec 0 #(a b c d e) 2) vec) equals #(c d e 4 5)
case 478 PASS: (let ((vec (vector 1 2 3 4 5))) (vector-copy! vec 2 #(a b c d e) 0 3) vec) equals #(1 2 a b c)
case 479 PASS: (let ((vec (vector 1 2 3 4 5))) (vector-copy! vec 2 #(a b c d e) 2 3) vec) equals #(1 2 c 4 5)
case 480 FAIL: (let ((vec (vector 1 2 3 4 5))) (vector-copy! vec 1 vec 0 2) vec)
   expected #(1 1 2 4 5) but got #(1 1 1 4 5)
case 481 PASS: (let ((vec (vector 1 2 3 4 5))) (vector-copy! vec 3 vec 0 2) vec) equals #(1 2 3 1 2)
case 482 PASS: (bytevector? #u8()) equals #t
case 483 PASS: (bytevector? #u8(0 1 2)) equals #t
case 484 PASS: (bytevector? #()) equals #f
case 485 PASS: (bytevector? #(0 1 2)) equals #f
case 486 PASS: (bytevector? '()) equals #f
case 487 PASS: (bytevector? (make-bytevector 0)) equals #t
case 488 PASS: (bytevector-length (make-bytevector 0)) equals 0
case 489 PASS: (bytevector-length (make-bytevector 1024)) equals 1024
case 490 PASS: (bytevector-length (make-bytevector 1024 255)) equals 1024
case 491 PASS: (bytevector-length (bytevector 0 1 2)) equals 3
case 492 PASS: (bytevector-u8-ref (bytevector 0 1 2) 0) equals 0
case 493 PASS: (bytevector-u8-ref (bytevector 0 1 2) 1) equals 1
case 494 PASS: (bytevector-u8-ref (bytevector 0 1 2) 2) equals 2
case 495 PASS: (let ((bv (bytevector 0 1 2))) (bytevector-u8-set! bv 1 255) bv) equals #u8(0 -1 2)
case 496 PASS: (bytevector-copy #u8()) equals #u8()
case 497 PASS: (bytevector-copy #u8(0 1 2)) equals #u8(0 1 2)
case 498 PASS: (bytevector-copy #u8(0 1 2) 1) equals #u8(1 2)
case 499 PASS: (bytevector-copy #u8(0 1 2) 1 2) equals #u8(1)
case 500 PASS: (let ((bv (bytevector 1 2 3 4 5))) (bytevector-copy! bv 1 #u8(6 7 8 9 10) 0 2) bv) equals #u8(1 6 7 4 5)
case 501 PASS: (let ((bv (bytevector 1 2 3 4 5))) (bytevector-copy! bv 0 #u8(6 7 8 9 10)) bv) equals #u8(6 7 8 9 10)
case 502 PASS: (let ((bv (bytevector 1 2 3 4 5))) (bytevector-copy! bv 0 #u8(6 7 8 9 10) 2) bv) equals #u8(8 9 10 4 5)
case 503 PASS: (let ((bv (bytevector 1 2 3 4 5))) (bytevector-copy! bv 2 #u8(6 7 8 9 10) 0 3) bv) equals #u8(1 2 6 7 8)
case 504 PASS: (let ((bv (bytevector 1 2 3 4 5))) (bytevector-copy! bv 2 #u8(6 7 8 9 10) 2 3) bv) equals #u8(1 2 8 4 5)
case 505 FAIL: (let ((bv (bytevector 1 2 3 4 5))) (bytevector-copy! bv 1 bv 0 2) bv)
   expected #u8(1 1 2 4 5) but got #u8(1 1 1 4 5)
case 506 PASS: (let ((bv (bytevector 1 2 3 4 5))) (bytevector-copy! bv 3 bv 0 2) bv) equals #u8(1 2 3 1 2)
case 507 PASS: (bytevector-append #u8()) equals #u8()
case 508 PASS: (bytevector-append #u8() #u8()) equals #u8()
case 509 PASS: (bytevector-append #u8() #u8(0 1 2)) equals #u8(0 1 2)
case 510 PASS: (bytevector-append #u8(0 1 2) #u8()) equals #u8(0 1 2)
case 511 PASS: (bytevector-append #u8(0 1 2) #u8(3 4)) equals #u8(0 1 2 3 4)
case 512 PASS: (bytevector-append #u8(0 1 2) #u8(3 4) #u8(5)) equals #u8(0 1 2 3 4 5)
case 513 FAIL: (utf8->string #u8(41 42 43))
   expected "ABC" but got ")*+"
case 514 FAIL: (utf8->string #u8(0 41 42 43) 1)
   expected "ABC" but got ")*+"
case 515 FAIL: (utf8->string #u8(0 41 42 43 0) 1 4)
   expected "ABC" but got ")*+"
case 516 PASS: (procedure? car) equals #t
case 517 PASS: (procedure? 'car) equals #f
case 518 PASS: (procedure? (lambda (x) (* x x))) equals #t
case 519 PASS: (procedure? '(lambda (x) (* x x))) equals #f
case 520 PASS: (call-with-current-continuation procedure?) equals #t
case 521 PASS: (apply + (list 3 4)) equals 7
case 522 PASS: (call-with-values (lambda () ((compose exact-integer-sqrt *) 12 75)) list) equals (30 0)
case 523 PASS: (map cadr '((a b) (d e) (g h))) equals (b e h)
case 524 PASS: (map (lambda (n) (expt n n)) '(1 2 3 4 5)) equals (1 4 27 256 3125)
case 525 PASS: (map + '(1 2 3) '(4 5 6 7)) equals (5 7 9)
case 526 PASS: (let ((res (let ((count 0)) (map (lambda (ignored) (set! count (+ count 1)) count) '(a b))))) (or (equal? res '(1 2)) (equal? res '(2 1)))) equals #t
case 527 PASS: (let ((ls1 (list 10 100 1000)) (ls2 (list 1 2 3 4 5 6))) (set-cdr! (cddr ls1) ls1) (map * ls1 ls2)) equals (10 200 3000 40 500 6000)
case 528 PASS: (string-map (lambda (c) (integer->char (+ 1 (char->integer c)))) "HAL") equals "IBM"
case 529 PASS: (vector-map cadr '#((a b) (d e) (g h))) equals #(b e h)
case 530 PASS: (vector-map (lambda (n) (expt n n)) '#(1 2 3 4 5)) equals #(1 4 27 256 3125)
case 531 PASS: (vector-map + '#(1 2 3) '#(4 5 6 7)) equals #(5 7 9)
case 532 PASS: (let ((res (let ((count 0)) (vector-map (lambda (ignored) (set! count (+ count 1)) count) '#(a b))))) (or (equal? res #(1 2)) (equal? res #(2 1)))) equals #t
case 533 PASS: (let ((v (make-vector 5))) (for-each (lambda (i) (vector-set! v i (* i i))) '(0 1 2 3 4)) v) equals #(0 1 4 9 16)
case 534 PASS: (let ((ls1 (list 10 100 1000)) (ls2 (list 1 2 3 4 5 6)) (count 0)) (set-cdr! (cddr ls1) ls1) (for-each (lambda (x y) (set! count (+ count (* x y)))) ls2 ls1) count) equals 9750
case 535 PASS: (let ((v '())) (string-for-each (lambda (c) (set! v (cons (char->integer c) v))) "abcde") v) equals (101 100 99 98 97)
case 536 PASS: (let ((v (make-list 5))) (vector-for-each (lambda (i) (list-set! v i (* i i))) '#(0 1 2 3 4)) v) equals (0 1 4 9 16)
case 537 PASS: (call-with-current-continuation (lambda (exit) (for-each (lambda (x) (if (negative? x) (exit x))) '(54 0 37 -3 245 19)) #t)) equals -3
case 538 PASS: (list-length '(1 2 3 4)) equals 4
case 539 PASS: (list-length '(a b . c)) equals #f
case 540 PASS: (call-with-values (lambda () (values 4 5)) (lambda (a b) b)) equals 5
case 541 PASS: (call-with-values * -) equals -1
case 542 PASS: (test-exception-handler-1 5) equals 106
case 543 PASS: something-went-wrong equals #f
case 544 PASS: (test-exception-handler-1 -1) equals exception
case 545 FAIL: something-went-wrong
   expected ("condition: " an-error) but got ("condition: " #<error 0x1c4a250>)
case 546 PASS: (port? (current-input-port)) equals #t
case 547 PASS: (input-port? (current-input-port)) equals #t
case 548 PASS: (output-port? (current-output-port)) equals #t
case 549 PASS: (output-port? (current-error-port)) equals #t
case 550 PASS: (input-port? (open-input-string "abc")) equals #t
case 551 PASS: (output-port? (open-output-string)) equals #t
case 552 PASS: (textual-port? (open-input-string "abc")) equals #t
case 553 PASS: (textual-port? (open-output-string)) equals #t
case 554 PASS: (binary-port? (open-input-bytevector #u8(0 1 2))) equals #t
case 555 PASS: (binary-port? (open-output-bytevector)) equals #t
case 556 PASS: (input-port-open? (open-input-string "abc")) equals #t
case 557 PASS: (output-port-open? (open-output-string)) equals #t
case 558 PASS: (let ((in (open-input-string "abc"))) (close-input-port in) (input-port-open? in)) equals #f
case 559 PASS: (let ((out (open-output-string))) (close-output-port out) (output-port-open? out)) equals #f
case 560 PASS: (let ((out (open-output-string))) (close-port out) (output-port-open? out)) equals #f
case 561 PASS: (eof-object? (eof-object)) equals #t
case 562 PASS: (char-ready? (open-input-string "42")) equals #t
case 563 PASS: (eof-object? (read-char (open-input-string ""))) equals #t
case 564 PASS: (read-char (open-input-string "abc")) equals #\a
case 565 PASS: (eof-object? (read-line (open-input-string ""))) equals #t
case 566 PASS: (read-line (open-input-string "abc")) equals "abc"
case 567 PASS: (read-line (open-input-string "abc
def
")) equals "abc"
case 568 PASS: (eof-object? (read-string 3 (open-input-string ""))) equals #t
case 569 PASS: (read-string 3 (open-input-string "abcd")) equals "abc"
case 570 PASS: (read-string 3 (open-input-string "abc
def
")) equals "abc"
case 571 PASS: (let ((out (open-output-string))) (write 'abc out) (get-output-string out)) equals "abc"
case 572 PASS: (let ((out (open-output-string))) (display "abc def" out) (get-output-string out)) equals "abc def"
case 573 PASS: (let ((out (open-output-string))) (display #\a out) (display "b" out) (display #\c out) (get-output-string out)) equals "abc"
case 574 PASS: (let* ((out (open-output-string)) (r (begin (newline out) (get-output-string out)))) (or (equal? r "
") (equal? r "
"))) equals #t
case 575 PASS: (let ((out (open-output-string))) (write-string "abc def" out) (get-output-string out)) equals "abc def"
case 576 PASS: (let ((out (open-output-string))) (write-string "abc def" out 4) (get-output-string out)) equals "def"
case 577 PASS: (let ((out (open-output-string))) (write-string "abc def" out 2 5) (get-output-string out)) equals "c d"
case 578 PASS: (let ((out (open-output-string))) (flush-output-port out) (get-output-string out)) equals ""
case 579 PASS: (eof-object? (read-u8 (open-input-bytevector #u8()))) equals #t
case 580 PASS: (read-u8 (open-input-bytevector #u8(1 2 3))) equals 1
case 581 PASS: (eof-object? (read-bytevector 3 (open-input-bytevector #u8()))) equals #t
case 582 PASS: (u8-ready? (open-input-bytevector #u8(1))) equals #t
case 583 PASS: (read-bytevector 3 (open-input-bytevector #u8(1))) equals #u8(1)
case 584 PASS: (read-bytevector 3 (open-input-bytevector #u8(1 2))) equals #u8(1 2)
case 585 PASS: (read-bytevector 3 (open-input-bytevector #u8(1 2 3))) equals #u8(1 2 3)
case 586 PASS: (read-bytevector 3 (open-input-bytevector #u8(1 2 3 4))) equals #u8(1 2 3)
case 587 PASS: (let ((bv (bytevector 1 2 3 4 5))) (eof-object? (read-bytevector! bv (open-input-bytevector #u8())))) equals #t
case 588 PASS: (let ((bv (bytevector 1 2 3 4 5))) (read-bytevector! bv (open-input-bytevector #u8(6 7 8 9 10)) 0 5) bv) equals #u8(6 7 8 9 10)
case 589 PASS: (let ((bv (bytevector 1 2 3 4 5))) (read-bytevector! bv (open-input-bytevector #u8(6 7 8 9 10)) 0 3) bv) equals #u8(6 7 8 4 5)
case 590 PASS: (let ((bv (bytevector 1 2 3 4 5))) (read-bytevector! bv (open-input-bytevector #u8(6 7 8 9 10)) 3 4) bv) equals #u8(1 2 3 6 5)
case 591 PASS: (let ((out (open-output-bytevector))) (write-u8 1 out) (write-u8 2 out) (write-u8 3 out) (get-output-bytevector out)) equals #u8(1 2 3)
case 592 PASS: (let ((out (open-output-bytevector))) (write-bytevector #u8(1 2 3 4 5) out) (get-output-bytevector out)) equals #u8(1 2 3 4 5)
case 593 PASS: (let ((out (open-output-bytevector))) (write-bytevector #u8(1 2 3 4 5) out 2) (get-output-bytevector out)) equals #u8(3 4 5)
case 594 PASS: (let ((out (open-output-bytevector))) (write-bytevector #u8(1 2 3 4 5) out 2 4) (get-output-bytevector out)) equals #u8(3 4)
case 595 PASS: (let ((out (open-output-bytevector))) (flush-output-port out) (get-output-bytevector out)) equals #u8()
case 596 PASS: (and (member (let ((out (open-output-string)) (x (list 1))) (set-cdr! x x) (write x out) (get-output-string out)) '("#0=(1 . #0#)" "#1=(1 . #1#)")) #t) equals #t
case 597 FAIL: (let ((out (open-output-string)) (x (list 1 2 3))) (write (list x x) out) (get-output-string out))
   expected "((1 2 3) (1 2 3))" but got "(#0=(1 2 3) #0#)"
case 598 PASS: (let ((out (open-output-string)) (x (list 1 2 3))) (write-simple (list x x) out) (get-output-string out)) equals "((1 2 3) (1 2 3))"
case 599 PASS: (and (member (let ((out (open-output-string)) (x (list 1 2 3))) (write-shared (list x x) out) (get-output-string out)) '("(#0=(1 2 3) #0#)" "(#1=(1 2 3) #1#)")) #t) equals #t
case 600 PASS: (list? (command-line)) equals #t
case 601 PASS: (real? (current-second)) equals #t
case 602 PASS: (inexact? (current-second)) equals #t
case 603 PASS: (exact? (current-jiffy)) equals #t
case 604 PASS: (exact? (jiffies-per-second)) equals #t
case 605 PASS: (list? (features)) equals #t
case 606 PASS: (and (memq 'r7rs (features)) #t) equals #t
case 607 PASS: (file-exists? ".") equals #t
case 608 PASS: (file-exists? " no such file ") equals #f