Fixing make-generated-input-port for non-ascii chars.

This commit is contained in:
Alex Shinn 2014-04-26 21:01:15 +09:00
parent 76a4cfa952
commit 35500df1d6
2 changed files with 33 additions and 6 deletions

View file

@ -349,9 +349,10 @@
((>= (- len offset) n) ((>= (- len offset) n)
(string-copy! str start buf offset (+ offset n)) (string-copy! str start buf offset (+ offset n))
(set! offset (+ offset n)) (set! offset (+ offset n))
n) (- (string-index->offset str end)
(string-index->offset str start)))
(else (else
(string-copy! str start buf offset (+ offset len)) (string-copy! str start buf offset len)
(let lp ((i (+ start (- len offset)))) (let lp ((i (+ start (- len offset))))
(set! buf (generator)) (set! buf (generator))
(cond (cond
@ -359,15 +360,17 @@
(set! buf "") (set! buf "")
(set! len 0) (set! len 0)
(set! offset 0) (set! offset 0)
(- i start)) (- (string-index->offset str i)
(string-index->offset str start)))
(else (else
(set! len (string-length buf)) (set! len (string-length buf))
(set! offset 0) (set! offset 0)
(cond (cond
((>= (- len offset) (- n i)) ((>= (- len offset) (- n i))
(string-copy! str i buf offset (+ offset (- n i))) (string-copy! str i buf 0 (- n i))
(set! offset (+ offset (- n i))) (set! offset (- n i))
n) (- (string-index->offset str end)
(string-index->offset str start)))
(else (else
(string-copy! str i buf offset len) (string-copy! str i buf offset len)
(lp (+ i (- len offset))))))))))))))) (lp (+ i (- len offset)))))))))))))))

View file

@ -89,6 +89,30 @@
(display "abc" out) (display "abc" out)
(close-output-port out))))) (close-output-port out)))))
(define (strings->input-port str-ls)
(make-generated-input-port
(lambda ()
(and (pair? str-ls)
(let ((res (car str-ls)))
(set! str-ls (cdr str-ls))
res)))))
(test "abcdef" (read-line (strings->input-port '("abcdef"))))
(test "abcdef" (read-line (strings->input-port '("abc" "def"))))
(test "abcdef" (read-line (strings->input-port '("a" "b" "c" "d" "e" "f"))))
(test "日本語" (read-line (strings->input-port '("日本語"))))
(test "日本語" (read-line (strings->input-port '("日" "本" "語"))))
(test "abc"
(let ((in (strings->input-port
(list "日本語" (make-string 4087 #\-) "abc"))))
(read-string 4090 in)
(read-line in)))
(test "abc"
(let ((in (strings->input-port
(list "日本語" (make-string 4093 #\-) "abc"))))
(read-string 4096 in)
(read-line in)))
(let ((in (make-custom-binary-input-port (let ((in (make-custom-binary-input-port
(let ((i 0)) (let ((i 0))
(lambda (bv start end) (lambda (bv start end)