HIRAUCHI Hideyuki
hira****@verys*****
2004年 2月 17日 (火) 23:58:40 JST
平内です。
改行が'\r'(MAC)のときのread-charでもエラーが出たので報告します。
以下、テストプログラム。
#テスト結果は省略します(環境に依存しない && 124行あるので)。
--hira
(use gauche.test)
(define (port-current-line-tester-read test-case-list)
(define (test3eol test-case)
(let ((name (car test-case))
(reader (cadr test-case))
(expects (caddr test-case)))
(define (test4pattern eol)
(let ((eol-name (car eol))
(eol-str (cadr eol))
(file (car expects))
(file/seek (cadr expects))
(str (caddr expects))
(str/seek (cadddr expects)))
(define (write3line port)
(for-each
(lambda (i) (format port "~a ~a~a" i name eol-str))
'("1" "2" "3")))
(define src (call-with-output-string write3line))
(define (tester t)
(let ((port-name (car t))
(expect (cadr t))
(port (caddr t))
(seek? (cadddr t)))
(test* (format #f "port-current-line (~11a:~a ~a)"
port-name name eol-name)
expect
(do () ((eof-object? (reader port))
(if seek? (port-seek port 0 SEEK_SET))
(port-current-line port))))))
(print src)
(call-with-output-file "tmp1.o" write3line)
(call-with-output-file "tmp2.o" write3line)
(call-with-input-file "tmp1.o"
(lambda (tmp1)
(call-with-input-file "tmp2.o"
(lambda (tmp2)
(for-each
tester
`(("file" ,file ,tmp1 #f)
("file/seek" ,file/seek ,tmp2 #t)
("string" ,str ,(open-input-string src) #f)
("string/seek" ,str/seek ,(open-input-string src) #t)))))))))
(for-each test4pattern '(("CR" "\r") ("CRLF" "\r\n") ("LF" "\n")))))
(for-each test3eol test-case-list))
(let ((my-read-block (lambda (p) (read-block 1 p))))
(port-current-line-tester-read
;test-case: `(name ,reader (file file/seek str str/seek))
`(("read" ,read ( 4 -1 -1 -1))
("read/ss" ,read/ss ( 4 -1 -1 -1))
("read-char" ,read-char ( 4 -1 -1 -1))
("read-line" ,read-line ( 4 -1 -1 -1))
("read-byte" ,read-byte (-1 -1 -1 -1))
("read-block" ,my-read-block (-1 -1 -1 -1)))))
(define (port-current-line-tester-write test-case-list)
(define (test3eol test-case)
(let ((name (car test-case))
(writer (cadr test-case))
(expects (caddr test-case)))
(define (test4pattern eol)
(let ((eol-name (car eol))
(eol-str (cadr eol))
(file (car expects))
(file/seek (cadr expects))
(str (caddr expects))
(str/seek (cadddr expects)))
(define (tester t)
(let ((port-name (car t))
(expect (cadr t))
(port (caddr t))
(seek? (cadddr t)))
(for-each
(lambda (i)
(writer (format #f "~a ~a~a" i name eol-str) port))
'("1" "2" "3"))
(if seek? (port-seek port 0 SEEK_SET))
(test* (format #f "port-current-line (~11a:~a ~a)"
port-name name eol-name)
expect
(port-current-line port))))
(call-with-output-file "tmp1.o"
(lambda (tmp1)
(call-with-output-file "tmp2.o"
(lambda (tmp2)
(for-each
tester
`(("file" ,file ,tmp1 #f)
("file/seek" ,file/seek ,tmp2 #t)
("string" ,str ,(open-output-string) #f)
("string/seek" ,str/seek ,(open-output-string) #t)))))))))
(for-each
test4pattern
(if (equal? name "newline")
'(("" "ignore"))
'(("CR" "\r") ("CRLF" "\r\n") ("LF" "\n"))))))
(for-each test3eol test-case-list))
(let ((my-write-char (lambda (s p)
(for-each
(lambda (c) (write-char c p))
(string->list s))))
(my-write-byte (lambda (s p)
(for-each
(lambda (c) (write-byte (char->integer c) p))
(string->list s))))
(my-format (lambda (s p) (format p "~a" s)))
(my-newline (lambda (s p) (newline p)))
)
(port-current-line-tester-write
;test-case: `(name ,writer (file file/seek str str/seek))
`(("write-char" ,my-write-char ( 4 -1 -1 -1))
("write-byte" ,my-write-byte ( 4 -1 -1 -1))
("display" ,display ( 4 -1 -1 -1))
("format" ,my-format ( 4 -1 -1 -1))
("newline" ,my-newline ( 4 -1 -1 -1)))))