0.8.15.2:

	Fix for (signed-byte N) read/write consistency (reported by
	Bruno Haible cmucl-imp 2004-09-06)

diff --git a/NEWS b/NEWS
index 341c3cc..3c9c848 100644 (file)
--- a/NEWS
+++ b/NEWS
@@ -1,4 +1,6 @@
 changes in sbcl-0.8.16 relative to sbcl-0.8.15:
+  * bug fix: read-write consistency on streams of element-type
+    (SIGNED-BYTE N) for N > 32.  (reported by Bruno Haible for CMUCL)
   * fixed some bugs revealed by Paul Dietz' test suite:
     ** POSITION on displaced vectors with non-zero displacement
        returns the right answer.

diff --git a/src/code/fd-stream.lisp b/src/code/fd-stream.lisp
index d8a2d57..122c3a4 100644 (file)
--- a/src/code/fd-stream.lisp
+++ b/src/code/fd-stream.lisp
@@ -671,7 +671,9 @@
                          do (setf result
                                   (+ (* 256 result)
                                      (sap-ref-8 sap (+ head j))))
-                         finally (return (dpb result (byte i 0) -1))))))
+                         finally (return (if (logbitp result (1- i))
+                                              (dpb result (byte i 0) -1)
+                                              result))))))
              `(signed-byte ,i)
              (/ i 8)))))
 

diff --git a/tests/stream.impure.lisp b/tests/stream.impure.lisp
index 598c55a..f133a35 100644 (file)
--- a/tests/stream.impure.lisp
+++ b/tests/stream.impure.lisp
@@ -149,5 +149,34 @@
       (when (probe-file test)
        (delete-file test)))))
 
+;;; test for read-write invariance of signed bytes, from Bruno Haible
+;;; cmucl-imp 2004-09-06
+(defun bin-stream-test (&key (size (integer-length most-positive-fixnum))
+                        (type 'unsigned-byte) (file-name "stream-impure.tmp")
+                        (num-bytes 10)
+                        (bytes (if (eq type 'signed-byte)
+                                   (loop :repeat num-bytes :collect
+                                         (- (random (ash 1 size))
+                                            (ash 1 (1- size))))
+                                   (loop :repeat num-bytes :collect
+                                         (random (ash 1 size))))))
+  (with-open-file (foo file-name :direction :output :if-exists :supersede
+                       :element-type (list type size))
+    (dolist (byte bytes)
+      (write-byte byte foo)))
+  (unwind-protect
+       (with-open-file (foo file-name :direction :input
+                            :element-type (list type size))
+         (list (stream-element-type foo) (file-length foo) bytes
+               (loop :for byte :in bytes :for nb = (read-byte foo) :collect nb
+                     :unless (= nb byte) :do
+                     (flet ((by-out (sz by)
+                              (format nil "~v,'0,' ,4:b"
+                                      (+ sz (floor sz 4)) by)))
+                       (error "~& * [(~s ~s)] ~a != ~a~%" type size
+                              (by-out size byte) (by-out size nb))))))
+    (delete-file file-name)))
+(loop for size from 2 to 40 do (bin-stream-test :size size :type 'signed-byte))
+
 ;;; success
 (quit :unix-status 104)

diff --git a/version.lisp-expr b/version.lisp-expr
index e36358c..187ee53 100644 (file)
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -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".)
-"0.8.15.1"
+"0.8.15.2"