mirror of
https://github.com/ashinn/chibi-scheme.git
synced 2025-05-19 05:39:18 +02:00
116 lines
4.3 KiB
Scheme
116 lines
4.3 KiB
Scheme
(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 "#\newline" #\newline)
|
|
|
|
(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))))
|