(define-library (chibi optional-test)
  (import (scheme base) (chibi optional))
  (cond-expand
   (chibi (import (chibi test)))
   (else
    (import (scheme write))
    ;; inline (chibi test) to avoid circular dependencies in snow
    ;; installations
    (begin
      (define-syntax test
       (syntax-rules ()
         ((test expect expr)
          (test 'expr expect expr))
         ((test name expect expr)
          (guard (exn (else (display "!\nERROR: ") (write name) (newline)
                            (write exn) (newline)))
            (let* ((res expr)
                   (pass? (equal? expect expr)))
              (display (if pass? "." "x"))
              (cond
               ((not pass?)
                (display "\nFAIL: ") (write name) (newline))))))))
      (define-syntax test-assert
        (syntax-rules ()
          ((test-assert expr) (test #t expr))))
      (define-syntax test-error
        (syntax-rules ()
          ((test-error expr)
           (test-assert (guard (exn (else #t)) expr #f)))))
      (define (test-begin name)
        (display name))
      (define (test-end)
        (newline)))))
  (export run-tests)
  (begin
    (define (run-tests)
      (test-begin "optional")
      (test '(0 11 12)
          (let-optionals '(0) ((a 10) (b 11) (c 12))
            (list a b c)))
      (test '(0 11 12)
          ((opt-lambda ((a 10) (b 11) (c 12))
             (list a b c))
           0))
      (test '(0 11 12)
          ((opt-lambda (a (b 11) (c 12))
             (list a b c))
           0))
      (test '(0 11 2)
          (let ((b 1))
            ((opt-lambda (a (b 11) (c (* b 2)))
               (list a b c))
             0)))
      (test '(0 11 22)
          (let ((b 1))
            ((opt-lambda* (a (b 11) (c (* b 2)))
               (list a b c))
             0)))
      (test '(0 1 (2 3 4))
          (let-optionals* '(0 1 2 3 4) ((a 10) (b 11) . c)
            (list a b c)))
      (test '(0 1 (2 3 4))
          (let-optionals '(0 1 2 3 4) ((a 10) (b 11) . c)
            (list a b c)))
      (test '(0 1 (2 3 4))
          (let-optionals* '(0 1 2 3 4) (a (b 11) . c)
            (list a b c)))
      (test '(0 1 (2 3 4))
          (let-optionals '(0 1 2 3 4) (a (b 11) . c)
            (list a b c)))
      (let ((ls '()))
        (let-optionals* ls ((a (begin (set! ls '(a b)) 'default-a))
                            (b 'default-b))
          (test '(default-a default-b) (list a b))))
      (let ((ls (list 0 1 2)))
        (let-optionals ls (a . b)
          (set-car! (cdr ls) 3)
          (test '(0 3 2) ls)
          (test '(0 1 2) (cons a b))))
      (test 5 (keyword-ref '(a: b: b: 5) 'b: #f))
      (test 5 (keyword-ref* '(a: b: b: 5) 'b: #f))
      (test '(1 2 0 (other: 9))
          (let-keywords '(b: 2 a: 1 other: 9)
              ((a 0) (b 0) (c 0) rest)
            (list a b c rest)))
      ;; a: is not in a keyword position, and the 3 is dropped
      (test '(1 (2 a:))
          (let-keywords '(2 a: 3) ((a a: 1) rest) (list a rest)))
      ;; a: is in a keyword position, and the 3 is dropped
      (test '(2 ())
          (let-keywords '(a: 2 3) ((a a: 1) rest) (list a rest)))
      ;; a: is in a keyword position, 3->5 is a kv, 4 is dropped
      (test '(2 (3 5))
          (let-keywords '(3 5 a: 2 4) ((a a: 1) rest) (list a rest)))
      ;; a: is in a keyword position, 3->5 and 4->6 are kvs
      (test '(2 (3 5 4 6))
          (let-keywords '(3 5 a: 2 4 6) ((a a: 1) rest) (list a rest)))
      (cond-expand
       (gauche)     ; gauche detects this at compile-time, can't catch
       (else (test-error '(0 11 12)
                         ((opt-lambda (a (b 11) (c 12))
                            (list a b c))))))
      (let ()
        (define-opt (f a (b 11) (c 12))
          (list a b c))
        (cond-expand
         (gauche)
         (else
          (test-error (f))))
        (test '(0 11 12) (f 0))
        (test '(0 1 12) (f 0 1))
        (test '(0 1 2) (f 0 1 2))
        (test '(0 1 2) (f 0 1 2 3)))
      (test-end))))