From dd7132b72f8b9ea60b303b4aabf76f63d3788f9b Mon Sep 17 00:00:00 2001 From: rtoy <rtoy> Date: Thu, 21 Dec 2006 17:53:28 +0000 Subject: [PATCH] Fix the bug reported by Madhu on cmucl-imp, 2006/12/16: (defvar $f (open "/etc/passwd" :mapped t :class 'stream:file-simple-stream)) (file-position $f) returns a negative value. I think this happens because of some possible confusion between buffer-ptr and buf-len in a mapped file-simple-stream. I changed the code so that buffer-ptr is initialized to 0, and the various routines that check for eof compare buffpos against buf-len, instead of buffer-ptr. I think this also means buffer-ptr is not used in mapped file-simple-streams. Add a couple of file-position tests too. --- pcl/simple-streams/file.lisp | 4 ++-- pcl/simple-streams/rt/simple-streams-test.lisp | 18 +++++++++++++++++- pcl/simple-streams/strategy.lisp | 10 +++++----- 3 files changed, 24 insertions(+), 8 deletions(-) diff --git a/pcl/simple-streams/file.lisp b/pcl/simple-streams/file.lisp index 1786be4fd..6c3cdbe6c 100644 --- a/pcl/simple-streams/file.lisp +++ b/pcl/simple-streams/file.lisp @@ -5,7 +5,7 @@ ;;; domain. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/simple-streams/file.lisp,v 1.4 2003/06/26 13:27:42 toy Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/simple-streams/file.lisp,v 1.5 2006/12/21 17:53:28 rtoy Rel $") ;;; ;;; ********************************************************************** ;;; @@ -193,7 +193,7 @@ (error "Unable to map file.")) (setf (sm buffer stream) buffer (sm buffpos stream) 0 - (sm buffer-ptr stream) size + (sm buffer-ptr stream) 0 (sm buf-len stream) size) (when (any-stream-instance-flags stream :output) (setf (sm control-out stream) *std-control-out-table*)) diff --git a/pcl/simple-streams/rt/simple-streams-test.lisp b/pcl/simple-streams/rt/simple-streams-test.lisp index a1d636e7a..6684d7181 100644 --- a/pcl/simple-streams/rt/simple-streams-test.lisp +++ b/pcl/simple-streams/rt/simple-streams-test.lisp @@ -416,7 +416,7 @@ ;;; FILE-POSITION returns the wrong value. (deftest file-position-6 - ;; Test the file-position is write. + ;; Test the file-position is right. (with-open-file (st1 "/etc/passwd" :class 'stream:file-simple-stream) (with-open-file (st2 "/etc/passwd" :element-type '(unsigned-byte 8)) (let* ((buf1 (make-array 100 :element-type '(unsigned-byte 8))) @@ -428,3 +428,19 @@ (100 100 100 100) ) +;;; From Madhu, cmucl-imp, 2006-12-16 +(deftest file-position-7 + (with-open-file (st1 "/etc/passwd" :mapped t :class 'stream:file-simple-stream) + (let* ((posn1 (file-position st1)) + (line1 (read-line st1)) + (posn2 (file-position st1))) + (list posn1 (= posn2 (1+ (length line1)))))) + (0 t)) + +(deftest file-position-8 + (with-open-file (st1 "/etc/passwd" :mapped t :class 'stream:file-simple-stream) + (let* ((posn1 (file-position st1)) + (c1 (read-char st1)) + (posn2 (file-position st1))) + (list posn1 posn2))) + (0 1)) diff --git a/pcl/simple-streams/strategy.lisp b/pcl/simple-streams/strategy.lisp index 82844e9ac..8e0e2327c 100644 --- a/pcl/simple-streams/strategy.lisp +++ b/pcl/simple-streams/strategy.lisp @@ -5,7 +5,7 @@ ;;; domain. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/simple-streams/strategy.lisp,v 1.9 2004/07/11 04:34:16 rtoy Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/simple-streams/strategy.lisp,v 1.10 2006/12/21 17:53:28 rtoy Exp $") ;;; ;;; ********************************************************************** ;;; @@ -210,7 +210,7 @@ (ef (sm external-format stream)) (state (sm oc-state stream))) (flet ((input () - (when (>= buffpos (sm buffer-ptr stream)) + (when (>= buffpos (sm buf-len stream)) (return-from read-char (lisp::eof-or-lose stream eof-error-p eof-value))) (incf (sm last-char-read-size stream)) @@ -319,7 +319,7 @@ ;; if stream is single-channel and mode == 3, flush buffer (if dirty) (do ((buffer (sm buffer stream)) (buffpos (sm buffpos stream)) - (buffer-ptr (sm buffer-ptr stream)) + (buf-len (sm buf-len stream)) (lcrs 0) (ctrl (sm control-in stream)) (ef (sm external-format stream)) @@ -331,9 +331,9 @@ (sm last-char-read-size stream) lcrs (sm oc-state stream) state) (values count nil)) - (declare (type lisp::index buffpos buffer-ptr posn count)) + (declare (type lisp::index buffpos buf-len posn count)) (flet ((input () - (when (>= buffpos buffer-ptr) + (when (>= buffpos buf-len) (return (values count :eof))) (prog1 (bref buffer buffpos) (incf buffpos) -- GitLab