HIRAUCHI Hideyuki
hira****@verys*****
2004年 2月 20日 (金) 00:19:39 JST
> 理屈の上では、CRをshift stateとして扱って、次にLF以外が来たら
> \nとその文字を返すということになるでしょうね (「フラグを立てる」のと
> 同様)。ただ、当面はブロックの可能性に目をつむって一文字先読み
> するんでもいいかなと思います。
了解です。それでやってみます。
ふむふむ。まずはScm_Peekcから手を入れることになるんだな、
と思ってpeekのテストを追加していたら、もう寝る時間だ。
今日はテストケースを強化しただけで終わってしまった。。。
#やっぱ地下に降りて泥まみれになるより、地上で遊んでる方が楽しいな〜。
#だんだん四角くなってきて良い感じだし。次はマクロ使ってみよ。
--hira
(use gauche.test)
(define (port-current-line-tester-read name reader file file/seek str str/seek)
(define (test4pattern eol-name eol-str)
(define (write3line port)
(for-each
(lambda (i) (format port "~a ~a~a" i name eol-str))
'("1" "2" "3")))
(define (tester proc)
(lambda (port-name expect port)
(test* (format #f "port-current-line (~11a:~a ~a)"
port-name name eol-name)
expect (proc port))))
(define norm-tester (tester (lambda (port)
(do () ((eof-object? (reader port))
(port-current-line port))))))
(define seek-tester (tester (lambda (port)
(do () ((eof-object? (reader port))
(port-seek port 0 SEEK_SET)
(port-current-line port))))))
(define (make-peek-tester peeker)
(tester (lambda (port)
(let loop ()
(cond ((eof-object? (reader port)) #t)
((not (= (port-current-line port)
(begin (peeker port)
(port-current-line port)))) #f)
(else (loop)))))))
(define peek-char-tester (make-peek-tester peek-char))
(define peek-byte-tester (make-peek-tester peek-byte))
(define src (call-with-output-string write3line))
(define (call/tmp1 proc) (call-with-input-file "tmp1.o" (lambda (p) (proc p))))
(define (call/strp proc) (proc (open-input-string src)))
(call-with-output-file "tmp1.o" write3line)
(call/tmp1 (lambda (p) (norm-tester "file" file p)))
(call/tmp1 (lambda (p) (seek-tester "file/seek" file/seek p)))
(call/tmp1 (lambda (p) (peek-char-tester "file/peek-char" #t p)))
(call/tmp1 (lambda (p) (peek-byte-tester "file/peek-byte" #t p)))
(call/strp (lambda (p) (norm-tester "string" str p)))
(call/strp (lambda (p) (seek-tester "string/seek" str/seek p)))
(call/strp (lambda (p) (peek-char-tester "string/peek-char" #t p)))
(call/strp (lambda (p) (peek-byte-tester "string/peek-byte" #t p))))
(test4pattern "CR" "\r")
(test4pattern "CRLF" "\r\n")
(test4pattern "LF" "\n"))
(let1 my-read-block (lambda (p) (read-block 1 p))
(port-current-line-tester-read "read" read 4 -1 -1 -1)
(port-current-line-tester-read "read/ss" read/ss 4 -1 -1 -1)
(port-current-line-tester-read "read-char" read-char 4 -1 -1 -1)
(port-current-line-tester-read "read-line" read-line 4 -1 -1 -1)
(port-current-line-tester-read "read-byte" read-byte -1 -1 -1 -1)
(port-current-line-tester-read "read-block" my-read-block -1 -1 -1 -1))
(define (port-current-line-tester-write name writer file file/seek str str/seek)
(define (test4pattern eol-name eol-str)
(define (tester port-name expect port seek?)
(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)))
(define (call/tmp1 proc) (call-with-output-file "tmp1.o" (lambda (p) (proc p))))
(define (call/strp proc) (proc (open-output-string)))
(call/tmp1 (lambda (p) (tester "file" file p #f)))
(call/tmp1 (lambda (p) (tester "file/seek" file/seek p #t)))
(call/strp (lambda (p) (tester "string" str p #f)))
(call/strp (lambda (p) (tester "string/seek" str/seek p #t))))
(if (equal? name "newline")
(test4pattern "" "ignore")
(begin
(test4pattern "CR" "\r")
(test4pattern "CRLF" "\r\n")
(test4pattern "LF" "\n"))))
(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 "write-char" my-write-char 4 -1 -1 -1)
(port-current-line-tester-write "write-byte" my-write-byte 4 -1 -1 -1)
(port-current-line-tester-write "display" display 4 -1 -1 -1)
(port-current-line-tester-write "format" my-format 4 -1 -1 -1)
(port-current-line-tester-write "newline" my-newline 4 -1 -1 -1))