Adding tests and bugfixes for read-string[!].

This commit is contained in:
Alex Shinn 2012-10-13 21:54:30 +09:00
parent 23d3d6dce7
commit fc1a1bd393
2 changed files with 34 additions and 9 deletions

View file

@ -99,10 +99,10 @@
((not string-streams)
(define (%read-string n in)
(let ((out (open-output-string)))
(do ((i 0 (+ i 1))
(ch (read-char in) (read-char in)))
((or (= i n) (eof-object? ch)) (list i (get-output-string out)))
(write-char ch out))))))
(let lp ((i 0))
(cond ((or (= i n) (eof-object? (peek-char in)))
(list i (get-output-string out)))
(else (write-char (read-char in) out) (lp (+ i 1)))))))))
(define (read-string n . o)
(if (zero? n)
@ -129,13 +129,12 @@
(cond-expand
((not string-streams)
(define (%read-string! str n in)
(do ((i 0 (+ i 1))
(ch (read-char in) (read-char in)))
((or (= i n) (eof-object? ch)) i)
(string-set! str i ch)))))
(let lp ((i 0))
(cond ((or (= i n) (eof-object? (peek-char in))) i)
(else (string-set! str i (read-char in)) (lp (+ i 1))))))))
(define (read-string! str n . o)
(if (>= n (string-length str))
(if (> n (string-length str))
(error "string to small to read chars" str n))
(let* ((in (if (pair? o) (car o) (current-input-port)))
(res (%read-string! str n in)))

View file

@ -23,6 +23,32 @@
(call-with-input-string "abc\ndef"
(lambda (in) (let ((line (read-line in))) (list line (read-line in))))))
(test "read-string" '("abc" "def")
(call-with-input-string "abcdef"
(lambda (in) (let ((str (read-string 3 in))) (list str (read-string 3 in))))))
(test "read-string-to-eof" '("abc" "de")
(call-with-input-string "abcde"
(lambda (in) (let ((str (read-string 3 in))) (list str (read-string 3 in))))))
(test "read-string!" '("abc" "def")
(call-with-input-string "abcdef"
(lambda (in)
(let* ((str1 (make-string 3))
(str2 (make-string 3)))
(read-string! str1 3 in)
(read-string! str2 3 in)
(list str1 str2)))))
(test "read-string!-to-eof" '("abc" "de ")
(call-with-input-string "abcde"
(lambda (in)
(let* ((str1 (make-string 3))
(str2 (make-string 3 #\space)))
(read-string! str1 3 in)
(read-string! str2 3 in)
(list str1 str2)))))
(test "null-output-port" #t
(let ((out (make-null-output-port)))
(write 1 out)