0.8.6.13:

	Merge fix for bidirectional (that is IO, not anything Unicodely)
	streams (Adam Warner/Gerd Moellmann sbcl-devel/cmucl-imp 2003-11-xx)
	... added a test for it; be careful with that standard io syntax :)

NEWS

@@ -2199,6 +2199,9 @@ changes in sbcl-0.8.7 relative to sbcl-0.8.6:
   * bug fix: GET-SETF-EXPANSION no longer throws an internal type
     error when called without an explicit environment argument.
     (thanks to Nikodemus Siivola)
+  * bug fix: buffered :DIRECTION :IO streams are less likely to become
+    confused about their position.  (thanks to Adam Warner and Gerd 
+    Moellmann)
 
 planned incompatible changes in 0.8.x:
   * (not done yet, but planned:) When the profiling interface settles

clean.sh

@@ -23,7 +23,7 @@ rm -rf obj/* output/* doc/user-manual \
 # standard clean.sh file.)
 
 # Ensure we know GNUMAKE
-. find-gnumake.sh
+. ./find-gnumake.sh
 find_gnumake
 
 # Ask some other directories to clean themselves up.

src/code/fd-stream.lisp

@@ -214,6 +214,11 @@
 				  (+ (fd-stream-obuf-tail stream)
 				     ,size))
 			   (flush-output-buffer stream)))
+		     ,(unless (eq (car buffering) :none)
+			`(when (> (fd-stream-ibuf-tail stream)
+				  (fd-stream-ibuf-head stream))
+			   (file-position stream (file-position stream))))
+
 		     ,@body
 		     (incf (fd-stream-obuf-tail stream) ,size)
 		     ,(ecase (car buffering)
@@ -305,6 +310,9 @@
   (let ((start (or start 0))
 	(end (or end (length (the (simple-array * (*)) thing)))))
     (declare (type index start end))
+    (when (> (fd-stream-ibuf-tail fd-stream)
+	     (fd-stream-ibuf-head fd-stream))
+      (file-position fd-stream (file-position fd-stream)))
     (let* ((len (fd-stream-obuf-length fd-stream))
 	   (tail (fd-stream-obuf-tail fd-stream))
 	   (space (- len tail))

tests/stream.impure.lisp

@@ -81,5 +81,17 @@
 (assert (raises-error? (with-open-file (s "/dev/zero")
 			 (read-byte s))
 		       type-error))
+;;; bidirectional streams getting confused about their position
+(let ((p "bidirectional-stream-test"))
+  (with-open-file (s p :direction :output :if-exists :supersede)
+    (with-standard-io-syntax
+      (format s "~S ~S ~S~%" 'these 'are 'symbols)))
+  (with-open-file (s p :direction :io :if-exists :overwrite)
+    (read s)
+    (with-standard-io-syntax
+      (prin1 'insert s)))
+  (with-open-file (s p)
+    (assert (string= (read-line s) "THESE INSERTMBOLS")))
+  (delete-file p))
 ;;; success
 (quit :unix-status 104)

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.6.12"
+"0.8.6.13"