619 lines
20 KiB
Scheme
619 lines
20 KiB
Scheme
|
|
(load-relative "loadtest.ss")
|
|
|
|
(SECTION 'port)
|
|
|
|
(define SLEEP-TIME 0.1)
|
|
|
|
(require (lib "port.ss"))
|
|
|
|
;; ----------------------------------------
|
|
|
|
;; pipe and pipe-with-specials commmit tests
|
|
(define (test-pipe-commit make-pipe)
|
|
(let-values ([(in out) (make-pipe)])
|
|
(display "apple" out)
|
|
(test #"app" peek-bytes 3 0 in)
|
|
(let ([sema (make-semaphore 1)])
|
|
(test #t port-commit-peeked 3 (port-progress-evt in) sema in)
|
|
(test #f semaphore-try-wait? sema))
|
|
(test #"le" read-bytes 2 in)
|
|
(display "banana" out)
|
|
(test #"ban" peek-bytes 3 0 in)
|
|
;; Set up a commit that fails, because the done-evt never becomes ready:
|
|
(let* ([r '?]
|
|
[unless-evt (port-progress-evt in)]
|
|
[th (thread
|
|
(lambda ()
|
|
(set! r (port-commit-peeked 3 unless-evt never-evt in))))])
|
|
(sleep SLEEP-TIME)
|
|
(test #t thread-running? th)
|
|
(test #\b peek-char in)
|
|
(sleep SLEEP-TIME)
|
|
(test #t thread-running? th)
|
|
(test #f sync/timeout 0 unless-evt)
|
|
(test #\b read-char in)
|
|
(sleep SLEEP-TIME)
|
|
(test th sync th)
|
|
(test #f values r))
|
|
(test "anana" read-string 5 in)
|
|
;; Set up two commits, pick one to succeed:
|
|
(let ([go (lambda (which peek? suspend/kill)
|
|
(printf "~a ~a ~a~n" which peek? suspend/kill)
|
|
(display "donut" out)
|
|
(test #"don" peek-bytes 3 0 in)
|
|
(let* ([r1 '?]
|
|
[r2 '?]
|
|
[s1 (make-semaphore)]
|
|
[s2 (make-semaphore)]
|
|
[unless-evt (port-progress-evt in)]
|
|
[th1 (thread
|
|
(lambda ()
|
|
(set! r1 (port-commit-peeked 1 unless-evt s1 in))))]
|
|
[_ (sleep SLEEP-TIME)]
|
|
[th2 (thread
|
|
(lambda ()
|
|
(set! r2 (port-commit-peeked 2 unless-evt (semaphore-peek-evt s2) in))))])
|
|
(sleep SLEEP-TIME)
|
|
(when suspend/kill
|
|
(case suspend/kill
|
|
[(suspend) (thread-suspend th1)]
|
|
[(kill) (kill-thread th1)])
|
|
(sleep SLEEP-TIME))
|
|
(test (eq? suspend/kill 'kill) thread-dead? th1)
|
|
(test #f thread-dead? th2)
|
|
(when peek?
|
|
(test #"do" peek-bytes 2 0 in)
|
|
(sleep SLEEP-TIME))
|
|
(unless (= which 3)
|
|
(semaphore-post (if (= which 1) s1 s2)))
|
|
(when (= which 3)
|
|
(test #"do" read-bytes 2 in))
|
|
(sleep SLEEP-TIME)
|
|
(test unless-evt sync/timeout 0 unless-evt)
|
|
(test (not (eq? suspend/kill 'suspend)) thread-dead? th1)
|
|
(sleep SLEEP-TIME)
|
|
(test #t thread-dead? th2)
|
|
(test (if (= which 1) #t (if suspend/kill '? #f)) values r1)
|
|
(test (= which 2) values r2)
|
|
(test (if (= which 1) #\o #\n) read-char in)
|
|
(test (if (= which 1) #"nut" #"ut") read-bytes (if (= which 1) 3 2) in)))])
|
|
(go 1 #f #f)
|
|
(go 2 #f #f)
|
|
(go 1 #t #f)
|
|
(go 2 #t #f)
|
|
(go 3 #f #f)
|
|
(go 2 #f 'suspend)
|
|
(go 2 #t 'suspend)
|
|
(go 3 #f 'suspend)
|
|
(go 2 #f 'kill)
|
|
(go 2 #t 'kill)
|
|
(go 3 #f 'kill))))
|
|
(test-pipe-commit make-pipe)
|
|
(test-pipe-commit (lambda () (make-pipe-with-specials 10000 'special-pipe 'spec-pipe)))
|
|
|
|
;; pipe-with-specials and limit; also used to test peeked-input-port
|
|
(define (test-special-pipe make-pipe-with-specials)
|
|
(let-values ([(in out) (make-pipe-with-specials 10)])
|
|
;; Check that write events work
|
|
(test 5 sync (write-bytes-avail-evt #"12345" out))
|
|
(test #"12345" read-bytes 5 in)
|
|
(test #f char-ready? in)
|
|
(test #t sync (write-special-evt 'okay out))
|
|
(test 11 write-bytes-avail (make-bytes 11 65) out)
|
|
(test 'okay read-char-or-special in)
|
|
(test (make-bytes 11 65) read-bytes 11 in)
|
|
|
|
(let ()
|
|
(define (bg thunk runs? spec? exn?)
|
|
;; Fill the pipe, again:
|
|
(test 10 write-bytes (make-bytes 10 66) out)
|
|
(let* ([ex #f]
|
|
[th (thread
|
|
(lambda ()
|
|
(with-handlers ([exn:fail? (lambda (x)
|
|
(set! ex #t)
|
|
(raise x))])
|
|
(sync (write-bytes-avail-evt #"x" out)))))])
|
|
(sleep SLEEP-TIME)
|
|
(test #t thread-running? th)
|
|
;; This thunk (and sometimes read) should go through the manager:
|
|
(thunk)
|
|
(sleep SLEEP-TIME)
|
|
(test (not runs?) thread-running? th)
|
|
(test (make-bytes 10 66) read-bytes 10 in)
|
|
(thread-wait th)
|
|
(test ex values exn?))
|
|
(when spec?
|
|
(test 'c read-char-or-special in))
|
|
(test (if exn? eof #"x") read-bytes 1 in))
|
|
|
|
(bg (lambda () (test 0 write-bytes-avail* #"c" out)) #f #f #f)
|
|
(bg (lambda () (test #t write-special 'c out)) #t #t #f)
|
|
(bg (lambda () (test (void) close-output-port out)) #t #f #t))))
|
|
(test-special-pipe make-pipe-with-specials)
|
|
(test-special-pipe (lambda (limit)
|
|
(let-values ([(in out) (make-pipe-with-specials limit)])
|
|
(values (peeking-input-port in) out))))
|
|
|
|
;; copy-port and make-pipe-with-specials tests
|
|
(let ([s (let loop ([n 10000][l null])
|
|
(if (zero? n)
|
|
(apply bytes l)
|
|
(loop (sub1 n) (cons (random 256) l))))])
|
|
(let-values ([(in out) (make-pipe-with-specials)])
|
|
(display s out)
|
|
(test #t 'pipe-same? (bytes=? s (read-bytes (bytes-length s) in)))
|
|
(test out sync/timeout 0 out)
|
|
(test #f sync/timeout 0 in)
|
|
(write-special 'hello? out)
|
|
(test 'hello? read-char-or-special in)
|
|
(display "123" out)
|
|
(write-special 'again! out)
|
|
(display "45" out)
|
|
(let ([s (make-bytes 5)])
|
|
(test 3 read-bytes-avail! s in)
|
|
(test #"123\0\0" values s)
|
|
(let ([p (read-bytes-avail! s in)])
|
|
(test #t procedure? p)
|
|
(test 'again! p 'ok 1 2 3))
|
|
(test 2 read-bytes-avail! s in)
|
|
(test #"453\0\0" values s)))
|
|
(let ([in (open-input-bytes s)]
|
|
[out (open-output-bytes)])
|
|
(copy-port in out)
|
|
(test #t 'copy-same? (bytes=? s (get-output-bytes out))))
|
|
(let* ([a (subbytes s 0 (max 1 (random (bytes-length s))))]
|
|
[b (subbytes s (bytes-length a) (+ (bytes-length a)
|
|
(max 1 (random (- (bytes-length s) (bytes-length a))))))]
|
|
[c (subbytes s (+ (bytes-length a) (bytes-length b)))])
|
|
(define (go-stream close? copy? threads? peek?)
|
|
(printf "Go stream: ~a ~a ~a ~a~n" close? copy? threads? peek?)
|
|
(let*-values ([(in1 out) (make-pipe-with-specials)]
|
|
[(in out1) (if copy?
|
|
(make-pipe-with-specials)
|
|
(values in1 out))])
|
|
(let ([w-th
|
|
(lambda ()
|
|
(display a out)
|
|
(write-special '(first one) out)
|
|
(display b out)
|
|
(write-special '(second one) out)
|
|
(display c out)
|
|
(when close?
|
|
(close-output-port out)))]
|
|
[c-th (lambda ()
|
|
(when copy?
|
|
(copy-port in1 out1)
|
|
(close-output-port out1)))]
|
|
[r-th (lambda ()
|
|
(let ([get-one-str
|
|
(lambda (a)
|
|
(let ([dest (make-bytes (bytes-length s))]
|
|
[target (bytes-length a)])
|
|
(let loop ([n 0])
|
|
(let ([v (read-bytes-avail! dest in n)])
|
|
(if (= target (+ v n))
|
|
(test #t `(same? ,target) (equal? (subbytes dest 0 target) a))
|
|
(loop (+ n v)))))))]
|
|
[get-one-special
|
|
(lambda (spec)
|
|
(let ([v (read-bytes-avail! (make-bytes 10) in)])
|
|
(test #t procedure? v)
|
|
(test spec v 'ok 5 5 5)))])
|
|
(when peek?
|
|
(test '(second one) peek-byte-or-special in (+ (bytes-length a) 1 (bytes-length b))))
|
|
(get-one-str a)
|
|
(get-one-special '(first one))
|
|
(get-one-str b)
|
|
(get-one-special '(second one))
|
|
(get-one-str c)
|
|
(if close?
|
|
(test eof read-byte in)
|
|
(test #f sync/timeout 0 in))))])
|
|
(let ([th (if threads?
|
|
thread
|
|
(lambda (f) (f)))])
|
|
(for-each (lambda (t)
|
|
(and (thread? t) (thread-wait t)))
|
|
(list
|
|
(th w-th)
|
|
(th c-th)
|
|
(th r-th)))))))
|
|
(go-stream #f #f #f #f)
|
|
(go-stream #t #f #f #f)
|
|
(go-stream #t #t #f #f)
|
|
(go-stream #t #f #t #f)
|
|
(go-stream #t #t #t #f)
|
|
(go-stream #t #f #f #t)
|
|
(go-stream #t #t #f #t)
|
|
(go-stream #t #f #t #t)
|
|
(go-stream #t #t #t #t)))
|
|
|
|
;; make-input-port/read-to-peek
|
|
(define (make-list-port . l)
|
|
(make-input-port/read-to-peek
|
|
'list-port
|
|
(lambda (bytes)
|
|
(cond
|
|
[(null? l) eof]
|
|
[(byte? (car l))
|
|
(bytes-set! bytes 0 (car l))
|
|
(set! l (cdr l))
|
|
1]
|
|
[(and (char? (car l))
|
|
(byte? (char->integer (car l))))
|
|
(bytes-set! bytes 0 (char->integer (car l)))
|
|
(set! l (cdr l))
|
|
1]
|
|
[else
|
|
(let ([v (car l)])
|
|
(set! l (cdr l))
|
|
(lambda (a b c d) v))]))
|
|
#f
|
|
void))
|
|
|
|
(let ([p (make-list-port #\h #\e #\l #\l #\o)])
|
|
(test (char->integer #\h) peek-byte p)
|
|
(test (char->integer #\e) peek-byte p 1)
|
|
(test (char->integer #\l) peek-byte p 2)
|
|
(test #"hel" read-bytes 3 p)
|
|
(test (char->integer #\l) peek-byte p)
|
|
(test (char->integer #\o) peek-byte p 1)
|
|
(test #"lo" read-bytes 3 p)
|
|
(test eof peek-byte p)
|
|
(test eof peek-byte p)
|
|
(test eof read-byte p)
|
|
(test eof read-byte p))
|
|
|
|
(let ([p (make-list-port #\h #\e #\l 'ack #\l #\o)])
|
|
(test (char->integer #\h) read-byte p)
|
|
(test (char->integer #\e) read-byte p)
|
|
(test (char->integer #\l) read-byte p)
|
|
(test 'ack read-byte-or-special p)
|
|
(test (char->integer #\l) read-byte p)
|
|
(test (char->integer #\o) read-byte p))
|
|
|
|
(let ([p (make-list-port #\h #\e #\l 'ack #\l #\o)])
|
|
(test (char->integer #\h) peek-byte p)
|
|
(test (char->integer #\l) peek-byte p 2)
|
|
(test 'ack peek-byte-or-special p 3)
|
|
(test (char->integer #\l) peek-byte p 4)
|
|
(test #"hel" read-bytes 3 p)
|
|
(test 'ack read-byte-or-special p)
|
|
(test #"lo" read-bytes 4 p))
|
|
|
|
(test 'hello read (make-list-port #\h #\e #\l #\l #\o))
|
|
(let ([p (make-list-port #\h #\e #\l eof #\l #\o)])
|
|
(test 'hel read p)
|
|
(test eof read p)
|
|
(test 'lo read p)
|
|
(test eof read p)
|
|
(test eof read p))
|
|
(let ([p (make-list-port #\h #\e #\l #\u7238 #\l #\o)])
|
|
(test 'hel read p)
|
|
(test #\u7238 read p)
|
|
(test 'lo read p))
|
|
|
|
;; read synchronization events
|
|
(define (go mk-hello sync atest btest)
|
|
(test #t list? (list mk-hello sync atest btest))
|
|
(test #"" sync (peek-bytes-evt 0 0 #f (mk-hello)))
|
|
(test #"" sync (read-bytes-evt 0 (mk-hello)))
|
|
(let ([p (mk-hello)])
|
|
(atest #"hello" sync (peek-bytes-evt 5 0 #f p))
|
|
(atest #"llo" sync (peek-bytes-evt 5 2 #f p))
|
|
(atest #"hello" sync (read-bytes-evt 5 p))
|
|
(atest eof sync (peek-bytes-evt 5 0 #f p))
|
|
(atest eof sync (read-bytes-evt 5 p)))
|
|
(test 0 sync (peek-bytes!-evt (make-bytes 0) 0 #f (mk-hello)))
|
|
(test 0 sync (read-bytes!-evt (make-bytes 0) (mk-hello)))
|
|
(let ([s (make-bytes 5)]
|
|
[p (mk-hello)])
|
|
(atest 5 sync (peek-bytes!-evt s 0 #f p))
|
|
(btest #"hello" values s)
|
|
(atest 3 sync (peek-bytes!-evt s 2 #f p))
|
|
(btest #"llolo" values s)
|
|
(bytes-copy! s 0 #"\0\0\0\0\0")
|
|
(atest 5 sync (read-bytes!-evt s p))
|
|
(btest #"hello" values s)
|
|
(atest eof sync (read-bytes!-evt s p)))
|
|
(test 0 sync (read-bytes-avail!-evt (make-bytes 0) (mk-hello)))
|
|
(let ([s (make-bytes 5)]
|
|
[p (mk-hello)])
|
|
(atest 5 sync (peek-bytes-avail!-evt s 0 #f p))
|
|
(btest #"hello" values s)
|
|
(atest 2 sync (peek-bytes-avail!-evt s 3 #f p))
|
|
(btest #"lollo" values s)
|
|
(bytes-copy! s 0 #"\0\0\0\0\0")
|
|
(atest 5 sync (read-bytes-avail!-evt s p))
|
|
(btest #"hello" values s)
|
|
(atest eof sync (read-bytes-avail!-evt s p)))
|
|
(test "" sync (read-string-evt 0 (mk-hello)))
|
|
(let ([p (mk-hello)])
|
|
(atest "hello" sync (peek-string-evt 5 0 #f p))
|
|
(atest "lo" sync (peek-string-evt 5 3 #f p))
|
|
(atest "hello" sync (read-string-evt 5 p))
|
|
(atest eof sync (peek-string-evt 5 0 #f p))
|
|
(atest eof sync (peek-string-evt 5 100 #f p))
|
|
(atest eof sync (read-string-evt 5 p)))
|
|
(test 0 sync (read-string!-evt (make-string 0) (mk-hello)))
|
|
(let ([s (make-string 5)]
|
|
[p (mk-hello)])
|
|
(let ([s2 (make-string 5)])
|
|
(atest 5 sync (peek-string!-evt s2 0 #f p))
|
|
(btest "hello" values s2))
|
|
(atest 5 sync (read-string!-evt s p))
|
|
(btest "hello" values s)
|
|
(atest eof sync (read-string!-evt s p)))
|
|
(let ([p (mk-hello)])
|
|
(atest '(#"hello") sync (regexp-match-evt #rx"....." p)))
|
|
(let ([p (mk-hello)])
|
|
(atest '(#"hello") sync (regexp-match-evt #rx".*" p)))
|
|
(let ([p (mk-hello)])
|
|
(atest '(#"hel") sync (regexp-match-evt #rx"..." p))
|
|
(atest '(#"lo") sync (regexp-match-evt #rx".." p)))
|
|
(let ([p (mk-hello)])
|
|
(atest #"hello" sync (read-bytes-line-evt p))
|
|
(atest eof sync (read-bytes-line-evt p))
|
|
(atest eof sync (eof-evt p)))
|
|
(let ([p (mk-hello)])
|
|
(atest "hello" sync (read-line-evt p))
|
|
(atest eof sync (read-line-evt p))))
|
|
(go (lambda () (open-input-bytes #"hello")) sync test test)
|
|
|
|
(define (sync/poll . args) (apply sync/timeout 0 args))
|
|
(go (lambda () (open-input-bytes #"hello")) sync/poll test test)
|
|
|
|
(define (delay-hello)
|
|
(let-values ([(r w) (make-pipe)])
|
|
(thread (lambda ()
|
|
(sleep 0.1)
|
|
(write-string "hello" w)
|
|
(close-output-port w)))
|
|
r))
|
|
(go delay-hello sync test test)
|
|
|
|
(go (lambda ()
|
|
(let-values ([(r w) (make-pipe)])
|
|
r))
|
|
sync/poll
|
|
(lambda args
|
|
(apply test #f (cdr args)))
|
|
(lambda args
|
|
(apply test (if (string? (car args))
|
|
(make-string (string-length (car args)))
|
|
(make-bytes (bytes-length (car args))))
|
|
(cdr args))))
|
|
|
|
|
|
;; extra checks for read-line-evt:
|
|
(let ([p (open-input-string "ab\nc")])
|
|
(test "ab" sync (read-line-evt p))
|
|
(test "c" sync (read-line-evt p))
|
|
(test eof sync (read-line-evt p)))
|
|
(let ([p (open-input-string "ab\nc")])
|
|
(test "ab\nc" sync (read-line-evt p 'return))
|
|
(test eof sync (read-line-evt p 'return)))
|
|
(let ([p (open-input-string "ab\r\nc\r")])
|
|
(test "ab" sync (read-line-evt p 'return))
|
|
(test "\nc" sync (read-line-evt p 'return))
|
|
(test eof sync (read-line-evt p 'return)))
|
|
(let ([p (open-input-string "ab\r\nc\r")])
|
|
(test "ab" sync (read-line-evt p 'return-linefeed))
|
|
(test "c\r" sync (read-line-evt p 'return-linefeed))
|
|
(test eof sync (read-line-evt p 'return-linefeed)))
|
|
(let ([p (open-input-string "ab\r\nc\r")])
|
|
(test "ab" sync (read-line-evt p 'any))
|
|
(test "c" sync (read-line-evt p 'any))
|
|
(test eof sync (read-line-evt p 'any)))
|
|
(let ([p (open-input-string "ab\r\nc\r")])
|
|
(test "ab" sync (read-line-evt p 'any-one))
|
|
(test "" sync (read-line-evt p 'any-one))
|
|
(test "c" sync (read-line-evt p 'any-one))
|
|
(test eof sync (read-line-evt p 'any-one)))
|
|
|
|
;; input-port-append tests
|
|
(let* ([do-test
|
|
;; ls is a list of strings for ports
|
|
;; n, m, q are positive
|
|
;; n and n+m < total length
|
|
;; n+m+q can be greater than total length
|
|
(lambda (ls n m q)
|
|
(let* ([p (apply input-port-append #f (map open-input-string ls))]
|
|
[s (apply string-append ls)]
|
|
[l (string-length s)])
|
|
(test (substring s 0 n) peek-string n 0 p)
|
|
(test (substring s n (min l (+ n m q))) peek-string (+ m q) n p)
|
|
(test (substring s (+ n m) (min l (+ n m q))) peek-string q (+ n m) p)
|
|
|
|
(test (substring s 0 n) read-string n p)
|
|
|
|
(test (substring s n (+ n m)) peek-string m 0 p)
|
|
(test (substring s (+ n m) (min l (+ n m q))) peek-string q m p)
|
|
|
|
(test (substring s n (+ n m)) read-string m p)
|
|
|
|
(test (substring s (+ n m) (min l (+ n m q))) peek-string q 0 p)))]
|
|
[do-tests
|
|
(lambda (ls)
|
|
(let ([l (apply + (map string-length ls))])
|
|
(let loop ([n 1])
|
|
(unless (= n (- l 2))
|
|
(let loop ([m 1])
|
|
(unless (= (+ m n) (- l 1))
|
|
(do-test ls n m 1)
|
|
(do-test ls n m (- l n m))
|
|
(do-test ls n m (+ (- l n m) 2))
|
|
(loop (add1 m))))
|
|
(loop (add1 n))))))])
|
|
(do-tests '("apple" "banana"))
|
|
(do-tests '("ax" "b" "cz")))
|
|
;; input-port-append and not-ready inputs
|
|
(let ([p0 (open-input-bytes #"123")])
|
|
(let-values ([(p1 out) (make-pipe)])
|
|
(let ([p (input-port-append #f p0 p1)])
|
|
(display "4" out)
|
|
(test #"1234" peek-bytes 4 0 p)
|
|
(test #"34" peek-bytes 2 2 p)
|
|
(test #"4" peek-bytes 1 3 p)
|
|
(let* ([v #f]
|
|
[t (thread (lambda ()
|
|
(set! v (read-bytes 6 p))))])
|
|
(test #f sync/timeout SLEEP-TIME t)
|
|
(display "56" out)
|
|
(test t sync/timeout SLEEP-TIME t)
|
|
(test #"123456" values v)))))
|
|
|
|
;; make-limited-input-port tests
|
|
(let* ([s (open-input-string "123456789")]
|
|
[s2 (make-limited-input-port s 5)])
|
|
(test #"123" peek-bytes 3 0 s2)
|
|
(test #"12345" peek-bytes 6 0 s2)
|
|
(test #"12" read-bytes 2 s2)
|
|
(test #"345" read-bytes 6 s2)
|
|
(test eof read-bytes 6 s2)
|
|
(test #f port-provides-progress-evts? s2))
|
|
(let-values ([(i o) (make-pipe)])
|
|
(let ([s (make-limited-input-port i 5)])
|
|
(test #f char-ready? s)
|
|
(display "123" o)
|
|
(test #t char-ready? s)
|
|
(let ([b (make-bytes 10)])
|
|
(test 3 peek-bytes-avail!* b 0 #f s)
|
|
(test 3 read-bytes-avail!* b s)
|
|
(test 0 peek-bytes-avail!* b 0 #f s)
|
|
(display "456" o)
|
|
(test 2 peek-bytes-avail!* b 0 #f s)
|
|
(test 1 peek-bytes-avail!* b 1 #f s)
|
|
(test 2 read-bytes-avail!* b s))))
|
|
|
|
;; ----------------------------------------
|
|
;; Conversion wrappers
|
|
|
|
(define (try-eip-seq encoding bytes try-map)
|
|
(let* ([p (open-input-bytes bytes)]
|
|
[p2 (reencode-input-port p encoding #".!")])
|
|
(for-each (lambda (one-try)
|
|
(let ([p (if (car one-try)
|
|
p2
|
|
p)]
|
|
[len (cadr one-try)]
|
|
[expect (caddr one-try)])
|
|
(test expect read-bytes len p)))
|
|
try-map)))
|
|
|
|
(try-eip-seq "UTF-8" #"apple" `((#t 3 #"app") (#f 2 #"le") (#t 4 ,eof)))
|
|
(try-eip-seq "UTF-8" #"ap\303\251ple" `((#t 3 #"ap\303") (#f 2 #"pl") (#t 4 #"\251e") (#t 5 ,eof)))
|
|
(try-eip-seq "ISO-8859-1" #"ap\303\251ple" `((#t 3 #"ap\303") (#f 2 #"\251p") (#t 4 #"\203le") (#t 5 ,eof)))
|
|
(try-eip-seq "UTF-8" #"ap\251ple" `((#t 2 #"ap") (#f 2 #"\251p") (#t 4 #"le") (#t 5 ,eof)))
|
|
(try-eip-seq "UTF-8" #"ap\251ple" `((#t 3 #"ap.") (#f 1 #"p") (#t 4 #"!le") (#t 5 ,eof)))
|
|
(try-eip-seq "UTF-8" #"ap\251ple" `((#t 4 #"ap.!") (#f 1 #"l") (#t 4 #"pe") (#t 5 ,eof)))
|
|
|
|
(let-values ([(in out) (make-pipe-with-specials)])
|
|
(display "ok" out)
|
|
(write-special 'special! out)
|
|
(display "yz" out)
|
|
(let ([p (reencode-input-port in "UTF-8")])
|
|
(test #"ok" read-bytes 2 p)
|
|
(test 'special! read-byte-or-special p)
|
|
(test #"yz" read-bytes 2 p)
|
|
(close-output-port out)
|
|
(test eof read-bytes 3 p)))
|
|
|
|
(let*-values ([(r w) (make-pipe 10)]
|
|
[(w2) (reencode-output-port w "UTF-8" #"!?")])
|
|
(test 4 write-bytes #"abcd" w2)
|
|
(flush-output w2)
|
|
(test #"abcd" read-bytes 4 r)
|
|
|
|
(test 3 write-bytes #"abc" w2)
|
|
(test 0 read-bytes-avail!* (make-bytes 10) r)
|
|
(test 1 write-bytes-avail #"wx" w2)
|
|
(test #"abcw" read-bytes 4 r)
|
|
|
|
;; Check encoding error
|
|
(test 4 write-bytes #"ab\303x" w2)
|
|
(flush-output w2)
|
|
(test #"ab!?x" read-bytes 5 r)
|
|
|
|
;; Check flushing in middle of encoding:
|
|
(test 3 write-bytes #"ab\303" w2)
|
|
(test 0 read-bytes-avail!* (make-bytes 10) r)
|
|
(test 1 write-bytes-avail #"\251x" w2)
|
|
(test #"ab\303\251" read-bytes 4 r)
|
|
(test 1 write-bytes-avail #"abc" w2)
|
|
(test #"a" read-bytes 1 r)
|
|
|
|
;; Check blocking on full pipe:
|
|
(test 10 write-bytes #"1234567890" w2)
|
|
(flush-output w2)
|
|
(test #f sync/timeout 0.0 w)
|
|
(test #f sync/timeout 0.0 w2)
|
|
(test 0 write-bytes-avail* #"123" w2)
|
|
(test 0 write-bytes-avail* #"123" w2)
|
|
(test 0 write-bytes-avail* #"123" w2)
|
|
(test #"1234567890" read-bytes 10 r)
|
|
(test w2 sync/timeout 0.0 w2)
|
|
(test 1 write-bytes-avail #"123" w2)
|
|
|
|
;; Check specials:
|
|
(let*-values ([(in out) (make-pipe-with-specials)]
|
|
[(out2) (reencode-output-port out "UTF-8" #"!")])
|
|
(test 3 write-bytes #"123" out2)
|
|
(test #t write-special 'spec out2)
|
|
(test 3 write-bytes #"456" out2)
|
|
(flush-output out2)
|
|
(test #"123" read-bytes 3 in)
|
|
(test 'spec read-char-or-special in)
|
|
(test #"456" read-bytes 3 in))
|
|
|
|
(void))
|
|
|
|
;; Check buffer modes:
|
|
(let ([i (open-input-string "abc")]
|
|
[o (open-output-string)])
|
|
(test #f file-stream-buffer-mode i)
|
|
(test #f file-stream-buffer-mode o)
|
|
(let ([ei (reencode-input-port i "UTF-8")]
|
|
[eo (reencode-output-port o "UTF-8")])
|
|
(test 'none file-stream-buffer-mode ei)
|
|
(test 'block file-stream-buffer-mode eo)
|
|
|
|
(test (void) display 10 eo)
|
|
(test (void) display 12 eo)
|
|
(test (void) newline eo)
|
|
(test #"" get-output-bytes o)
|
|
(test (void) flush-output eo)
|
|
(test #"1012\n" get-output-bytes o)
|
|
|
|
(test (void) file-stream-buffer-mode eo 'line)
|
|
(test 'line file-stream-buffer-mode eo)
|
|
(test (void) display 13 eo)
|
|
(test #"1012\n" get-output-bytes o)
|
|
(test (void) newline eo)
|
|
(test #"1012\n13\n" get-output-bytes o)
|
|
(test (void) flush-output eo)
|
|
(test #"1012\n13\n" get-output-bytes o)
|
|
|
|
(test (void) display 14 eo)
|
|
(test #"1012\n13\n" get-output-bytes o)
|
|
(test (void) file-stream-buffer-mode eo 'none)
|
|
(test #"1012\n13\n14" get-output-bytes o)
|
|
(test 'none file-stream-buffer-mode eo)
|
|
(test (void) display 15 eo)
|
|
(test #"1012\n13\n1415" get-output-bytes o)
|
|
|
|
(test #\a read-char ei)
|
|
(test #\b peek-char i)
|
|
(test (void) file-stream-buffer-mode ei 'block)
|
|
(test 'block file-stream-buffer-mode ei)
|
|
(test #\b read-char ei)
|
|
(test eof peek-char i)
|
|
(test #\c read-char ei)
|
|
(test eof read-char ei)))
|
|
|
|
;; --------------------------------------------------
|
|
|
|
(report-errs)
|