X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=tests%2Fstream.impure.lisp;h=fdc294bf89d9b0dca7d5eeb4832a38d73b65600a;hb=4a4da2875171c4802af72defcb71d720e8fa8093;hp=598c55ab5cad690e05224f5f6c396fc6924a4a8a;hpb=96a1badea2523bf188f7ba023e2f69a6785847d6;p=sbcl.git

diff --git a/tests/stream.impure.lisp b/tests/stream.impure.lisp
index 598c55a..fdc294b 100644
--- a/tests/stream.impure.lisp
+++ b/tests/stream.impure.lisp
@@ -141,6 +141,7 @@
 	   (with-open-file (f test :direction :output)
 	     (write-line "test" f))
 	   (test-mode :append)
+	   (test-mode :overwrite)
 	   ;; FIXME: We really should recover supersede files as well, according to
 	   ;; CLOSE in CLHS, but at the moment we don't.
 	   ;; (test-mode :supersede)
@@ -149,5 +150,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)