~ chicken-core (chicken-5) a302a6dcc92d99c36b87353d81a22525a2493a4a
commit a302a6dcc92d99c36b87353d81a22525a2493a4a
Author: Peter Bex <peter.bex@xs4all.nl>
AuthorDate: Sat Feb 16 15:07:44 2013 +0100
Commit: Jim Ursetto <zbigniewsz@gmail.com>
CommitDate: Fri May 31 16:49:45 2013 -0500
Restore row and column number tracking in read-line (partially fixes #978)
diff --git a/library.scm b/library.scm
index 77278157..16e39436 100644
--- a/library.scm
+++ b/library.scm
@@ -3575,11 +3575,16 @@ EOF
(end (if limit (fx+ pos limit) size)))
(if (fx>= pos size)
#!eof
- (receive (next line)
+ (receive (next line full-line?)
(##sys#scan-buffer-line
buf (if (fx> end size) size end) pos
(lambda (pos) (values #f pos #f) ) )
- (##sys#setislot p 4 (fx+ (##sys#slot p 4) 1)) ; lineno
+ ;; Update row & column position
+ (if full-line?
+ (begin
+ (##sys#setislot p 4 (fx+ (##sys#slot p 4) 1))
+ (##sys#setislot p 5 0))
+ (##sys#setislot p 5 (fx+ (##sys#slot p 5) (##sys#size line))))
(##sys#setislot p 10 next)
line) ) ) )
(lambda (p) ; read-buffered
@@ -3613,26 +3618,26 @@ EOF
(receive (buf offset limit) (eos-handler pos)
(if buf
(loop buf offset offset limit line)
- (values offset line))))
+ (values offset line #f))))
(let ((c (##core#inline "C_subchar" buf pos)))
(cond ((eq? c #\newline)
- (values (fx+ pos 1) (copy&append buf offset pos line)))
+ (values (fx+ pos 1) (copy&append buf offset pos line) #t))
((and (eq? c #\return) ; \r\n -> drop \r from string
(fx> limit (fx+ pos 1))
(eq? (##core#inline "C_subchar" buf (fx+ pos 1)) #\newline))
- (values (fx+ pos 2) (copy&append buf offset pos line)))
+ (values (fx+ pos 2) (copy&append buf offset pos line) #t))
((and (eq? c #\return) ; Edge case (#568): \r{read}[\n|xyz]
(fx= limit (fx+ pos 1)))
(let ((line (copy&append buf offset pos line)))
(receive (buf offset limit) (eos-handler pos)
(if buf
(if (eq? (##core#inline "C_subchar" buf offset) #\newline)
- (values (fx+ offset 1) line)
+ (values (fx+ offset 1) line #t)
;; "Restore" \r we didn't copy, loop w/ new string
(loop buf offset offset limit
(##sys#string-append line "\r")))
;; Restore \r here, too (when we reached EOF)
- (values offset (##sys#string-append line "\r"))))))
+ (values offset (##sys#string-append line "\r") #t)))))
(else (loop buf offset (fx+ pos 1) limit line)) ) ) ) ) )
(define (open-input-string string)
diff --git a/posixunix.scm b/posixunix.scm
index 43c7bfa4..d3580956 100644
--- a/posixunix.scm
+++ b/posixunix.scm
@@ -1368,13 +1368,13 @@ EOF
(if (eq? 0 buflen)
m
(loop n m start) ) ] ) ) )
- (lambda (port limit) ; read-line
+ (lambda (p limit) ; read-line
(when (fx>= bufpos buflen)
(fetch))
(if (fx>= bufpos buflen)
#!eof
(let ((limit (or limit (fx- (##sys#fudge 21) bufpos))))
- (receive (next line)
+ (receive (next line full-line?)
(##sys#scan-buffer-line
buf
(fxmin buflen (fx+ bufpos limit))
@@ -1391,7 +1391,13 @@ EOF
(fxmin buflen
(fx+ bufpos limit)))
(values #f bufpos #f)))))))
- (##sys#setislot port 4 (fx+ (##sys#slot port 4) 1))
+ ;; Update row & column position
+ (if full-line?
+ (begin
+ (##sys#setislot p 4 (fx+ (##sys#slot p 4) 1))
+ (##sys#setislot p 5 0))
+ (##sys#setislot p 5 (fx+ (##sys#slot p 5)
+ (##sys#size line))))
(set! bufpos next)
line)) ) )
(lambda (port) ; read-buffered
diff --git a/tcp.scm b/tcp.scm
index fe01b4f5..30369a6a 100644
--- a/tcp.scm
+++ b/tcp.scm
@@ -395,7 +395,7 @@ EOF
(if (fx>= bufindex buflen)
#!eof
(let ((limit (or limit (fx- (##sys#fudge 21) bufindex))))
- (receive (next line)
+ (receive (next line full-line?)
(##sys#scan-buffer-line
buf
(fxmin buflen (fx+ bufindex limit))
@@ -411,7 +411,13 @@ EOF
(fxmin buflen
(fx+ bufindex limit)))
(values #f bufindex #f))))) ) )
- (##sys#setislot p 4 (fx+ (##sys#slot p 4) 1)) ; lineno
+ ;; Update row & column position
+ (if full-line?
+ (begin
+ (##sys#setislot p 4 (fx+ (##sys#slot p 4) 1))
+ (##sys#setislot p 5 0))
+ (##sys#setislot p 5 (fx+ (##sys#slot p 5)
+ (##sys#size line))))
(set! bufindex next)
line) )) )
(lambda (p) ; read-buffered
Trap