mirror of
https://github.com/ashinn/chibi-scheme.git
synced 2025-05-19 13:49:17 +02:00
8b5eb68238
They can be close()d explicitly with close-file-descriptor, and will close() on gc, but only explicitly closing the last port on them will close the fileno. Notably needed for network sockets where we open separate input and output ports on the same socket.
93 lines
2.9 KiB
Scheme
93 lines
2.9 KiB
Scheme
|
|
(cond-expand
|
|
(chibi (import (chibi) (chibi test) (srfi 1) (srfi 38)))
|
|
(chicken (use chicken test srfi-38)))
|
|
|
|
(test-begin "read/write")
|
|
|
|
(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-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-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-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 255 (read-from-string "#xff"))
|
|
(test 99 (read-from-string "#d99"))
|
|
(test 63 (read-from-string "#o77"))
|
|
(test 3 (read-from-string "#b11"))
|
|
|
|
(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)
|