; File: "error.scm", Time-stamp: <2006-09-25 10:12:05 feeley>

; Copyright (C) 1998-2006 by Marc Feeley, All Rights Reserved.

; Test program for error processing.

; run like this:  gsi/gsi -f error.scm < error.scm

1 2 3

(define scheme-system
  (let ((str1 (symbol->string (car '(aB\c;
                                     ))))
        (str2 "\0411\x23"))
    (cond ((or (equal? str1 "aB\\c") (equal? str1 "aB"))
           'gambit) ; Gambit in case-sensitive mode
          ((equal? str1 "ab\\c")
           (let* ((c0 (string-ref str2 0)))
             (cond ((char=? c0 (integer->char 0))
                    'scm)
                   ((char=? c0 (integer->char 9))
                    'stk)
                   ((char=? c0 #\!)
                    (cond ((char=? (string-ref str2 2) #\#)
                           'gambit) ; Gambit in case-insensitive mode
                          (else
                           'mit)))
                   (else
                    'unknown))))
          ((equal? str1 "ABc")
           'scheme-to-c)
          ((equal? str1 "abc")
           'chez)
          ((equal? str1 "aBc")
           'elk)
          ((equal? str1 "AB\\C")
           'bigloo)
          (else
           'unknown))))

(define return #f)
(define call-args #f)
(define call-expr #f)

(define continuation->return-address #f)
(define catch-all #f)

(define chez-continuation->return-address
  (lambda (cont)
    #f))

(define chez-catch-all
  (lambda (catcher thunk)
    (parameterize ((error-handler
                    (lambda (fn-name err-format . err-args)
                      (catcher (string->symbol "##signal.runtime-error")
                               (list (apply format
                                            (cons err-format err-args))
                                     fn-name
                                     call-args)))))
      (thunk))))

(define mit-continuation->return-address
  (lambda (cont)
    #f))

(define mit-catch-all
  (lambda (catcher thunk)
    (call-with-current-continuation
     (lambda (return)
       (bind-condition-handler
        '()
        (lambda (condition)
          (catcher (string->symbol "##signal.runtime-error")
                   (list (condition/report-string condition)
                         (car call-expr)
                         call-args))
          (return #f))
        thunk)))))

(define scm-continuation->return-address
  (lambda (cont)
    #f))

(define scm-catch-all
  (lambda (catcher thunk)
    (call-with-current-continuation
     (lambda (return)
       (let ((error? #t))
         (dynamic-wind
          (lambda () #f)
          (lambda ()
            (let ((result (thunk)))
              (set! error? #f)
              result))
          (lambda ()
            (if error?
              (begin
                (catcher (string->symbol "##signal.runtime-error")
                         (list "ERROR"
                               (car call-expr)
                               call-args))
                (return #f))))))))))

(case scheme-system
  ((gambit)
   (set! continuation->return-address
     (eval `(lambda (cont)
              (,(string->symbol "##continuation-ret")
               (,(string->symbol "##procedure->continuation") cont)))))
   (set! catch-all
     (lambda (catcher thunk)
       (with-exception-handler
        (lambda (exc)

          (define (call oper args)
            (catcher
             (string->symbol "##signal.runtime-error")
             (list (with-input-from-string
                     (with-output-to-string
                       '()
                       (lambda ()
                         (if (os-exception? exc)
                             (write exc)
                             (##display-exception exc (current-output-port)))))
                     read-line)
                   (##procedure-name oper)
                   args)))

          (cond ((abandoned-mutex-exception? exc)
                 (call "???" '()))
                ((sfun-conversion-exception? exc)
                 (call
                  (sfun-conversion-exception-procedure exc)
                  (sfun-conversion-exception-arguments exc)))
                ((cfun-conversion-exception? exc)
                 (call
                  (cfun-conversion-exception-procedure exc)
                  (cfun-conversion-exception-arguments exc)))
                ((datum-parsing-exception? exc)
                 (call "???" '()))
                ((deadlock-exception? exc)
                 (call "???" '()))
                ((divide-by-zero-exception? exc)
                 (call
                  (divide-by-zero-exception-procedure exc)
                  (divide-by-zero-exception-arguments exc)))
                ((error-exception? exc)
                 (call "???" '()))
                ((expression-parsing-exception? exc)
                 (call "???" '()))
                ((heap-overflow-exception? exc)
                 (call "???" '()))
                ((improper-length-list-exception? exc)
                 (call
                  (improper-length-list-exception-procedure exc)
                  (improper-length-list-exception-arguments exc)))
                ((join-timeout-exception? exc)
                 (call
                  (join-timeout-exception-procedure exc)
                  (join-timeout-exception-arguments exc)))
                ((keyword-expected-exception? exc)
                 (call
                  (keyword-expected-exception-procedure exc)
                  (keyword-expected-exception-arguments exc)))
                ((multiple-c-return-exception? exc)
                 (call "???" '()))
                ((noncontinuable-exception? exc)
                 (call "???" '()))
                ((nonprocedure-operator-exception? exc)
                 (call
                  (quot (nonprocedure-operator-exception-operator exc))
                  (nonprocedure-operator-exception-arguments exc)))
                ((number-of-arguments-limit-exception? exc)
                 (call
                  (number-of-arguments-limit-exception-procedure exc)
                  (number-of-arguments-limit-exception-arguments exc)))
                ((os-exception? exc)
                 (call
                  (os-exception-procedure exc)
                  (os-exception-arguments exc)))
                ((range-exception? exc)
                 (call
                  (range-exception-procedure exc)
                  (range-exception-arguments exc)))
                ((scheduler-exception? exc)
                 (call "???" '()))
                ((stack-overflow-exception? exc)
                 (call "???" '()))
                ((started-thread-exception? exc)
                 (call
                  (started-thread-exception-procedure exc)
                  (started-thread-exception-arguments exc)))
                ((terminated-thread-exception? exc)
                 (call
                  (terminated-thread-exception-procedure exc)
                  (terminated-thread-exception-arguments exc)))
                ((type-exception? exc)
                 (call
                  (type-exception-procedure exc)
                  (type-exception-arguments exc)))
                ((unbound-os-environment-variable-exception? exc)
                 (call
                  (unbound-os-environment-variable-exception-procedure exc)
                  (unbound-os-environment-variable-exception-arguments exc)))
                ((unbound-global-exception? exc)
                 (call "???" '()))
                ((uncaught-exception? exc)
                 (call
                  (uncaught-exception-procedure exc)
                  (uncaught-exception-arguments exc)))
                ((unknown-keyword-argument-exception? exc)
                 (call
                  (unknown-keyword-argument-exception-procedure exc)
                  (unknown-keyword-argument-exception-arguments exc)))
                ((wrong-number-of-arguments-exception? exc)
                 (call
                  (wrong-number-of-arguments-exception-procedure exc)
                  (wrong-number-of-arguments-exception-arguments exc)))
                ((no-such-file-or-directory-exception? exc)
                 (call
                  (no-such-file-or-directory-exception-procedure exc)
                  (no-such-file-or-directory-exception-arguments exc)))
                (else
                 (call "???" '()))))
        thunk))))
  ((chez)
   (set! continuation->return-address chez-continuation->return-address)
   (set! catch-all chez-catch-all)
   (print-vector-length #f))
  ((mit)
   (set! continuation->return-address mit-continuation->return-address)
   (set! catch-all mit-catch-all))
  ((scm)
   (set! continuation->return-address scm-continuation->return-address)
   (set! catch-all scm-catch-all)))

(define copy-obj
  (lambda (obj)
    (cond ((string? obj) (string-copy obj))
          ((pair? obj)   (cons (copy-obj (car obj)) (copy-obj (cdr obj))))
          ((vector? obj) (list->vector (map copy-obj (vector->list obj))))
          (else          obj))))

(define apply-fn
  (lambda (fn args)
    (let ((result ; make sure continuation is unique (even in interpreter)
           (cond (fn => (lambda (f) (apply f args))))))
      result)))

(define return-address-of-apply-fn
  (apply-fn
   (lambda ()
     (call-with-current-continuation
      (lambda (cont)
        (continuation->return-address cont))))
   '()))

(define error-catcher
  (lambda (s args)
    (call-with-current-continuation
     (lambda (cont)
       (if (not (eq? s (string->symbol "##signal.runtime-error")))
         (begin
           (display ";;; SIGNAL ")
           (write s)
           (display " IS WRONG: ")
           (write call-expr)
           (newline))
         (let ((call-expr2
                (cons (cadr args)
                      (map quot (caddr args)))))
           (if (not (equal? call-expr call-expr2))
             (begin
               (display ";;; CALL EXPRESSION ")
               (write call-expr2)
               (display " IS WRONG: ")
               (write call-expr)
               (newline))
             (let ((retadr (continuation->return-address cont)))
               (if (not (eq? retadr return-address-of-apply-fn))
                 (begin
                   (display ";;; CONTINUATION ")
                   (display retadr)
                   (display " IS WRONG: ")
                   (write call-expr)
                   (newline))
                 (begin
                   (display ";;; ")
                   (display (car args))
                   (display ": ")
                   (write call-expr)
                   (newline)))))))
       (return #t)))))

(define quot
  (lambda (x)
    (if (or (number? x) (string? x) (char? x) (boolean? x))
      x
      (list 'quote x))))

(define generic-try
  (lambda (fn-name fn args proc)
    (set! call-args (map copy-obj args))
    (set! call-expr (cons fn-name (map quot call-args)))
    (call-with-current-continuation
     (lambda (cont)
       (set! return cont)
       (proc
        (catch-all
         error-catcher
         (lambda ()
           (apply-fn fn args))))))))

(define try
  (lambda (fn-name fn . args)
    (generic-try fn-name
                 fn
                 args
                 (lambda (result)
                   (write call-expr)
                   (display " => ")
                   (write (normalize-numbers result))
                   (newline)))))

(define try*
  (lambda (obj fn-name fn . args)
    (generic-try fn-name
                 fn
                 args
                 (lambda (result)
                   (write call-expr)
                   (display " => ")
                   (write (normalize-numbers obj))
                   (newline)))))

(define normalize-numbers
  (lambda (x)
    (if (and (number? x) (inexact? x))
      (if (real? x)
        (let ((y (/ (round (* (abs x) 1000000)) 1000000)))
          (if (< x 0) (- y) y)) ; get rid of -0.
        (make-rectangular (normalize-numbers (real-part x))
                          (normalize-numbers (imag-part x))))
      x)))

(define (sort-list lst <?)

  (define (mergesort lst)

    (define (merge lst1 lst2)
      (cond ((null? lst1) lst2)
            ((null? lst2) lst1)
            (else
             (let ((e1 (car lst1)) (e2 (car lst2)))
               (if (<? e1 e2)
                 (cons e1 (merge (cdr lst1) lst2))
                 (cons e2 (merge lst1 (cdr lst2))))))))

    (define (split lst)
      (if (or (null? lst) (null? (cdr lst)))
        lst
        (cons (car lst) (split (cddr lst)))))

    (if (or (null? lst) (null? (cdr lst)))
      lst
      (let* ((lst1 (mergesort (split lst)))
             (lst2 (mergesort (split (cdr lst)))))
        (merge lst1 lst2))))

  (mergesort lst))

;------------------------------------------------------------------------------

(define (test-not) ; no error possible
(try 'not not #f)
(try 'not not #t)
(try 'not not '())
(try 'not not "foo")
)
(test-not)

(define (test-boolean?) ; no error possible
(try 'boolean? boolean? #f)
(try 'boolean? boolean? #t)
(try 'boolean? boolean? '())
(try 'boolean? boolean? "foo")
)
(test-boolean?)

(define (test-eqv?) ; no error possible
(try 'eqv? eqv? #f "foo")
(try 'eqv? eqv? #f #f)
(try 'eqv? eqv? 'foo 'foo)
(try 'eqv? eqv? 12345678901234567890 12345678901234567890)
(try 'eqv? eqv? '(1 2) '(1 2))
)
(test-eqv?)

(define (test-eq?) ; no error possible
(try 'eq? eq? #f "foo")
(try 'eq? eq? #f #f)
(try 'eq? eq? 'foo 'foo)
(try 'eq? eq? 12345678901234567890 12345678901234567890)
(try 'eq? eq? '(1 2) '(1 2))
)
(test-eq?)

(define (test-equal?) ; no error possible
(try 'equal? equal? #f "foo")
(try 'equal? equal? #f #f)
(try 'equal? equal? 'foo 'foo)
(try 'equal? equal? 12345678901234567890 12345678901234567890)
(try 'equal? equal? '(1 2) '(1 2))
)
(test-equal?)

(define (test-pair?) ; no error possible
(try 'pair? pair? '(1 . 2))
(try 'pair? pair? '())
(try 'pair? pair? "foo")
(try 'pair? pair? #f)
)
(test-pair?)

(define (test-cons) ; no error possible
(try 'cons cons 1 "foo")
)
(test-cons)

(define (test-car)
(try 'car car '(a . b))
(try 'car car 'a)
(try 'car car "foo")
(try 'car car '#(a b))
)
(test-car)

(define (test-cdr)
(try 'cdr cdr '(a . b))
(try 'cdr cdr 'a)
(try 'cdr cdr "foo")
(try 'cdr cdr '#(a b))
)
(test-cdr)

(define (test-set-car!)
(let ((x (cons 'a 'b))) (try* x 'set-car! set-car! x 123))
(try 'set-car! set-car! 'a 123)
(try 'set-car! set-car! "foo" 123)
(try 'set-car! set-car! '#(a b) 123)
)
(test-set-car!)

(define (test-set-cdr!)
(let ((x (cons 'a 'b))) (try* x 'set-cdr! set-cdr! x 123))
(try 'set-cdr! set-cdr! 'a 123)
(try 'set-cdr! set-cdr! "foo" 123)
(try 'set-cdr! set-cdr! '#(a b) 123)
)
(test-set-cdr!)

(define (test-caar)
(try 'caar caar '((((a . b) c . d) (e . f) g . h) ((i . j) k . l) (m . n) o . p))
(try 'caar caar '(((a . b) c . d) (e . f) g . h))
(try 'caar caar '((a . b) c . d))
(try 'caar caar '(a . b))
(try 'caar caar 'a)
)
(test-caar)

(define (test-cadr)
(try 'cadr cadr '((((a . b) c . d) (e . f) g . h) ((i . j) k . l) (m . n) o . p))
(try 'cadr cadr '(((a . b) c . d) (e . f) g . h))
(try 'cadr cadr '((a . b) c . d))
(try 'cadr cadr '(a . b))
(try 'cadr cadr 'a)
)
(test-cadr)

(define (test-cdar)
(try 'cdar cdar '((((a . b) c . d) (e . f) g . h) ((i . j) k . l) (m . n) o . p))
(try 'cdar cdar '(((a . b) c . d) (e . f) g . h))
(try 'cdar cdar '((a . b) c . d))
(try 'cdar cdar '(a . b))
(try 'cdar cdar 'a)
)
(test-cdar)

(define (test-cddr)
(try 'cddr cddr '((((a . b) c . d) (e . f) g . h) ((i . j) k . l) (m . n) o . p))
(try 'cddr cddr '(((a . b) c . d) (e . f) g . h))
(try 'cddr cddr '((a . b) c . d))
(try 'cddr cddr '(a . b))
(try 'cddr cddr 'a)
)
(test-cddr)

(define (test-caaar)
(try 'caaar caaar '((((a . b) c . d) (e . f) g . h) ((i . j) k . l) (m . n) o . p))
(try 'caaar caaar '(((a . b) c . d) (e . f) g . h))
(try 'caaar caaar '((a . b) c . d))
(try 'caaar caaar '(a . b))
(try 'caaar caaar 'a)
)
(test-caaar)

(define (test-caadr)
(try 'caadr caadr '((((a . b) c . d) (e . f) g . h) ((i . j) k . l) (m . n) o . p))
(try 'caadr caadr '(((a . b) c . d) (e . f) g . h))
(try 'caadr caadr '((a . b) c . d))
(try 'caadr caadr '(a . b))
(try 'caadr caadr 'a)
)
(test-caadr)

(define (test-cddar)
(try 'cddar cddar '((((a . b) c . d) (e . f) g . h) ((i . j) k . l) (m . n) o . p))
(try 'cddar cddar '(((a . b) c . d) (e . f) g . h))
(try 'cddar cddar '((a . b) c . d))
(try 'cddar cddar '(a . b))
(try 'cddar cddar 'a)
)
(test-cddar)

(define (test-cdddr)
(try 'cdddr cdddr '((((a . b) c . d) (e . f) g . h) ((i . j) k . l) (m . n) o . p))
(try 'cdddr cdddr '(((a . b) c . d) (e . f) g . h))
(try 'cdddr cdddr '((a . b) c . d))
(try 'cdddr cdddr '(a . b))
(try 'cdddr cdddr 'a)
)
(test-cdddr)

(define (test-caaaar)
(try 'caaaar caaaar '((((a . b) c . d) (e . f) g . h) ((i . j) k . l) (m . n) o . p))
(try 'caaaar caaaar '(((a . b) c . d) (e . f) g . h))
(try 'caaaar caaaar '((a . b) c . d))
(try 'caaaar caaaar '(a . b))
(try 'caaaar caaaar 'a)
)
(test-caaaar)

(define (test-caaadr)
(try 'caaadr caaadr '((((a . b) c . d) (e . f) g . h) ((i . j) k . l) (m . n) o . p))
(try 'caaadr caaadr '(((a . b) c . d) (e . f) g . h))
(try 'caaadr caaadr '((a . b) c . d))
(try 'caaadr caaadr '(a . b))
(try 'caaadr caaadr 'a)
)
(test-caaadr)

(define (test-caddar)
(try 'caddar caddar '((((a . b) c . d) (e . f) g . h) ((i . j) k . l) (m . n) o . p))
(try 'caddar caddar '(((a . b) c . d) (e . f) g . h))
(try 'caddar caddar '((a . b) c . d))
(try 'caddar caddar '(a . b))
(try 'caddar caddar 'a)
)
(test-caddar)

(define (test-cadddr)
(try 'cadddr cadddr '((((a . b) c . d) (e . f) g . h) ((i . j) k . l) (m . n) o . p))
(try 'cadddr cadddr '(((a . b) c . d) (e . f) g . h))
(try 'cadddr cadddr '((a . b) c . d))
(try 'cadddr cadddr '(a . b))
(try 'cadddr cadddr 'a)
)
(test-cadddr)

(define (test-cdaaar)
(try 'cdaaar cdaaar '((((a . b) c . d) (e . f) g . h) ((i . j) k . l) (m . n) o . p))
(try 'cdaaar cdaaar '(((a . b) c . d) (e . f) g . h))
(try 'cdaaar cdaaar '((a . b) c . d))
(try 'cdaaar cdaaar '(a . b))
(try 'cdaaar cdaaar 'a)
)
(test-cdaaar)

(define (test-cdaadr)
(try 'cdaadr cdaadr '((((a . b) c . d) (e . f) g . h) ((i . j) k . l) (m . n) o . p))
(try 'cdaadr cdaadr '(((a . b) c . d) (e . f) g . h))
(try 'cdaadr cdaadr '((a . b) c . d))
(try 'cdaadr cdaadr '(a . b))
(try 'cdaadr cdaadr 'a)
)
(test-cdaadr)

(define (test-cdddar)
(try 'cdddar cdddar '((((a . b) c . d) (e . f) g . h) ((i . j) k . l) (m . n) o . p))
(try 'cdddar cdddar '(((a . b) c . d) (e . f) g . h))
(try 'cdddar cdddar '((a . b) c . d))
(try 'cdddar cdddar '(a . b))
(try 'cdddar cdddar 'a)
)
(test-cdddar)

(define (test-cddddr)
(try 'cddddr cddddr '((((a . b) c . d) (e . f) g . h) ((i . j) k . l) (m . n) o . p))
(try 'cddddr cddddr '(((a . b) c . d) (e . f) g . h))
(try 'cddddr cddddr '((a . b) c . d))
(try 'cddddr cddddr '(a . b))
(try 'cddddr cddddr 'a)
)
(test-cddddr)

(define (test-null?) ; no error possible
(try 'null? null? '())
(try 'null? null? '(1 . 2))
(try 'null? null? "foo")
(try 'null? null? #f)
)
(test-null?)

(define (test-list?) ; no error possible
(try 'list? list? '())
(try 'list? list? '(1 . 2))
(try 'list? list? '(1 2))
(try 'list? list? "foo")
(try 'list? list? #f)
)
(test-list?)

(define (test-list) ; no error possible
(try 'list list)
(try 'list list 1)
(try 'list list 1 2)
)
(test-list)

(define (test-length)
(try 'length length '())
(try 'length length '(1 2 3))
(try 'length length '(1 2 . 3))
(try 'length length "foo")
)
(test-length)

(define (test-append)
(try 'append append)
(try 'append append #f)
(try 'append append '() #f)
(try 'append append '(1 2) #f)
(try 'append append '(1 2 . "foo") #f)
(try 'append append '() '() #f)
(try 'append append '() '(1 2) #f)
(try 'append append '() '(1 2 . "foo") #f)
(try 'append append '(1 2) '() #f)
(try 'append append '(1 2 . "foo") '() #f)
(try 'append append '(1 2) '(3 4) #f)
(try 'append append '() '() '() #f)
(try 'append append '(1 2) '(3 4) '(5 6) #f)
)
(test-append)

(define (test-reverse)
(try 'reverse reverse '())
(try 'reverse reverse '(1 2 3))
(try 'reverse reverse '(1 2 . 3))
(try 'reverse reverse "foo")
)
(test-reverse)

(define (test-list-tail)
(try 'list-tail list-tail '() 0)
(try 'list-tail list-tail '(1 2 . 3) 1)
(try 'list-tail list-tail '(1 2) 3)
(try 'list-tail list-tail "foo" 1)
)
(test-list-tail)

(define (test-list-ref)
(try 'list-ref list-ref '() 0)
(try 'list-ref list-ref '(1 2 . 3) 1)
(try 'list-ref list-ref '(1 2) 3)
(try 'list-ref list-ref "foo" 1)
)
(test-list-ref)

(define (test-memq)
(try 'memq memq 123 '(a b c))
(try 'memq memq #f '(a #f b))
(try 'memq memq 'foo '(a foo b))
(try 'memq memq 12345678901234567890 '(a 12345678901234567890 b))
(try 'memq memq '(1 2) '(a (1 2) b))
(try 'memq memq 123 '())
(try 'memq memq 123 "foo")
(try 'memq memq 123 '(a b . "foo"))
)
(test-memq)

(define (test-memv)
(try 'memv memv 123 '(a b c))
(try 'memv memv #f '(a #f b))
(try 'memv memv 'foo '(a foo b))
(try 'memv memv 12345678901234567890 '(a 12345678901234567890 b))
(try 'memv memv '(1 2) '(a (1 2) b))
(try 'memv memv 123 '())
(try 'memv memv 123 "foo")
(try 'memv memv 123 '(a b . "foo"))
)
(test-memv)

(define (test-member)
(try 'member member 123 '(a b c))
(try 'member member #f '(a #f b))
(try 'member member 'foo '(a foo b))
(try 'member member 12345678901234567890 '(a 12345678901234567890 b))
(try 'member member '(1 2) '(a (1 2) b))
(try 'member member 123 '())
(try 'member member 123 "foo")
(try 'member member 123 '(a b . "foo"))
)
(test-member)

(define (test-assq)
(try 'assq assq 123 '((a . 1) (b . 2) (c . 3)))
(try 'assq assq #f '((a . 1) (#f . 2) (b . 3)))
(try 'assq assq 'foo '((a . 1) (foo . 2) (b . 3)))
(try 'assq assq 12345678901234567890 '((a . 1) (12345678901234567890 . 2) (b . 3)))
(try 'assq assq '(1 2) '((a . 1) ((1 2) . 2) (b . 3)))
(try 'assq assq 123 '())
(try 'assq assq 123 "foo")
(try 'assq assq 123 '((a . 1) (b . 2) . "foo"))
(try 'assq assq 123 '((a . 1) b (c . 3)))
)
(test-assq)

(define (test-assv)
(try 'assv assv 123 '((a . 1) (b . 2) (c . 3)))
(try 'assv assv #f '((a . 1) (#f . 2) (b . 3)))
(try 'assv assv 'foo '((a . 1) (foo . 2) (b . 3)))
(try 'assv assv 12345678901234567890 '((a . 1) (12345678901234567890 . 2) (b . 3)))
(try 'assv assv '(1 2) '((a . 1) ((1 2) . 2) (b . 3)))
(try 'assv assv 123 '())
(try 'assv assv 123 "foo")
(try 'assv assv 123 '((a . 1) (b . 2) . "foo"))
(try 'assv assv 123 '((a . 1) b (c . 3)))
)
(test-assv)

(define (test-assoc)
(try 'assoc assoc 123 '((a . 1) (b . 2) (c . 3)))
(try 'assoc assoc #f '((a . 1) (#f . 2) (b . 3)))
(try 'assoc assoc 'foo '((a . 1) (foo . 2) (b . 3)))
(try 'assoc assoc 12345678901234567890 '((a . 1) (12345678901234567890 . 2) (b . 3)))
(try 'assoc assoc '(1 2) '((a . 1) ((1 2) . 2) (b . 3)))
(try 'assoc assoc 123 '())
(try 'assoc assoc 123 "foo")
(try 'assoc assoc 123 '((a . 1) (b . 2) . "foo"))
(try 'assoc assoc 123 '((a . 1) b (c . 3)))
)
(test-assoc)

(define (test-symbol?) ; no error possible
(try 'symbol? symbol? 'foo)
(try 'symbol? symbol? #f)
(try 'symbol? symbol? '())
(try 'symbol? symbol? "foo")
)
(test-symbol?)

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

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

(define (test-number?) ; no error possible
(try 'number? number? 1)
(try 'number? number? 1/2)
(try 'number? number? 1.5)
(try 'number? number? +i)
(try 'number? number? #f)
)
(test-number?)

(define (test-complex?) ; no error possible
(try 'complex? complex? 1)
(try 'complex? complex? 1/2)
(try 'complex? complex? 1.5)
(try 'complex? complex? +i)
(try 'complex? complex? #f)
)
(test-complex?)

(define (test-real?) ; no error possible
(try 'real? real? 1)
(try 'real? real? 1/2)
(try 'real? real? 1.5)
(try 'real? real? +i)
(try 'real? real? #f)
)
(test-real?)

(define (test-rational?) ; no error possible
(try 'rational? rational? 1)
(try 'rational? rational? 1/2)
(try 'rational? rational? 1.5)
(try 'rational? rational? +i)
(try 'rational? rational? #f)
)
(test-rational?)

(define (test-integer?) ; no error possible
(try 'integer? integer? 1)
(try 'integer? integer? 1/2)
(try 'integer? integer? 1.5)
(try 'integer? integer? +i)
(try 'integer? integer? #f)
)
(test-integer?)

(define (test-exact?)
(try 'exact? exact? 1/2)
(try 'exact? exact? 1.5)
(try 'exact? exact? +i)
(try 'exact? exact? #f)
)
(test-exact?)

(define (test-inexact?)
(try 'inexact? inexact? 1/2)
(try 'inexact? inexact? 1.5)
(try 'inexact? inexact? +i)
(try 'inexact? inexact? #f)
)
(test-inexact?)

(define (test-=)
(try '= =)
(try '= = 1)
(try '= = 'a)
(try '= = 1 1)
(try '= = 1 2)
(try '= = 2 1)
(try '= = 1 +i)
(try '= = 'a 2)
(try '= = 1 'b)
(try '= = 1 2 3)
(try '= = 1 2 'c)
(try '= = 2 2 2 2)
(try '= = 1 2 3 4)
(try '= = 4 3 2 1)
(try '= = 1 2 4 4)
(try '= = 4 4 2 1)
)
(test-=)

(define (test-<)
(try '< <)
(try '< < 1)
(try '< < 'a)
(try '< < 1 1)
(try '< < 1 2)
(try '< < 2 1)
(try '< < 1 +i)
(try '< < 'a 2)
(try '< < 1 'b)
(try '< < 1 2 3)
(try '< < 1 2 'c)
(try '< < 2 2 2 2)
(try '< < 1 2 3 4)
(try '< < 4 3 2 1)
(try '< < 1 2 4 4)
(try '< < 4 4 2 1)
)
(test-<)

(define (test->)
(try '> >)
(try '> > 1)
(try '> > 'a)
(try '> > 1 1)
(try '> > 1 2)
(try '> > 2 1)
(try '> > 1 +i)
(try '> > 'a 2)
(try '> > 1 'b)
(try '> > 1 2 3)
(try '> > 1 2 'c)
(try '> > 2 2 2 2)
(try '> > 1 2 3 4)
(try '> > 4 3 2 1)
(try '> > 1 2 4 4)
(try '> > 4 4 2 1)
)
(test->)

(define (test-<=)
(try '<= <=)
(try '<= <= 1)
(try '<= <= 'a)
(try '<= <= 1 1)
(try '<= <= 1 2)
(try '<= <= 2 1)
(try '<= <= 1 +i)
(try '<= <= 'a 2)
(try '<= <= 1 'b)
(try '<= <= 1 2 3)
(try '<= <= 1 2 'c)
(try '<= <= 2 2 2 2)
(try '<= <= 1 2 3 4)
(try '<= <= 4 3 2 1)
(try '<= <= 1 2 4 4)
(try '<= <= 4 4 2 1)
)
(test-<=)

(define (test->=)
(try '>= >=)
(try '>= >= 1)
(try '>= >= 'a)
(try '>= >= 1 1)
(try '>= >= 1 2)
(try '>= >= 2 1)
(try '>= >= 1 +i)
(try '>= >= 'a 2)
(try '>= >= 1 'b)
(try '>= >= 1 2 3)
(try '>= >= 1 2 'c)
(try '>= >= 2 2 2 2)
(try '>= >= 1 2 3 4)
(try '>= >= 4 3 2 1)
(try '>= >= 1 2 4 4)
(try '>= >= 4 4 2 1)
)
(test->=)

(define (test-zero?)
(try 'zero? zero? 1)
(try 'zero? zero? 2.0)
(try 'zero? zero? 3.4)
(try 'zero? zero? +i)
(try 'zero? zero? 'foo)
)
(test-zero?)

(define (test-positive?)
(try 'positive? positive? 1)
(try 'positive? positive? 2.0)
(try 'positive? positive? 3.4)
(try 'positive? positive? +i)
(try 'positive? positive? 'foo)
)
(test-positive?)

(define (test-negative?)
(try 'negative? negative? 1)
(try 'negative? negative? 2.0)
(try 'negative? negative? 3.4)
(try 'negative? negative? +i)
(try 'negative? negative? 'foo)
)
(test-negative?)

(define (test-odd?)
(try 'odd? odd? 1)
(try 'odd? odd? 2.0)
(try 'odd? odd? 3.4)
(try 'odd? odd? +i)
(try 'odd? odd? 'foo)
)
(test-odd?)

(define (test-even?)
(try 'even? even? 1)
(try 'even? even? 2.0)
(try 'even? even? 3.4)
(try 'even? even? +i)
(try 'even? even? 'foo)
)
(test-even?)

(define (test-max)
(try 'max max 3)
(try 'max max 'a)
(try 'max max 3 4)
(try 'max max 3 4.0)
(try 'max max 'a 4.0)
(try 'max max 3 'b)
(try 'max max 1 2 3)
(try 'max max 1 2 'c)
(try 'max max 1+0.i 2+0.i)
)
(test-max)

(define (test-min)
(try 'min min 3)
(try 'min min 'a)
(try 'min min 3 4)
(try 'min min 3 4.0)
(try 'min min 'a 4.0)
(try 'min min 3 'b)
(try 'min min 1 2 3)
(try 'min min 1 2 'c)
(try 'min min 1+0.i 2+0.i)
)
(test-min)

(define (test-+)
(try '+ +)
(try '+ + 2)
(try '+ + 'a)
(try '+ + 2 3)
(try '+ + 2 +i)
(try '+ + 'a 2)
(try '+ + 1 'b)
(try '+ + 1 2 3)
(try '+ + 1 2 'c)
(try '+ + 2 2 2 2)
(try '+ + 1 2 3 4)
(try '+ + 4 3 2 1)
(try '+ + 1 2 4 4)
(try '+ + 4 4 2 1)
)
(test-+)

(define (test-*)
(try '* *)
(try '* * 2)
(try '* * 'a)
(try '* * 2 3)
(try '* * 2 +i)
(try '* * 'a 2)
(try '* * 1 'b)
(try '* * 1 2 3)
(try '* * 1 2 'c)
(try '* * 2 2 2 2)
(try '* * 1 2 3 4)
(try '* * 4 3 2 1)
(try '* * 1 2 4 4)
(try '* * 4 4 2 1)
)
(test-*)

(define (test--)
(try '- - 2)
(try '- - 'a)
(try '- - 2 3)
(try '- - 2 +i)
(try '- - 'a 2)
(try '- - 1 'b)
(try '- - 1 2 3)
(try '- - 1 2 'c)
(try '- - 2 2 2 2)
(try '- - 1 2 3 4)
(try '- - 4 3 2 1)
(try '- - 1 2 4 4)
(try '- - 4 4 2 1)
)
(test--)

(define (test-/)
(try '/ / 2)
(try '/ / 0)
(try '/ / 'a)
(try '/ / 2 3)
(try '/ / 2 +i)
(try '/ / 2 0)
(try '/ / 'a 2)
(try '/ / 1 'b)
(try '/ / 1 2 3)
(try '/ / 1 2 0)
(try '/ / 1 2 'c)
(try '/ / 2 2 2 2)
(try '/ / 1 2 3 4)
(try '/ / 4 3 2 1)
(try '/ / 1 2 4 4)
(try '/ / 4 4 2 1)
)
(test-/)

(define (test-abs)
(try 'abs abs -7)
(try 'abs abs +i)
(try 'abs abs 'a)
)
(test-abs)

(define (test-quotient)
(try 'quotient quotient 9 4)
(try 'quotient quotient 9. -4.)
(try 'quotient quotient 9. 3/2)
(try 'quotient quotient 9 0)
(try 'quotient quotient 'a 4)
(try 'quotient quotient 9 'b)
)
(test-quotient)

(define (test-remainder)
(try 'remainder remainder 9 4)
(try 'remainder remainder 9. -4.)
(try 'remainder remainder 9. 3/2)
(try 'remainder remainder 9 0)
(try 'remainder remainder 'a 4)
(try 'remainder remainder 9 'b)
)
(test-remainder)

(define (test-modulo)
(try 'modulo modulo 9 4)
(try 'modulo modulo 9. -4.)
(try 'modulo modulo 9. 3/2)
(try 'modulo modulo 9 0)
(try 'modulo modulo 'a 4)
(try 'modulo modulo 9 'b)
)
(test-modulo)

(define (test-gcd)
(try 'gcd gcd)
(try 'gcd gcd 10)
(try 'gcd gcd 3/2)
(try 'gcd gcd 'a)
(try 'gcd gcd 9 4)
(try 'gcd gcd 9. -4.)
(try 'gcd gcd 9. 3/2)
(try 'gcd gcd 'a 4)
(try 'gcd gcd 9 'b)
(try 'gcd gcd 12 8 10)
(try 'gcd gcd 12 8 'c)
)
(test-gcd)

(define (test-lcm)
(try 'lcm lcm)
(try 'lcm lcm 10)
(try 'lcm lcm 3/2)
(try 'lcm lcm 'a)
(try 'lcm lcm 9 4)
(try 'lcm lcm 9. -4.)
(try 'lcm lcm 9. 3/2)
(try 'lcm lcm 'a 4)
(try 'lcm lcm 9 'b)
(try 'lcm lcm 12 8 10)
(try 'lcm lcm 12 8 'c)
)
(test-lcm)

(define (test-numerator)
(try 'numerator numerator 3/2)
(try 'numerator numerator 1.5)
(try 'numerator numerator +i)
(try 'numerator numerator 'a)
)
(test-numerator)

(define (test-denominator)
(try 'denominator denominator 3/2)
(try 'denominator denominator 1.5)
(try 'denominator denominator +i)
(try 'denominator denominator 'a)
)
(test-denominator)

(define (test-floor)
(try 'floor floor 2/3)
(try 'floor floor 1.2)
(try 'floor floor +i)
(try 'floor floor 'a)
)
(test-floor)

(define (test-ceiling)
(try 'ceiling ceiling 2/3)
(try 'ceiling ceiling 1.2)
(try 'ceiling ceiling +i)
(try 'ceiling ceiling 'a)
)
(test-ceiling)

(define (test-truncate)
(try 'truncate truncate 2/3)
(try 'truncate truncate 1.2)
(try 'truncate truncate +i)
(try 'truncate truncate 'a)
)
(test-truncate)

(define (test-round)
(try 'round round 2/3)
(try 'round round 1.2)
(try 'round round +i)
(try 'round round 'a)
)
(test-round)

(define (test-rationalize)
(try 'rationalize rationalize -3/2 1/2)
(try 'rationalize rationalize -1.5 0.5)
(try 'rationalize rationalize -1.5 -0.5)
(try 'rationalize rationalize +i 2)
(try 'rationalize rationalize 1 +i)
(try 'rationalize rationalize 'a 2)
(try 'rationalize rationalize 1 'b)
)
(test-rationalize)

(define (test-exp)
(try 'exp exp 1/2)
(try 'exp exp -1.5)
(try 'exp exp +i)
(try 'exp exp 'a)
)
(test-exp)

(define (test-log)
(try 'log log 1/2)
(try 'log log -1.5)
(try 'log log +i)
(try 'log log 'a)
)
(test-log)

(define (test-sin)
(try 'sin sin 1/2)
(try 'sin sin -1.5)
(try 'sin sin +i)
(try 'sin sin 'a)
)
(test-sin)

(define (test-cos)
(try 'cos cos 1/2)
(try 'cos cos -1.5)
(try 'cos cos +i)
(try 'cos cos 'a)
)
(test-cos)

(define (test-tan)
(try 'tan tan 1/2)
(try 'tan tan -1.5)
(try 'tan tan +i)
(try 'tan tan 'a)
)
(test-tan)

(define (test-asin)
(try 'asin asin 1/2)
(try 'asin asin -1.5)
(try 'asin asin +i)
(try 'asin asin 'a)
)
(test-asin)

(define (test-acos)
(try 'acos acos 1/2)
(try 'acos acos -1.5)
(try 'acos acos +i)
(try 'acos acos 'a)
)
(test-acos)

(define (test-atan)
(try 'atan atan 1/2)
(try 'atan atan -1.5)
(try 'atan atan +i)
(try 'atan atan 'a)
(try 'atan atan -1.5 2.5)
(try 'atan atan 1 +i)
(try 'atan atan +i 2)
(try 'atan atan 1 'b)
(try 'atan atan 'a 2)
)
(test-atan)

(define (test-sqrt)
(try 'sqrt sqrt 1/4)
(try 'sqrt sqrt -1.5)
(try 'sqrt sqrt +i)
(try 'sqrt sqrt 'a)
)
(test-sqrt)

(define (test-expt)
(try 'expt expt 1/4 -1.5)
(try 'expt expt 2 +i)
(try 'expt expt +i 2)
(try 'expt expt 'a +i)
(try 'expt expt +i 'b)
)
(test-expt)

(define (test-make-rectangular)
(try 'make-rectangular make-rectangular 1/2 -1.5)
(try 'make-rectangular make-rectangular 1/2 +i)
(try 'make-rectangular make-rectangular +i -1.5)
(try 'make-rectangular make-rectangular 'a 2)
(try 'make-rectangular make-rectangular 1 'b)
)
(test-make-rectangular)

(define (test-make-polar)
(try 'make-polar make-polar 1/2 -1.5)
(try 'make-polar make-polar 1/2 +i)
(try 'make-polar make-polar +i -1.5)
(try 'make-polar make-polar 'a 2)
(try 'make-polar make-polar 1 'b)
)
(test-make-polar)

(define (test-real-part)
(try 'real-part real-part 1/2)
(try 'real-part real-part -1.5)
(try 'real-part real-part +i)
(try 'real-part real-part 'a)
)
(test-real-part)

(define (test-imag-part)
(try 'imag-part imag-part 1/2)
(try 'imag-part imag-part -1.5)
(try 'imag-part imag-part +i)
(try 'imag-part imag-part 'a)
)
(test-imag-part)

(define (test-magnitude)
(try 'magnitude magnitude 1/2)
(try 'magnitude magnitude -1.5)
(try 'magnitude magnitude +i)
(try 'magnitude magnitude 'a)
)
(test-magnitude)

(define (test-angle)
(try 'angle angle 1/2)
(try 'angle angle -1.5)
(try 'angle angle +i)
(try 'angle angle 'a)
)
(test-angle)

(define (test-exact->inexact)
(try 'exact->inexact exact->inexact 1/2)
(try 'exact->inexact exact->inexact -1.5)
(try 'exact->inexact exact->inexact +i)
(try 'exact->inexact exact->inexact 'a)
)
(test-exact->inexact)

(define (test-inexact->exact)
(try 'inexact->exact inexact->exact 1/2)
(try 'inexact->exact inexact->exact -1.5)
(try 'inexact->exact inexact->exact +i)
(try 'inexact->exact inexact->exact 'a)
)
(test-inexact->exact)

(define (test-number->string)
(try 'number->string number->string 1/2)
(try 'number->string number->string -1.5)
(try 'number->string number->string +i)
(try 'number->string number->string 'a)
(try 'number->string number->string 123 2)
(try 'number->string number->string 123 3)
(try 'number->string number->string 123 2.)
(try 'number->string number->string 123 +i)
(try 'number->string number->string 123 'a)
)
(test-number->string)

(define (test-string->number)
(try 'string->number string->number "1/2")
(try 'string->number string->number "-1.5")
(try 'string->number string->number "+i")
(try 'string->number string->number "foo")
(try 'string->number string->number 'a)
(try 'string->number string->number "123" 2)
(try 'string->number string->number "123" 3)
(try 'string->number string->number "123" 2.)
(try 'string->number string->number "123" +i)
(try 'string->number string->number "123" 'a)
)
(test-string->number)

(define (test-char?) ; no error possible
(try 'char? char? #\A)
(try 'char? char? #f)
(try 'char? char? '())
(try 'char? char? "foo")
)
(test-char?)

(define (test-char=?)
(try 'char=? char=?)
(try 'char=? char=? #\A)
(try 'char=? char=? 123)
(try 'char=? char=? #\A #\A)
(try 'char=? char=? #\A #\B)
(try 'char=? char=? #\B #\A)
(try 'char=? char=? #\A 123)
(try 'char=? char=? 123 #\A)
(try 'char=? char=? #\A #\B #\C)
(try 'char=? char=? #\A #\B #\B)
(try 'char=? char=? #\B #\B #\B)
(try 'char=? char=? #\B #\B #\A)
(try 'char=? char=? #\C #\B #\A)
(try 'char=? char=? #\A #\B 123)
)
(test-char=?)

(define (test-char<?)
(try 'char<? char<?)
(try 'char<? char<? #\A)
(try 'char<? char<? 123)
(try 'char<? char<? #\A #\A)
(try 'char<? char<? #\A #\B)
(try 'char<? char<? #\B #\A)
(try 'char<? char<? #\A 123)
(try 'char<? char<? 123 #\A)
(try 'char<? char<? #\A #\B #\C)
(try 'char<? char<? #\A #\B #\B)
(try 'char<? char<? #\B #\B #\B)
(try 'char<? char<? #\B #\B #\A)
(try 'char<? char<? #\C #\B #\A)
(try 'char<? char<? #\A #\B 123)
)
(test-char<?)

(define (test-char>?)
(try 'char>? char>?)
(try 'char>? char>? #\A)
(try 'char>? char>? 123)
(try 'char>? char>? #\A #\A)
(try 'char>? char>? #\A #\B)
(try 'char>? char>? #\B #\A)
(try 'char>? char>? #\A 123)
(try 'char>? char>? 123 #\A)
(try 'char>? char>? #\A #\B #\C)
(try 'char>? char>? #\A #\B #\B)
(try 'char>? char>? #\B #\B #\B)
(try 'char>? char>? #\B #\B #\A)
(try 'char>? char>? #\C #\B #\A)
(try 'char>? char>? #\A #\B 123)
)
(test-char>?)

(define (test-char<=?)
(try 'char<=? char<=?)
(try 'char<=? char<=? #\A)
(try 'char<=? char<=? 123)
(try 'char<=? char<=? #\A #\A)
(try 'char<=? char<=? #\A #\B)
(try 'char<=? char<=? #\B #\A)
(try 'char<=? char<=? #\A 123)
(try 'char<=? char<=? 123 #\A)
(try 'char<=? char<=? #\A #\B #\C)
(try 'char<=? char<=? #\A #\B #\B)
(try 'char<=? char<=? #\B #\B #\B)
(try 'char<=? char<=? #\B #\B #\A)
(try 'char<=? char<=? #\C #\B #\A)
(try 'char<=? char<=? #\A #\B 123)
)
(test-char<=?)

(define (test-char>=?)
(try 'char>=? char>=?)
(try 'char>=? char>=? #\A)
(try 'char>=? char>=? 123)
(try 'char>=? char>=? #\A #\A)
(try 'char>=? char>=? #\A #\B)
(try 'char>=? char>=? #\B #\A)
(try 'char>=? char>=? #\A 123)
(try 'char>=? char>=? 123 #\A)
(try 'char>=? char>=? #\A #\B #\C)
(try 'char>=? char>=? #\A #\B #\B)
(try 'char>=? char>=? #\B #\B #\B)
(try 'char>=? char>=? #\B #\B #\A)
(try 'char>=? char>=? #\C #\B #\A)
(try 'char>=? char>=? #\A #\B 123)
)
(test-char>=?)

(define (test-char-ci=?)
(try 'char-ci=? char-ci=?)
(try 'char-ci=? char-ci=? #\A)
(try 'char-ci=? char-ci=? 123)
(try 'char-ci=? char-ci=? #\A #\a)
(try 'char-ci=? char-ci=? #\A #\b)
(try 'char-ci=? char-ci=? #\B #\a)
(try 'char-ci=? char-ci=? #\A 123)
(try 'char-ci=? char-ci=? 123 #\A)
(try 'char-ci=? char-ci=? #\A #\b #\C)
(try 'char-ci=? char-ci=? #\A #\b #\B)
(try 'char-ci=? char-ci=? #\B #\b #\B)
(try 'char-ci=? char-ci=? #\B #\b #\A)
(try 'char-ci=? char-ci=? #\C #\b #\A)
(try 'char-ci=? char-ci=? #\A #\b 123)
)
(test-char-ci=?)

(define (test-char-ci<?)
(try 'char-ci<? char-ci<?)
(try 'char-ci<? char-ci<? #\A)
(try 'char-ci<? char-ci<? 123)
(try 'char-ci<? char-ci<? #\A #\a)
(try 'char-ci<? char-ci<? #\A #\b)
(try 'char-ci<? char-ci<? #\B #\a)
(try 'char-ci<? char-ci<? #\A 123)
(try 'char-ci<? char-ci<? 123 #\A)
(try 'char-ci<? char-ci<? #\A #\b #\C)
(try 'char-ci<? char-ci<? #\A #\b #\B)
(try 'char-ci<? char-ci<? #\B #\b #\B)
(try 'char-ci<? char-ci<? #\B #\b #\A)
(try 'char-ci<? char-ci<? #\C #\b #\A)
(try 'char-ci<? char-ci<? #\A #\b 123)
)
(test-char-ci<?)

(define (test-char-ci>?)
(try 'char-ci>? char-ci>?)
(try 'char-ci>? char-ci>? #\A)
(try 'char-ci>? char-ci>? 123)
(try 'char-ci>? char-ci>? #\A #\a)
(try 'char-ci>? char-ci>? #\A #\b)
(try 'char-ci>? char-ci>? #\B #\a)
(try 'char-ci>? char-ci>? #\A 123)
(try 'char-ci>? char-ci>? 123 #\A)
(try 'char-ci>? char-ci>? #\A #\b #\C)
(try 'char-ci>? char-ci>? #\A #\b #\B)
(try 'char-ci>? char-ci>? #\B #\b #\B)
(try 'char-ci>? char-ci>? #\B #\b #\A)
(try 'char-ci>? char-ci>? #\C #\b #\A)
(try 'char-ci>? char-ci>? #\A #\b 123)
)
(test-char-ci>?)

(define (test-char-ci<=?)
(try 'char-ci<=? char-ci<=?)
(try 'char-ci<=? char-ci<=? #\A)
(try 'char-ci<=? char-ci<=? 123)
(try 'char-ci<=? char-ci<=? #\A #\a)
(try 'char-ci<=? char-ci<=? #\A #\b)
(try 'char-ci<=? char-ci<=? #\B #\a)
(try 'char-ci<=? char-ci<=? #\A 123)
(try 'char-ci<=? char-ci<=? 123 #\A)
(try 'char-ci<=? char-ci<=? #\A #\b #\C)
(try 'char-ci<=? char-ci<=? #\A #\b #\B)
(try 'char-ci<=? char-ci<=? #\B #\b #\B)
(try 'char-ci<=? char-ci<=? #\B #\b #\A)
(try 'char-ci<=? char-ci<=? #\C #\b #\A)
(try 'char-ci<=? char-ci<=? #\A #\b 123)
)
(test-char-ci<=?)

(define (test-char-ci>=?)
(try 'char-ci>=? char-ci>=?)
(try 'char-ci>=? char-ci>=? #\A)
(try 'char-ci>=? char-ci>=? 123)
(try 'char-ci>=? char-ci>=? #\A #\a)
(try 'char-ci>=? char-ci>=? #\A #\b)
(try 'char-ci>=? char-ci>=? #\B #\a)
(try 'char-ci>=? char-ci>=? #\A 123)
(try 'char-ci>=? char-ci>=? 123 #\A)
(try 'char-ci>=? char-ci>=? #\A #\b #\C)
(try 'char-ci>=? char-ci>=? #\A #\b #\B)
(try 'char-ci>=? char-ci>=? #\B #\b #\B)
(try 'char-ci>=? char-ci>=? #\B #\b #\A)
(try 'char-ci>=? char-ci>=? #\C #\b #\A)
(try 'char-ci>=? char-ci>=? #\A #\b 123)
)
(test-char-ci>=?)

(define (test-char-alphabetic?)
(try 'char-alphabetic? char-alphabetic? #\a)
(try 'char-alphabetic? char-alphabetic? #\A)
(try 'char-alphabetic? char-alphabetic? #\0)
(try 'char-alphabetic? char-alphabetic? #\newline)
(try 'char-alphabetic? char-alphabetic? 123)
)
(test-char-alphabetic?)

(define (test-char-numeric?)
(try 'char-numeric? char-numeric? #\a)
(try 'char-numeric? char-numeric? #\A)
(try 'char-numeric? char-numeric? #\0)
(try 'char-numeric? char-numeric? #\newline)
(try 'char-numeric? char-numeric? 123)
)
(test-char-numeric?)

(define (test-char-whitespace?)
(try 'char-whitespace? char-whitespace? #\a)
(try 'char-whitespace? char-whitespace? #\A)
(try 'char-whitespace? char-whitespace? #\0)
(try 'char-whitespace? char-whitespace? #\newline)
(try 'char-whitespace? char-whitespace? 123)
)
(test-char-whitespace?)

(define (test-char-upper-case?)
(try 'char-upper-case? char-upper-case? #\a)
(try 'char-upper-case? char-upper-case? #\A)
(try 'char-upper-case? char-upper-case? #\0)
(try 'char-upper-case? char-upper-case? #\newline)
(try 'char-upper-case? char-upper-case? 123)
)
(test-char-upper-case?)

(define (test-char-lower-case?)
(try 'char-lower-case? char-lower-case? #\a)
(try 'char-lower-case? char-lower-case? #\A)
(try 'char-lower-case? char-lower-case? #\0)
(try 'char-lower-case? char-lower-case? #\newline)
(try 'char-lower-case? char-lower-case? 123)
)
(test-char-lower-case?)

(define (test-char->integer)
(try 'char->integer char->integer #\A)
(try 'char->integer char->integer 123)
)
(test-char->integer)

(define (test-integer->char)
(try 'integer->char integer->char 123)
(try 'integer->char integer->char -1)
(try 'integer->char integer->char #x110000)
(try 'integer->char integer->char #xd800)
(try 'integer->char integer->char 123.0)
(try 'integer->char integer->char #\A)
)
(test-integer->char)

(define (test-char-upcase)
(try 'char-upcase char-upcase #\a)
(try 'char-upcase char-upcase #\A)
(try 'char-upcase char-upcase #\@)
(try 'char-upcase char-upcase 123)
(try 'char-upcase char-upcase 'a)
(try 'char-upcase char-upcase "a")
)
(test-char-upcase)

(define (test-char-downcase)
(try 'char-downcase char-downcase #\a)
(try 'char-downcase char-downcase #\A)
(try 'char-downcase char-downcase #\@)
(try 'char-downcase char-downcase 123)
(try 'char-downcase char-downcase 'a)
(try 'char-downcase char-downcase "a")
)
(test-char-downcase)

(define (test-string?) ; no error possible
(string? "5678")
(string? 12345678901234567890)
)
(test-string?)

(define (test-make-string)
(try 'make-string make-string 0)
(try 'make-string make-string 3)
(try 'make-string make-string 536870911)
(try 'make-string make-string 12345678901234567890)
(try 'make-string make-string -1)
(try 'make-string make-string 1.5)
(try 'make-string make-string 5 #\6)
(try 'make-string make-string 1 'a)
)
(test-make-string)

(define (test-string)
(try 'string string)
(try 'string string #\5)
(try 'string string #\5 #\6)
(try 'string string #\5 'b #\7)
)
(test-string)

(define (test-string-length)
(try 'string-length string-length "5678")
(try 'string-length string-length 12345678901234567890)
)
(test-string-length)

(define (test-string-ref)
(try 'string-ref string-ref "5678" 3)
(try 'string-ref string-ref "56" -1)
(try 'string-ref string-ref "56" 2)
(try 'string-ref string-ref "56" 12345678901234567890)
(try 'string-ref string-ref 12345678901234567890 0)
)
(test-string-ref)

(define (test-string-set!)
(let ((x (string #\5 #\6))) (try* x 'string-set! string-set! x 1 #\3))
(let ((x (string #\5 #\6))) (try* x 'string-set! string-set! x -1 #\3))
(let ((x (string #\5 #\6))) (try* x 'string-set! string-set! x 2 #\3))
(let ((x (string #\5 #\6))) (try* x 'string-set! string-set! x 12345678901234567890 #\3))
(let ((x (string #\5 #\6))) (try* x 'string-set! string-set! x 1 'a))
(try 'string-set! string-set! 12345678901234567890 0 #\3)
)
(test-string-set!)

(define (test-string=?)
(try 'string=? string=?)
(try 'string=? string=? "A")
(try 'string=? string=? 123)
(try 'string=? string=? "A" "A")
(try 'string=? string=? "A" "B")
(try 'string=? string=? "A" "A ")
(try 'string=? string=? "B" "A")
(try 'string=? string=? "A " "A")
(try 'string=? string=? "A" 123)
(try 'string=? string=? 123 "A")
(try 'string=? string=? "A" 123)
(try 'string=? string=? "A" "B" "C")
(try 'string=? string=? "A" "B" "B")
(try 'string=? string=? "B" "B" "B")
(try 'string=? string=? "B" "B" "A")
(try 'string=? string=? "C" "B" "A")
(try 'string=? string=? "A" "B" 123)
)
(test-string=?)

(define (test-string<?)
(try 'string<? string<?)
(try 'string<? string<? "A")
(try 'string<? string<? 123)
(try 'string<? string<? "A" "A")
(try 'string<? string<? "A" "B")
(try 'string<? string<? "A" "A ")
(try 'string<? string<? "B" "A")
(try 'string<? string<? "A " "A")
(try 'string<? string<? "A" 123)
(try 'string<? string<? 123 "A")
(try 'string<? string<? "A" 123)
(try 'string<? string<? "A" "B" "C")
(try 'string<? string<? "A" "B" "B")
(try 'string<? string<? "B" "B" "B")
(try 'string<? string<? "B" "B" "A")
(try 'string<? string<? "C" "B" "A")
(try 'string<? string<? "A" "B" 123)
)
(test-string<?)

(define (test-string>?)
(try 'string>? string>?)
(try 'string>? string>? "A")
(try 'string>? string>? 123)
(try 'string>? string>? "A" "A")
(try 'string>? string>? "A" "B")
(try 'string>? string>? "A" "A ")
(try 'string>? string>? "B" "A")
(try 'string>? string>? "A " "A")
(try 'string>? string>? "A" 123)
(try 'string>? string>? 123 "A")
(try 'string>? string>? "A" 123)
(try 'string>? string>? "A" "B" "C")
(try 'string>? string>? "A" "B" "B")
(try 'string>? string>? "B" "B" "B")
(try 'string>? string>? "B" "B" "A")
(try 'string>? string>? "C" "B" "A")
(try 'string>? string>? "A" "B" 123)
)
(test-string>?)

(define (test-string<=?)
(try 'string<=? string<=?)
(try 'string<=? string<=? "A")
(try 'string<=? string<=? 123)
(try 'string<=? string<=? "A" "A")
(try 'string<=? string<=? "A" "B")
(try 'string<=? string<=? "A" "A ")
(try 'string<=? string<=? "B" "A")
(try 'string<=? string<=? "A " "A")
(try 'string<=? string<=? "A" 123)
(try 'string<=? string<=? 123 "A")
(try 'string<=? string<=? "A" 123)
(try 'string<=? string<=? "A" "B" "C")
(try 'string<=? string<=? "A" "B" "B")
(try 'string<=? string<=? "B" "B" "B")
(try 'string<=? string<=? "B" "B" "A")
(try 'string<=? string<=? "C" "B" "A")
(try 'string<=? string<=? "A" "B" 123)
)
(test-string<=?)

(define (test-string>=?)
(try 'string>=? string>=?)
(try 'string>=? string>=? "A")
(try 'string>=? string>=? 123)
(try 'string>=? string>=? "A" "A")
(try 'string>=? string>=? "A" "B")
(try 'string>=? string>=? "A" "A ")
(try 'string>=? string>=? "B" "A")
(try 'string>=? string>=? "A " "A")
(try 'string>=? string>=? "A" 123)
(try 'string>=? string>=? 123 "A")
(try 'string>=? string>=? "A" 123)
(try 'string>=? string>=? "A" "B" "C")
(try 'string>=? string>=? "A" "B" "B")
(try 'string>=? string>=? "B" "B" "B")
(try 'string>=? string>=? "B" "B" "A")
(try 'string>=? string>=? "C" "B" "A")
(try 'string>=? string>=? "A" "B" 123)
)
(test-string>=?)

(define (test-string-ci=?)
(try 'string-ci=? string-ci=?)
(try 'string-ci=? string-ci=? "A")
(try 'string-ci=? string-ci=? 123)
(try 'string-ci=? string-ci=? "A" "a")
(try 'string-ci=? string-ci=? "A" "b")
(try 'string-ci=? string-ci=? "A" "a ")
(try 'string-ci=? string-ci=? "B" "a")
(try 'string-ci=? string-ci=? "A " "a")
(try 'string-ci=? string-ci=? "A" 123)
(try 'string-ci=? string-ci=? 123 "A")
(try 'string-ci=? string-ci=? "A" 123)
(try 'string-ci=? string-ci=? "A" "b" "C")
(try 'string-ci=? string-ci=? "A" "b" "B")
(try 'string-ci=? string-ci=? "B" "b" "B")
(try 'string-ci=? string-ci=? "B" "b" "A")
(try 'string-ci=? string-ci=? "C" "b" "A")
(try 'string-ci=? string-ci=? "A" "b" 123)
)
(test-string-ci=?)

(define (test-string-ci<?)
(try 'string-ci<? string-ci<?)
(try 'string-ci<? string-ci<? "A")
(try 'string-ci<? string-ci<? 123)
(try 'string-ci<? string-ci<? "A" "a")
(try 'string-ci<? string-ci<? "A" "b")
(try 'string-ci<? string-ci<? "A" "a ")
(try 'string-ci<? string-ci<? "B" "a")
(try 'string-ci<? string-ci<? "A " "a")
(try 'string-ci<? string-ci<? "A" 123)
(try 'string-ci<? string-ci<? 123 "A")
(try 'string-ci<? string-ci<? "A" 123)
(try 'string-ci<? string-ci<? "A" "b" "C")
(try 'string-ci<? string-ci<? "A" "b" "B")
(try 'string-ci<? string-ci<? "B" "b" "B")
(try 'string-ci<? string-ci<? "B" "b" "A")
(try 'string-ci<? string-ci<? "C" "b" "A")
(try 'string-ci<? string-ci<? "A" "b" 123)
)
(test-string-ci<?)

(define (test-string-ci>?)
(try 'string-ci>? string-ci>?)
(try 'string-ci>? string-ci>? "A")
(try 'string-ci>? string-ci>? 123)
(try 'string-ci>? string-ci>? "A" "a")
(try 'string-ci>? string-ci>? "A" "b")
(try 'string-ci>? string-ci>? "A" "a ")
(try 'string-ci>? string-ci>? "B" "a")
(try 'string-ci>? string-ci>? "A " "a")
(try 'string-ci>? string-ci>? "A" 123)
(try 'string-ci>? string-ci>? 123 "A")
(try 'string-ci>? string-ci>? "A" 123)
(try 'string-ci>? string-ci>? "A" "b" "C")
(try 'string-ci>? string-ci>? "A" "b" "B")
(try 'string-ci>? string-ci>? "B" "b" "B")
(try 'string-ci>? string-ci>? "B" "b" "A")
(try 'string-ci>? string-ci>? "C" "b" "A")
(try 'string-ci>? string-ci>? "A" "b" 123)
)
(test-string-ci>?)

(define (test-string-ci<=?)
(try 'string-ci<=? string-ci<=?)
(try 'string-ci<=? string-ci<=? "A")
(try 'string-ci<=? string-ci<=? 123)
(try 'string-ci<=? string-ci<=? "A" "a")
(try 'string-ci<=? string-ci<=? "A" "b")
(try 'string-ci<=? string-ci<=? "A" "a ")
(try 'string-ci<=? string-ci<=? "B" "a")
(try 'string-ci<=? string-ci<=? "A " "a")
(try 'string-ci<=? string-ci<=? "A" 123)
(try 'string-ci<=? string-ci<=? 123 "A")
(try 'string-ci<=? string-ci<=? "A" 123)
(try 'string-ci<=? string-ci<=? "A" "b" "C")
(try 'string-ci<=? string-ci<=? "A" "b" "B")
(try 'string-ci<=? string-ci<=? "B" "b" "B")
(try 'string-ci<=? string-ci<=? "B" "b" "A")
(try 'string-ci<=? string-ci<=? "C" "b" "A")
(try 'string-ci<=? string-ci<=? "A" "b" 123)
)
(test-string-ci<=?)

(define (test-string-ci>=?)
(try 'string-ci>=? string-ci>=?)
(try 'string-ci>=? string-ci>=? "A")
(try 'string-ci>=? string-ci>=? 123)
(try 'string-ci>=? string-ci>=? "A" "a")
(try 'string-ci>=? string-ci>=? "A" "b")
(try 'string-ci>=? string-ci>=? "A" "a ")
(try 'string-ci>=? string-ci>=? "B" "a")
(try 'string-ci>=? string-ci>=? "A " "a")
(try 'string-ci>=? string-ci>=? "A" 123)
(try 'string-ci>=? string-ci>=? 123 "A")
(try 'string-ci>=? string-ci>=? "A" 123)
(try 'string-ci>=? string-ci>=? "A" "b" "C")
(try 'string-ci>=? string-ci>=? "A" "b" "B")
(try 'string-ci>=? string-ci>=? "B" "b" "B")
(try 'string-ci>=? string-ci>=? "B" "b" "A")
(try 'string-ci>=? string-ci>=? "C" "b" "A")
(try 'string-ci>=? string-ci>=? "A" "b" 123)
)
(test-string-ci>=?)

(define (test-substring)
(try 'substring substring "abcdef" 0 2)
(try 'substring substring "abcdef" 2 2)
(try 'substring substring "abcdef" 2 5)
(try 'substring substring "abcdef" 2 6)
(try 'substring substring "abcdef" 2 7)
(try 'substring substring "abcdef" -1 5)
(try 'substring substring "abcdef" 2 1)
(try 'substring substring "abcdef" 2 12345678901234567890)
(try 'substring substring "abcdef" 12345678901234567890 2)
(try 'substring substring "abcdef" #\a 5)
(try 'substring substring "abcdef" 2 #\a)
(try 'substring substring 12345678901234567890 0 2)
)
(test-substring)

(define (test-string-append)
(try 'string-append string-append)
(try 'string-append string-append "ab")
(try 'string-append string-append 12345678901234567890)
(try 'string-append string-append "ab" "cd")
(try 'string-append string-append "ab" 12345678901234567890)
(try 'string-append string-append 12345678901234567890 "cd")
(try 'string-append string-append "ab" "cd" "ef")
(try 'string-append string-append "ab" "cd" 12345678901234567890)
)
(test-string-append)

(define (test-string->list)
(try 'string->list string->list "56")
(try 'string->list string->list 12345678901234567890)
)
(test-string->list)

(define (test-list->string)
(try 'list->string list->string '(#\5 #\6))
(try 'list->string list->string '(#\5 b))
(try 'list->string list->string 12345678901234567890)
)
(test-list->string)

(define (test-string-copy)
(try 'string-copy string-copy "ab")
(try 'string-copy string-copy 12345678901234567890)
)
(test-string-copy)

(define (test-string-fill!)
(let ((x (string #\5 #\6))) (try* x 'string-fill! string-fill! x #\a))
(let ((x (string #\5 #\6))) (try* x 'string-fill! string-fill! x 'a))
(try 'string-fill! string-fill! 12345678901234567890 #\a)
)
(test-string-fill!)

(define (test-vector?) ; no error possible
(vector? '#(5 6 7 8))
(vector? 12345678901234567890)
)
(test-vector?)

(define (test-make-vector)
(try 'make-vector make-vector 0)
(try 'make-vector make-vector 3)
(try 'make-vector make-vector 536870911)
(try 'make-vector make-vector 12345678901234567890)
(try 'make-vector make-vector -1)
(try 'make-vector make-vector 1.5)
(try 'make-vector make-vector 5 'a)
)
(test-make-vector)

(define (test-vector)
(try 'vector vector)
(try 'vector vector 5)
(try 'vector vector 5 'b)
(try 'vector vector 5 'b 7)
)
(test-vector)

(define (test-vector-length)
(try 'vector-length vector-length '#(5 6 7 8))
(try 'vector-length vector-length 12345678901234567890)
)
(test-vector-length)

(define (test-vector-ref)
(try 'vector-ref vector-ref '#(5 6 7 8) 3)
(try 'vector-ref vector-ref '#(5 6) -1)
(try 'vector-ref vector-ref '#(5 6) 2)
(try 'vector-ref vector-ref '#(5 6) 12345678901234567890)
(try 'vector-ref vector-ref 12345678901234567890 0)
)
(test-vector-ref)

(define (test-vector-set!)
(let ((x (vector 5 6))) (try* x 'vector-set! vector-set! x 1 3))
(let ((x (vector 5 6))) (try* x 'vector-set! vector-set! x -1 3))
(let ((x (vector 5 6))) (try* x 'vector-set! vector-set! x 2 3))
(let ((x (vector 5 6))) (try* x 'vector-set! vector-set! x 12345678901234567890 3))
(let ((x (vector 5 6))) (try* x 'vector-set! vector-set! x 1 'a))
(try 'vector-set! vector-set! 12345678901234567890 0 3)
)
(test-vector-set!)

(define (test-vector->list)
(try 'vector->list vector->list '#(5 6))
(try 'vector->list vector->list 12345678901234567890)
)
(test-vector->list)

(define (test-list->vector)
(try 'list->vector list->vector '(5 b))
(try 'list->vector list->vector 12345678901234567890)
)
(test-list->vector)

(define (test-vector-fill!)
(let ((x (vector 5 6))) (try* x 'vector-fill! vector-fill! x 'a))
(try 'vector-fill! vector-fill! 12345678901234567890 'a)
)
(test-vector-fill!)

(define (test-procedure?) ; no error possible
(try 'procedure? procedure? append)
(try 'procedure? procedure? '())
(try 'procedure? procedure? "foo")
(try 'procedure? procedure? #f)
)
(test-procedure?)

(define (test-apply)
(try 'apply apply + '())
(try 'apply apply + '(2 3))
(try 'apply apply + 2 '(3))
(try 'apply apply + 2 3 '())
(try 'apply apply + '(2 . #f))
(try 'apply apply + #f)
(try 'apply apply #f '(2 3))
)
(test-apply)

(define (test-map)
(try 'map map sqrt '())
(try 'map map sqrt '(1 4 9))
(try 'map map sqrt #f)
(try 'map map sqrt '(1 . #f))
(try 'map map #f '(1 4 9))
(try 'map map + '() '())
(try 'map map + '(1 2 3) '(0 2 6))
(try 'map map + '(1 2 3) '(0 2))
(try 'map map + '(1 2) '(0 2 6))
(try 'map map + #f '())
(try 'map map + '() #f)
(try 'map map + '(1 . #f) '(0 . #f))
(try 'map map #f '(1 2 3) '(0 2 6))
(try 'map map + '() '() '())
(try 'map map + '(1 2 3) '(0 2 6) '(10 100 1000))
(try 'map map + '(1 2 3) '(0 2) '(10 100 1000))
(try 'map map + '(1 2) '(0 2 6) '(10 100 1000))
(try 'map map + #f '() '())
(try 'map map + '() #f '())
(try 'map map + '() '() #f)
(try 'map map + '(1 . #f) '(0 . #f) '(10 . #f))
(try 'map map #f '(1 2 3) '(0 2 6) '(10 100 1000))
)
(test-map)

(define (test-for-each)
(try 'for-each for-each sqrt '())
(try 'for-each for-each sqrt '(1 4 9))
(try 'for-each for-each sqrt #f)
(try 'for-each for-each sqrt '(1 . #f))
(try 'for-each for-each #f '(1 4 9))
(try 'for-each for-each + '() '())
(try 'for-each for-each + '(1 2 3) '(0 2 6))
(try 'for-each for-each + '(1 2 3) '(0 2))
(try 'for-each for-each + '(1 2) '(0 2 6))
(try 'for-each for-each + #f '())
(try 'for-each for-each + '() #f)
(try 'for-each for-each + '(1 . #f) '(0 . #f))
(try 'for-each for-each #f '(1 2 3) '(0 2 6))
(try 'for-each for-each + '() '() '())
(try 'for-each for-each + '(1 2 3) '(0 2 6) '(10 100 1000))
(try 'for-each for-each + '(1 2 3) '(0 2) '(10 100 1000))
(try 'for-each for-each + '(1 2 3) '(0 2) '(10 100 1000))
(try 'for-each for-each + '(1 2) '(0 2 6) '(10 100 1000))
(try 'for-each for-each + #f '() '())
(try 'for-each for-each + '() #f '())
(try 'for-each for-each + '() '() #f)
(try 'for-each for-each + '(1 . #f) '(0 . #f) '(10 . #f))
(try 'for-each for-each #f '(1 2 3) '(0 2 6) '(10 100 1000))
)
(test-for-each)

(define (test-force) ; no error possible
;(let ((x (delay (+ 2 3)))) (try 'force force x))
(try 'force force 123)
)
(test-force)

(define (test-call-with-current-continuation)
;(try 'call-with-current-continuation call-with-current-continuation list)
(try 'call-with-current-continuation call-with-current-continuation #f)
)
(test-call-with-current-continuation)

(define (test-call-with-input-file)
(try 'call-with-input-file call-with-input-file #f list)
(try 'call-with-input-file call-with-input-file "tmp" #f)
(try 'call-with-input-file call-with-input-file "notexist" list)
)
(test-call-with-input-file)

(define (test-call-with-output-file)
(try 'call-with-output-file call-with-output-file #f list)
(try 'call-with-output-file call-with-output-file "tmp" #f)
)
(test-call-with-output-file)

(define (test-input-port?)
(try 'input-port? input-port? (current-input-port))
(try 'input-port? input-port? (current-output-port))
(try 'input-port? input-port? #f)
)
(test-input-port?)

(define (test-output-port?)
(try 'output-port? output-port? (current-output-port))
(try 'output-port? output-port? (current-input-port))
(try 'output-port? output-port? #f)
)
(test-output-port?)

(define (test-current-input-port) ; no error possible
(try 'current-input-port current-input-port)
)
(test-current-input-port)

(define (test-current-output-port) ; no error possible
(try 'current-output-port current-output-port)
)
(test-current-output-port)

(define (test-with-input-from-file)
(try 'with-input-from-file with-input-from-file #f list)
(try 'with-input-from-file with-input-from-file "tmp" #f)
(try 'with-input-from-file with-input-from-file "noexist" list)
)
(test-with-input-from-file)

(define (test-with-output-to-file)
(try 'with-output-to-file with-output-to-file #f list)
(try 'with-output-to-file with-output-to-file "tmp" #f)
)
(test-with-output-to-file)

(define (test-open-input-file)
(try 'open-input-file open-input-file #f)
(try 'open-input-file open-input-file "noexist")
)
(test-open-input-file)

(define (test-open-output-file)
(try 'open-output-file open-output-file #f)
)
(test-open-output-file)

(define (test-close-input-port)
(try 'close-input-port close-input-port (current-output-port))
(try 'close-input-port close-input-port #f)
)
(test-close-input-port)

(define (test-close-output-port)
(try 'close-output-port close-output-port (current-input-port))
(try 'close-output-port close-output-port #f)
)
(test-close-output-port)

(define (test-read)
(try 'read read)
(try 'read read (current-output-port))
(try 'read read #f)
)
(test-read)

(define (test-read-char)
(try 'read-char read-char)
(try 'read-char read-char (current-output-port))
(try 'read-char read-char #f)
)
(test-read-char)

(define (test-peek-char)
(try 'peek-char peek-char)
(try 'peek-char peek-char (current-output-port))
(try 'peek-char peek-char #f)
)
(test-peek-char)

(define (test-eof-object?) ; no error possible
(try 'eof-object? eof-object? #f)
(try 'eof-object? eof-object? "abc")
)
(test-eof-object?)

(define (test-char-ready?)
(try 'char-ready? char-ready?)
(try 'char-ready? char-ready? (current-input-port))
(try 'char-ready? char-ready? (current-output-port))
(try 'char-ready? char-ready? #f)
)
(test-char-ready?)

(define (test-write)
(try 'write write "abc")
(try 'write write "abc" (current-output-port))
(try 'write write "abc" (current-input-port))
(try 'write write "abc" #f)
)
(test-write)

(define (test-display)
(try 'display display "abc")
(try 'display display "abc" (current-output-port))
(try 'display display "abc" (current-input-port))
(try 'display display "abc" #f)
)
(test-display)

(define (test-newline)
(try 'newline newline)
(try 'newline newline (current-output-port))
(try 'newline newline (current-input-port))
(try 'newline newline #f)
)
(test-newline)

(define (test-write-char)
(try 'write-char write-char #\A)
(try 'write-char write-char 123)
(try 'write-char write-char #\A (current-output-port))
(try 'write-char write-char 123 (current-output-port))
(try 'write-char write-char #\A (current-input-port))
(try 'write-char write-char #\A #f)
)
(test-write-char)

(define (test-load)
(try 'load load "noexist")
(try 'load load #f)
)
(test-load)

(define (test-transcript-on)
(try 'transcript-on transcript-on #f)
)
(test-transcript-on)

(define (test-transcript-off)
(try 'transcript-off transcript-off)
)
(test-transcript-off)

;------------------------------------------------------------------------------

(define (path-exp file dir)
  (string-append dir "/" file))

(define (test-setenv)
(try 'setenv setenv "UNKNOWNVAR1")
(try 'setenv setenv "UNKNOWNVAR2" "NOW-DEFINED")
)
(test-setenv)

(define (test-getenv)
(try 'getenv getenv "UNKNOWNVAR1")
(try 'getenv getenv "UNKNOWNVAR2")
(try 'getenv getenv "UNKNOWNVAR1" 999)
(try 'getenv getenv "UNKNOWNVAR2" 999)
)
(test-getenv)

(define (test-command-line)
(define (cdr-command-line) (cdr (command-line)))
(try 'cdr-command-line cdr-command-line)
)
(test-command-line)

(define (test-shell-command)
(try 'shell-command shell-command "echo hello > newfile1")
;(try 'shell-command shell-command "notexist")
)
(test-shell-command)

(define (test-create-directory)
(try 'create-directory create-directory "newdir1")
(try 'create-directory create-directory "newdir1")
(try 'create-directory create-directory "newfile1")
)
(test-create-directory)

(define (test-rename-file)
(try 'rename-file rename-file "newdir1" "newdir2")
(try 'rename-file rename-file "newdir1" "newdir2")
(try 'rename-file rename-file "newfile1" (path-exp "aaa" "newdir2"))
(try 'rename-file rename-file "newfile1" (path-exp "aaa" "newdir2"))
)
(test-rename-file)

(define (test-copy-file)
(try 'copy-file copy-file "error.scm" (path-exp "bbb" "newdir2"))
(try 'copy-file copy-file "notexist" (path-exp "ccc" "newdir2"))
)
(test-copy-file)

(define (test-directory-files)
(define (sort-directory-files)
  (sort-list (directory-files "newdir2") string<?))
(try 'sort-directory-files sort-directory-files)
)
(test-directory-files)

(define (test-file-exists?)
(try 'file-exists? file-exists? ".")
(try 'file-exists? file-exists? "error.scm")
(try 'file-exists? file-exists? "newdir2")
(try 'file-exists? file-exists? (path-exp "bbb" "newdir2"))
(try 'file-exists? file-exists? "notexist")
)
(test-file-exists?)

(define (test-file-type)
(try 'file-type file-type ".")
(try 'file-type file-type "error.scm")
(try 'file-type file-type "newdir2")
(try 'file-type file-type (path-exp "bbb" "newdir2"))
(try 'file-type file-type "notexist")
)
(test-file-type)

(define (test-file-size)
(try 'file-size file-size "error.scm")
(try 'file-size file-size (path-exp "bbb" "newdir2"))
(try 'file-size file-size "notexist")
)
(test-file-size)

(define (test-delete-file-and-directory)
(try 'delete-directory delete-directory "newdir2")
(try 'delete-file delete-file (path-exp "aaa" "newdir2"))
(try 'delete-file delete-file (path-exp "bbb" "newdir2"))
(try 'delete-file delete-file (path-exp "ccc" "newdir2"))
(try 'delete-directory delete-directory "newdir2")
)
(test-delete-file-and-directory)

(define (test-open-process)
(define (read-all-open-process)
  (let ((p
         (open-process (list path: "sort"
                             arguments: (list "input")
                             eol-encoding: 'cr-lf))))
    (output-port-timeout-set! p 10)
    (input-port-timeout-set! p 10)
    (let ((x (read-all p)))
      (close-port p)
      x)))
(try 'open-process open-process
     (list path: "sort"
           arguments: (list "input")
           eol-encoding: 'cr-lf))
(try 'read-all-open-process read-all-open-process)
)
(test-open-process)

(define (test-host-info)
(define (host-info-addresses-host-info hostname)
  (host-info-addresses (host-info hostname)))
(try 'host-info host-info "notexist.iro.umontreal.ca")
(try 'host-info-addresses-host-info
     host-info-addresses-host-info
     "www.iro.umontreal.ca")
)
(test-host-info)

(define (test-open-tcp-client)
(define (string?-read-line-open-tcp-client)
  (let ((p
         (open-tcp-client
          (list server-address: "www.iro.umontreal.ca"
                port-number: 80
                eol-encoding: 'cr-lf))))
    (output-port-timeout-set! p 10)
    (input-port-timeout-set! p 10)
    (display "GET /gambit-check\n\n" p)
    (force-output p)
    (let ((x (read-line p)))
      (close-port p)
      (string? x))))
'
(try 'open-tcp-client open-tcp-client
     (list server-address: "www.iro.umontreal.ca"
           port-number: 80
           eol-encoding: 'cr-lf))
'
(try 'string?-read-line-open-tcp-client string?-read-line-open-tcp-client)
)
(test-open-tcp-client)

;------------------------------------------------------------------------------

(exit)