X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=tests%2Fstream.impure.lisp;h=3540257ab1d54d3c6a8db52e5817ae70b852aac1;hb=007bcd5aac2f3a1e714563bd39f7a2db2d0bf7c2;hp=851990f688297ea68fc9379e80cfe48f01c7731c;hpb=5d5894082c39ca44da75d38859d669c7b2108f6a;p=sbcl.git

diff --git a/tests/stream.impure.lisp b/tests/stream.impure.lisp
index 851990f..3540257 100644
--- a/tests/stream.impure.lisp
+++ b/tests/stream.impure.lisp
@@ -421,16 +421,7 @@
 ;;; 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
@@ -438,9 +429,20 @@
                             :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+)
@@ -516,5 +518,64 @@
                 (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))))))
+
+;;; In 1.0.27 (and also 0.9.16; presumably in between, too), binary
+;;; input operations on a bivalent stream did something bad after
+;;; unread-char: READ-BYTE would return the character, and
+;;; READ-SEQUENCE into a byte buffer would lose when attempting to
+;;; store the character in the vector.
+(let ((pathname "bivalent-stream-unread-char-test.tmp"))
+  (with-open-file (s pathname
+                     :element-type :default
+                     :direction :io :if-exists :rename)
+    (write-char #\a s)
+    (file-position s :start)
+    (unread-char (read-char s) s)
+    (assert (integerp (read-byte s))))
+  (delete-file pathname))
+
+(let ((pathname "bivalent-stream-unread-char-test.tmp"))
+  (with-open-file (s pathname
+                     :element-type :default
+                     :direction :io :if-exists :rename)
+    (write-char #\a s)
+    (file-position s :start)
+    (unread-char (read-char s) s)
+    (assert (let ((buffer (make-array 10 :element-type '(unsigned-byte 8))))
+              (read-sequence buffer s))))
+  (delete-file pathname))
+
+#+sb-unicode
+(let ((pathname "bivalent-stream-unread-char-test.tmp"))
+  (with-open-file (s pathname
+                     :element-type :default
+                     :direction :io :if-exists :rename
+                     :external-format :utf8)
+    (write-char (code-char 192) s)
+    (file-position s :start)
+    (unread-char (read-char s) s)
+    (assert (integerp (read-byte s))))
+  (delete-file pathname))
+
+#+sb-unicode
+(let ((pathname "bivalent-stream-unread-char-test.tmp"))
+  (with-open-file (s pathname
+                     :element-type :default
+                     :direction :io :if-exists :rename
+                     :external-format :utf8)
+    (write-char (code-char 192) s)
+    (file-position s :start)
+    (unread-char (read-char s) s)
+    (assert (let ((buffer (make-array 10 :element-type '(unsigned-byte 8))))
+              (read-sequence buffer s))))
+  (delete-file pathname))
 
 ;;; success