ikarus/lab/io-test.ss

205 lines
5.7 KiB
Scheme
Raw Normal View History

2007-12-06 05:05:26 -05:00
#!/usr/bin/env scheme-script
(import
(except (ikarus) get-char get-u8 lookahead-u8 close-port input-port?)
(io-spec))
(define-syntax test
(syntax-rules ()
[(_ name body)
(begin
(printf "running ~s ..." 'name)
body
(printf " ok\n"))]))
(define (make-n-byte-custom-binary-input-port n)
(assert (<= 0 n 256))
(make-custom-binary-input-port "test0"
(let ([c 0])
(lambda (bv i count)
(if (< c n)
(begin
(bytevector-u8-set! bv i c)
(set! c (+ c 1))
1)
0)))
#f #f #f))
(define (make-n-byte-bytevector-binary-input-port n)
(assert (<= 0 n 256))
(let ([bv (make-bytevector n)])
(let f ([i 0])
(unless (= i n)
(bytevector-u8-set! bv i i)
(f (+ i 1))))
(open-bytevector-input-port bv)))
(define (make-ascii-range-bytevector)
(let ([bv (make-bytevector 128)])
(let f ([i 0])
(unless (= i 128)
(bytevector-u8-set! bv i i)
(f (+ i 1))))
bv))
(define (make-ascii-range-bytevector+utf8-bom)
(let ([bv (make-bytevector (+ 128 3))])
(bytevector-u8-set! bv 0 #xEF)
(bytevector-u8-set! bv 1 #xBB)
(bytevector-u8-set! bv 2 #xBF)
(let f ([i 0])
(unless (= i 128)
(bytevector-u8-set! bv (+ i 3) i)
(f (+ i 1))))
bv))
2007-12-06 05:05:26 -05:00
(define (test-get-u8-1 p n)
(let f ([i 0])
(let ([x (get-u8 p)])
(cond
[(eof-object? x)
(unless (= i n)
(error 'test0 "premature termination" i))]
[(= x i) (f (+ i 1))]
[else
(error 'test0 "incorrect value returned" x)]))))
(define (test-get-char-1 p n)
(let f ([i 0])
(let ([x (get-char p)])
(cond
[(eof-object? x)
(unless (= i n)
(error 'test0 "premature termination" i))]
[(= (char->integer x) i) (f (+ i 1))]
[else
(error 'test0 "incorrect value returned" x)]))))
2007-12-06 05:05:26 -05:00
(define (test-peek-u8-1 p n)
(let f ([i 0])
(let* ([px (lookahead-u8 p)]
[x (get-u8 p)])
(cond
[(not (eqv? px x)) (error #f "peek invalid" px x)]
[(eof-object? x)
(unless (= i n)
(error #f "premature termination" i))]
[(= x i) (f (+ i 1))]
[else
(error #f "incorrect value returned" x i)]))))
(define (test-peek-char-1 p n)
(let f ([i 0])
(let* ([px (lookahead-char p)]
[x (get-char p)])
(cond
[(not (eqv? px x)) (error #f "peek invalid" px x)]
[(eof-object? x)
(unless (= i n)
(error #f "premature termination" i))]
[(= (char->integer x) i) (f (+ i 1))]
[else
(error #f "incorrect value returned" x i)]))))
(define (test-binary-port-eof?-1 p n)
2007-12-06 05:05:26 -05:00
(let f ([i 0])
(cond
[(port-eof? p)
(unless (= i n)
(error #f "premature termination" i))
(assert (eof-object? (lookahead-u8 p)))
(assert (eof-object? (get-u8 p)))]
[(= (get-u8 p) i) (f (+ i 1))]
[else
(error #f "incorrect value returned" i)])))
(define (test-textual-port-eof?-1 p n)
(let f ([i 0])
(cond
[(port-eof? p)
(unless (= i n)
(error #f "premature termination" i))
(assert (eof-object? (lookahead-char p)))
(assert (eof-object? (get-char p)))]
[(= (char->integer (get-char p)) i) (f (+ i 1))]
[else
(error #f "incorrect value returned" i)])))
2007-12-06 05:05:26 -05:00
(test "reading 256 bytes in ascending order"
(test-get-u8-1 (make-n-byte-custom-binary-input-port 256) 256))
(test "reading 256 bytes in ascending order 2 at a time"
(test-get-u8-1
(make-custom-binary-input-port "test0"
(let ([c 0])
(lambda (bv i count)
(if (< c 256)
(begin
(assert (>= count 2))
(bytevector-u8-set! bv i c)
(bytevector-u8-set! bv (+ i 1) (+ c 1))
(set! c (+ c 2))
2)
0)))
#f #f #f)
256))
(test "peeking 256 bytes in ascending order"
(test-peek-u8-1 (make-n-byte-custom-binary-input-port 256) 256))
(test "custom-binary-port port-eof?"
(test-binary-port-eof?-1 (make-n-byte-custom-binary-input-port 256) 256))
2007-12-06 05:05:26 -05:00
;;;
(test "reading 256 bytes from bytevector-input-port"
(test-get-u8-1 (make-n-byte-bytevector-binary-input-port 256) 256))
(test "peeking 256 bytes from bytevector-input-port"
(test-peek-u8-1 (make-n-byte-bytevector-binary-input-port 256) 256))
(test "bytevector-binary-port port-eof?"
(test-binary-port-eof?-1 (make-n-byte-bytevector-binary-input-port 256) 256))
;;;
(test "reading 256 latin1 chars from bytevector-input-port"
(test-get-char-1
(transcoded-port (make-n-byte-bytevector-binary-input-port 256)
(make-transcoder (latin-1-codec) 'none 'raise))
256))
(test "peeking 256 bytes from latin1 transcoded port"
(test-peek-char-1
(transcoded-port (make-n-byte-bytevector-binary-input-port 256)
(make-transcoder (latin-1-codec) 'none 'raise))
256))
(test "latin1 transcoded port port-eof?"
(test-textual-port-eof?-1
(transcoded-port (make-n-byte-bytevector-binary-input-port 256)
(make-transcoder (latin-1-codec) 'none 'raise))
256))
;;;
(test "reading 128 utf8 chars from bytevector-input-port"
(test-get-char-1
(open-bytevector-input-port (make-ascii-range-bytevector)
(make-transcoder (utf-8-codec) 'none 'raise))
128))
(test "peeking 128 chars from utf8 port"
(test-peek-char-1
(open-bytevector-input-port (make-ascii-range-bytevector)
(make-transcoder (utf-8-codec) 'none 'raise))
128))
(test "utf8 transcoded port port-eof?"
(test-textual-port-eof?-1
(open-bytevector-input-port (make-ascii-range-bytevector)
(make-transcoder (utf-8-codec) 'none 'raise))
128))
2007-12-06 05:05:26 -05:00