conservatory
/
ikarus
4
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

Added IO tests.

This commit is contained in:
Abdulaziz Ghuloum 2007-12-10 10:42:43 -05:00
parent 8a375a3cf7
commit 3575b0c8d8
3 changed files with 1772 additions and 139 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
scheme/run-tests.ss
View File

@ -32,6 +32,7 @@
(tests input-ports) (tests input-ports)
(tests fldiv-and-mod) (tests fldiv-and-mod)
(tests parse-flonums) (tests parse-flonums)
(tests io)
) )
(define (test-exact-integer-sqrt) (define (test-exact-integer-sqrt)
@ -69,4 +70,5 @@
(test-fxdiv0-and-mod0) (test-fxdiv0-and-mod0)
(test-fxlength) (test-fxlength)
(test-bitwise-bit-count) (test-bitwise-bit-count)
(test-io)
(printf "Happy Happy Joy Joy\n") (printf "Happy Happy Joy Joy\n")

1640
scheme/tests/SRFI-1.ss Normal file
View File

File diff suppressed because it is too large Load Diff

269
lab/io-test.ss → scheme/tests/io.ss
View File

@ -1,21 +1,8 @@
#!/usr/bin/env scheme-script
(import (library (tests io)
(export test-io)
(import (ikarus))
(except (ikarus) get-char peek-char read-char
get-u8 lookahead-u8 close-port
input-port? open-string-input-port output-port?
standard-input-port current-input-port
get-bytevector-n get-bytevector-n!
get-string-n get-string-n! get-line port?
close-input-port close-output-port flush-output-port
open-input-file call-with-input-file with-input-from-file
put-char put-u8 open-bytevector-output-port
call-with-bytevector-output-port open-string-output-port
write-char current-output-port current-error-port
standard-output-port standard-error-port put-string)
(io-spec))
(define-syntax test (define-syntax test
(syntax-rules () (syntax-rules ()
@ -139,80 +126,81 @@
[else [else
(error #f "incorrect value returned" i)]))) (error #f "incorrect value returned" i)])))
(test "reading 256 bytes in ascending order" (define (test-custom-binary-input-ports)
(test-get-u8-1 (make-n-byte-custom-binary-input-port 256) 256)) (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 (test "reading 256 bytes in ascending order 2 at a time"
(make-custom-binary-input-port "test0" (test-get-u8-1
(let ([c 0]) (make-custom-binary-input-port "test0"
(lambda (bv i count) (let ([c 0])
(if (< c 256) (lambda (bv i count)
(begin (if (< c 256)
(assert (>= count 2)) (begin
(bytevector-u8-set! bv i c) (assert (>= count 2))
(bytevector-u8-set! bv (+ i 1) (+ c 1)) (bytevector-u8-set! bv i c)
(set! c (+ c 2)) (bytevector-u8-set! bv (+ i 1) (+ c 1))
2) (set! c (+ c 2))
0))) 2)
#f #f #f) 0)))
256)) #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 "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)) (test "custom-binary-port port-eof?"
(test-binary-port-eof?-1 (make-n-byte-custom-binary-input-port 256) 256))
;;;
(test "reading 256 bytes from bytevector-input-port" ;;;
(test-get-u8-1 (make-n-byte-bytevector-binary-input-port 256) 256)) (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 "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 "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 (test "reading 256 latin1 chars from bytevector-input-port"
(transcoded-port (make-n-byte-bytevector-binary-input-port 256) (test-get-char-1
(make-transcoder (latin-1-codec) 'none 'raise)) (transcoded-port (make-n-byte-bytevector-binary-input-port 256)
256)) (make-transcoder (latin-1-codec) 'none 'raise))
256))
(test "peeking 256 bytes from latin1 transcoded port"
(test-peek-char-1 (test "peeking 256 bytes from latin1 transcoded port"
(transcoded-port (make-n-byte-bytevector-binary-input-port 256) (test-peek-char-1
(make-transcoder (latin-1-codec) 'none 'raise)) (transcoded-port (make-n-byte-bytevector-binary-input-port 256)
256)) (make-transcoder (latin-1-codec) 'none 'raise))
256))
(test "latin1 transcoded port port-eof?"
(test-textual-port-eof?-1 (test "latin1 transcoded port port-eof?"
(transcoded-port (make-n-byte-bytevector-binary-input-port 256) (test-textual-port-eof?-1
(make-transcoder (latin-1-codec) 'none 'raise)) (transcoded-port (make-n-byte-bytevector-binary-input-port 256)
256)) (make-transcoder (latin-1-codec) 'none 'raise))
256))
;;;
;;;
(test "reading 128 utf8 chars from bytevector-input-port"
(test-get-char-1 (test "reading 128 utf8 chars from bytevector-input-port"
(open-bytevector-input-port (make-ascii-range-bytevector) (test-get-char-1
(make-transcoder (utf-8-codec) 'none 'raise)) (open-bytevector-input-port (make-ascii-range-bytevector)
128)) (make-transcoder (utf-8-codec) 'none 'raise))
128))
(test "peeking 128 chars from utf8 port"
(test-peek-char-1 (test "peeking 128 chars from utf8 port"
(open-bytevector-input-port (make-ascii-range-bytevector) (test-peek-char-1
(make-transcoder (utf-8-codec) 'none 'raise)) (open-bytevector-input-port (make-ascii-range-bytevector)
128)) (make-transcoder (utf-8-codec) 'none 'raise))
128))
(test "utf8 transcoded port port-eof?"
(test-textual-port-eof?-1 (test "utf8 transcoded port port-eof?"
(open-bytevector-input-port (make-ascii-range-bytevector) (test-textual-port-eof?-1
(make-transcoder (utf-8-codec) 'none 'raise)) (open-bytevector-input-port (make-ascii-range-bytevector)
128)) (make-transcoder (utf-8-codec) 'none 'raise))
128)))
(define (make-utf8-bytevector-range2) (define (make-utf8-bytevector-range2)
(u8-list->bytevector (u8-list->bytevector
@ -405,7 +393,6 @@
i i
(f (+ i 1)))))))) (f (+ i 1))))))))
(assert (= (file-size "SRFI-1.ss") 56573))
(define (file->bytevector filename) (define (file->bytevector filename)
(let ([p (open-file-input-port filename (file-options) 'block #f)]) (let ([p (open-file-input-port filename (file-options) 'block #f)])
@ -428,54 +415,58 @@
(put-char p (integer->char (bytevector-u8-ref bv i))) (put-char p (integer->char (bytevector-u8-ref bv i)))
(f (fx+ i 1))))) (f (fx+ i 1)))))
(let ([bv (file->bytevector "SRFI-1.ss")]) (define (test-input-files)
(let-values ([(p extract) (open-bytevector-output-port #f)]) (assert (= (file-size "tests/SRFI-1.ss") 56573))
(bytevector->binary-port bv p) (let ([bv (file->bytevector "tests/SRFI-1.ss")])
(let ([bv2 (extract)]) (let-values ([(p extract) (open-bytevector-output-port #f)])
(assert (bytevector=? bv bv2)) (bytevector->binary-port bv p)
(assert (bytevector=? #vu8() (extract)))))) (let ([bv2 (extract)])
(assert (bytevector=? bv bv2))
(assert (bytevector=? #vu8() (extract))))))
(let ([bv (file->bytevector "tests/SRFI-1.ss")])
(let-values ([(p extract) (open-bytevector-output-port
(native-transcoder))])
(bytevector->textual-port bv p)
(let ([bv2 (extract)])
(assert (bytevector=? bv bv2))
(assert (bytevector=? #vu8() (extract))))))
(let ([bv (file->bytevector "tests/SRFI-1.ss")])
(let-values ([(p extract) (open-bytevector-output-port
(make-transcoder (latin-1-codec)))])
(bytevector->textual-port bv p)
(let ([bv2 (extract)])
(assert (bytevector=? bv bv2))
(assert (bytevector=? #vu8() (extract))))))
(let ([bv (file->bytevector "tests/SRFI-1.ss")])
(let-values ([(p extract) (open-string-output-port)])
(bytevector->textual-port bv p)
(let ([str (extract)])
(assert (bytevector=? bv (string->utf8 str)))
(assert (string=? "" (extract))))))
(let ([p (standard-output-port)])
(bytevector->binary-port
(string->utf8 "HELLO THERE\n")
p)
(flush-output-port p))
(let ([p (current-output-port)])
(bytevector->textual-port
(string->utf8 "HELLO THERE\n")
p)
(flush-output-port p))
(let ([p (current-output-port)])
(put-string p "HELLO THERE\n")
(flush-output-port p)))
(let ([bv (file->bytevector "SRFI-1.ss")]) (define (test-io)
(let-values ([(p extract) (open-bytevector-output-port (test-custom-binary-input-ports)
(native-transcoder))]) (run-exhaustive-tests)
(bytevector->textual-port bv p) (test-input-files))
(let ([bv2 (extract)]) )
(assert (bytevector=? bv bv2))
(assert (bytevector=? #vu8() (extract))))))
(let ([bv (file->bytevector "SRFI-1.ss")])
(let-values ([(p extract) (open-bytevector-output-port
(make-transcoder (latin-1-codec)))])
(bytevector->textual-port bv p)
(let ([bv2 (extract)])
(assert (bytevector=? bv bv2))
(assert (bytevector=? #vu8() (extract))))))
(let ([bv (file->bytevector "SRFI-1.ss")])
(let-values ([(p extract) (open-string-output-port)])
(bytevector->textual-port bv p)
(let ([str (extract)])
(assert (bytevector=? bv (string->utf8 str)))
(assert (string=? "" (extract))))))
(let ([p (standard-output-port)])
(bytevector->binary-port
(string->utf8 "HELLO THERE\n")
p)
(flush-output-port p))
(let ([p (current-output-port)])
(bytevector->textual-port
(string->utf8 "HELLO THERE\n")
p)
(flush-output-port p))
(let ([p (current-output-port)])
(put-string p "HELLO THERE\n")
(flush-output-port p))
(open-file-output-port "bar" (file-options no-truncate))
;(run-exhaustive-tests)
;(run-interactive-tests) ;(run-interactive-tests)