From eadbbfbdfa228593bbc0841f38a44b5d8985a2fe Mon Sep 17 00:00:00 2001 From: Christophe Rhodes Date: Thu, 30 Sep 2004 13:59:03 +0000 Subject: [PATCH] 0.8.15.2: Fix for (signed-byte N) read/write consistency (reported by Bruno Haible cmucl-imp 2004-09-06) --- NEWS | 2 ++ src/code/fd-stream.lisp | 4 +++- tests/stream.impure.lisp | 29 +++++++++++++++++++++++++++++ version.lisp-expr | 2 +- 4 files changed, 35 insertions(+), 2 deletions(-) diff --git a/NEWS b/NEWS index 341c3cc..3c9c848 100644 --- 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 --- 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 --- 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 --- 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" -- 1.7.10.4