From b095510bb0f8a15bba529f31075998ce7fa883f6 Mon Sep 17 00:00:00 2001 From: Christophe Rhodes Date: Sat, 29 Nov 2003 11:25:31 +0000 Subject: [PATCH] 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 | 3 +++ clean.sh | 2 +- src/code/fd-stream.lisp | 8 ++++++++ tests/stream.impure.lisp | 12 ++++++++++++ version.lisp-expr | 2 +- 5 files changed, 25 insertions(+), 2 deletions(-) diff --git a/NEWS b/NEWS index 3568e39..49e3136 100644 --- a/NEWS +++ b/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 diff --git a/clean.sh b/clean.sh index 4b84302..92d8144 100755 --- a/clean.sh +++ b/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. diff --git a/src/code/fd-stream.lisp b/src/code/fd-stream.lisp index b403ffa..2fbafbf 100644 --- a/src/code/fd-stream.lisp +++ b/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)) diff --git a/tests/stream.impure.lisp b/tests/stream.impure.lisp index 099c305..71a7a8c 100644 --- a/tests/stream.impure.lisp +++ b/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) diff --git a/version.lisp-expr b/version.lisp-expr index ebe112e..4081e2c 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.6.12" +"0.8.6.13" -- 1.7.10.4