(define-library (srfi 38 test)
  (export run-tests)
  (import (chibi) (chibi test) (srfi 1) (srfi 38))
  (begin
    (define (run-tests)
      (define (read-from-string str)
        (call-with-input-string str
          (lambda (in) (read/ss in))))

      (define (write-to-string x . o)
        (call-with-output-string
          (lambda (out) (apply write/ss x out o))))

      (define-syntax test-io
        (syntax-rules ()
          ((test-io str-expr expr)
           (let ((str str-expr)
                 (value expr))
             (test str (write-to-string value))
             (test str (write-to-string (read-from-string str)))))))

      (define-syntax test-cyclic-io
        (syntax-rules ()
          ((test-cyclic-io str-expr expr)
           (let ((str str-expr)
                 (value expr))
             (test str (write-to-string value #t))
             (test str (write-to-string (read-from-string str) #t))))))

      (test-begin "srfi-38: shared read/write")

      (test-io "(1)" (list 1))
      (test-io "(1 2)" (list 1 2))
      (test-io "(1 . 2)" (cons 1 2))

      (test-io "#0=(1 . #0#)" (circular-list 1))
      (test-io "#0=(1 2 . #0#)" (circular-list 1 2))
      (test-io "(1 . #0=(2 . #0#))" (cons 1 (circular-list 2)))
      (test-io "#0=(1 #0# 3)"
               (let ((x (list 1 2 3))) (set-car! (cdr x) x) x))
      (test-io "(#0=(1 #0# 3))"
               (let ((x (list 1 2 3))) (set-car! (cdr x) x) (list x)))
      (test-io "(#0=(1 #0# 3) #0#)"
               (let ((x (list 1 2 3))) (set-car! (cdr x) x) (list x x)))
      (test-io "(#0=(1 . #0#) #1=(1 . #1#))"
               (list (circular-list 1) (circular-list 1)))

      (test-io "(#0=(1 . 2) #1=(1 . 2) #2=(3 . 4) #0# #1# #2#)"
               (let ((a (cons 1 2)) (b (cons 1 2)) (c (cons 3 4)))
                 (list a b c a b c)))
      (test-io "((1 . #0=#(2)) #0#)"
               (let ((vec (vector 2)))
                 (list (cons 1 vec) vec)))
      (test-io "((1 . #0=#(2 #0#)) #0#)"
               (let ((vec (vector 2 #f)))
                 (vector-set! vec 1 vec)
                 (list (cons 1 vec) vec)))
      (test-cyclic-io "((1 . 2) (1 . 2) (3 . 4) (1 . 2) (1 . 2) (3 . 4))"
                      (let ((a (cons 1 2)) (b (cons 1 2)) (c (cons 3 4)))
                        (list a b c a b c)))
      (test-cyclic-io "#0=((1 . 2) (1 . 2) (3 . 4) . #0#)"
                      (let* ((a (cons 1 2))
                             (b (cons 1 2))
                             (c (cons 3 4))
                             (ls (list a b c)))
                        (set-cdr! (cddr ls) ls)
                        ls))

      (test-io "#0=#(#0#)"
               (let ((x (vector 1))) (vector-set! x 0 x) x))
      (test-io "#0=#(1 #0#)"
               (let ((x (vector 1 2))) (vector-set! x 1 x) x))
      (test-io "#0=#(1 #0# 3)"
               (let ((x (vector 1 2 3))) (vector-set! x 1 x) x))
      (test-io "(#0=#(1 #0# 3))"
               (let ((x (vector 1 2 3))) (vector-set! x 1 x) (list x)))
      (test-io "#0=#(#0# 2 #0#)"
               (let ((x (vector 1 2 3)))
                 (vector-set! x 0 x)
                 (vector-set! x 2 x)
                 x))

      (test '+.! (read-from-string "+.!"))

      (test 255 (read-from-string "#xff"))
      (test 99 (read-from-string "#d99"))
      (test 63 (read-from-string "#o77"))
      (test 3 (read-from-string "#b11"))
      (test 5 (read-from-string "#e5.0"))
      (test 5.0 (read-from-string "#i5"))
      (test 15 (read-from-string "#e#xf"))
      (test 15.0 (read-from-string "#i#xf"))
      (test (expt 10 100) (read-from-string "#e1e100"))

      (test "A\n\nB\n" (read-from-string "\"A\\n\\
                                            \\n\\
                                            B\n\""))
      (test "A\n\n" (read-from-string "\"A\\n\\
                                         \\n\\
                                         \""))

      (cond-expand
       (chicken
        (test-io "(#0=\"abc\" #0# #0#)"
                 (let ((str (string #\a #\b #\c))) (list str str str)))
        (test "(\"abc\" \"abc\" \"abc\")"
            (let ((str (string #\a #\b #\c)))
              (call-with-output-string
                (lambda (out)
                  (write/ss (list str str str) out ignore-strings: #t))))))
       (else
        ))

      (test-end))))