1.0.23.51: wrong return value from READ-SEQUENCE :START on file streams
authorNikodemus Siivola <nikodemus@random-state.net>
Thu, 18 Dec 2008 10:48:21 +0000 (10:48 +0000)
committerNikodemus Siivola <nikodemus@random-state.net>
Thu, 18 Dec 2008 10:48:21 +0000 (10:48 +0000)
 * Regression since 1.0.12.22.

 * Reported by Daniel Herring, patch by Paul Huong.

 * Also tweak the "write a line with bignum characters test" to run a bit faster.

NEWS
src/code/stream.lisp
tests/stream.impure.lisp
version.lisp-expr

diff --git a/NEWS b/NEWS
index 5574f03..e826d51 100644 (file)
--- a/NEWS
+++ b/NEWS
@@ -32,6 +32,9 @@
     to #xffff0000 bytes. (reported by Benjamin Lambert)
   * bug fix: setting *READ-SUPPRESS* to T no longer renders the default
     REPL unusable. (reported by Daniel Herring)
+  * bug fix: return values of READ-SEQUENCE did not take :START into
+    account on file streams, regressions since 1.0.12.22. (reported by
+    Daniel Herring, patch by Paul Huong)
 
 changes in sbcl-1.0.23 relative to 1.0.22:
   * enhancement: when disassembling method functions, disassembly
index bd7086c..19b3f8e 100644 (file)
@@ -2021,14 +2021,14 @@ benefit of the function GET-OUTPUT-STREAM-STRING.")
                              (refill-buffer))
                      (done-with-fast-read-char)
                      (return-from ansi-stream-read-string-from-frc-buffer
-                       read)))))
+                       (+ start read))))))
         (declare (inline refill-buffer))
         (when (and (= %frc-index% +ansi-stream-in-buffer-length+)
                    (refill-buffer))
           ;; EOF had been reached before we read anything
           ;; at all. Return the EOF value or signal the error.
           (done-with-fast-read-char)
-          (return-from ansi-stream-read-string-from-frc-buffer 0))
+          (return-from ansi-stream-read-string-from-frc-buffer start))
         (loop (add-chunk))))))
 
 \f
index 851990f..f39e3c0 100644 (file)
 ;;; writing looong lines. takes way too long and way too much space
 ;;; to test on 64 bit platforms
 #-#.(cl:if (cl:= sb-vm:n-word-bits 64) '(and) '(or))
-(progn
-  (defun write-n-chars (n stream)
-    (format t "~&/writing ~D chars on a single line~%" n)
-    (finish-output t)
-    (loop repeat n
-       do (write-char #\x stream))
-    (terpri stream)
-    n)
-
-  (let ((test "long-lines-write-test.tmp"))
+(let ((test "long-lines-write-test.tmp"))
     (unwind-protect
          (with-open-file (f test
                             :direction :output
                             :element-type 'character
                             :if-does-not-exist :create
                             :if-exists :supersede)
-         (write-n-chars (+ most-positive-fixnum 7) f))
+           (let* ((n (truncate most-positive-fixnum 16))
+                  (m 18)
+                  (p (* n m))
+                  (buffer (make-string n)))
+             (dotimes (i m)
+               (write-char #\.)
+               (finish-output)
+               (write-sequence buffer f))
+             (assert (= p (sb-impl::fd-stream-char-pos f)))
+             (write-char #\! f)
+             (assert (= (+ 1 p) (sb-impl::fd-stream-char-pos f)))
+             (assert (typep p 'bignum))))
       (when (probe-file test)
-        (delete-file test)))))
+        (delete-file test))))
 
 ;;; read-sequence misreported the amount read and lost position
 (let ((string (make-array (* 3 sb-impl::+ansi-stream-in-buffer-length+)
                 (handler-case
                     (read-line f)
                   (sb-int:closed-stream-error () :faa))))))
+
+(with-test (:name :regression-1.0.12.22)
+  (with-open-file (s "stream.impure.lisp" :direction :input)
+    (let ((buffer (make-string 20)))
+      (assert (= 2 (read-sequence buffer s :start 0 :end 2)))
+      (assert (= 3 (read-sequence buffer s :start 2 :end 3)))
+      (file-position s :end)
+      (assert (= 3 (read-sequence buffer s :start 3))))))
 \f
 ;;; success
index c58198d..f6ebf01 100644 (file)
@@ -17,4 +17,4 @@
 ;;; checkins which aren't released. (And occasionally for internal
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"1.0.23.50"
+"1.0.23.51"