0.8.10.12:

	Fix for FILE-POSITION on BROADCAST-STREAMs
	... I'd been blathering about ambiguity and contradiction, but
		in fact FILE-POSITION is well-specified; it's
		FILE-LENGTH, FILE-STRING-LENGTH and
		STREAM-EXTERNAL-FORMAT which have problems.

diff --git a/NEWS b/NEWS
index cdc1a20..6be01de 100644 (file)
--- a/NEWS
+++ b/NEWS
@@ -2422,6 +2422,8 @@ changes in sbcl-0.8.11 relative to sbcl-0.8.10:
     so that each expands into only one top-level form in a
     :LOAD-TOPLEVEL context; this appears to decrease fasl sizes by
     approximately 10%.
+  * fixed some bugs revealed by Paul Dietz' test suite:
+    ** FILE-POSITION works as specified on BROADCAST-STREAMs.
 
 planned incompatible changes in 0.8.x:
   * (not done yet, but planned:) When the profiling interface settles

diff --git a/src/code/stream.lisp b/src/code/stream.lisp
index 9046767..925daa7 100644 (file)
--- a/src/code/stream.lisp
+++ b/src/code/stream.lisp
@@ -629,6 +629,14 @@
             ((null streams) res)
           (when (null (cdr streams))
             (setq res (stream-element-type (car streams)))))))
+      (:file-position
+       (if arg1
+          (let ((res (or (eql arg1 :start) (eql arg1 0))))
+            (dolist (stream streams res)
+              (setq res (file-position stream arg1))))
+          (let ((res 0))
+            (dolist (stream streams res)
+              (setq res (file-position stream))))))
       (:close
        (set-closed-flame stream))
       (t

diff --git a/tests/stream.impure.lisp b/tests/stream.impure.lisp
index 9b671c5..7348bfe 100644 (file)
--- a/tests/stream.impure.lisp
+++ b/tests/stream.impure.lisp
@@ -104,5 +104,26 @@
     (assert (char= (read-char s) #\1)))
   (delete-file p))
 \f
+;;; FILE-POSITION on broadcast-streams is mostly uncontroversial
+(assert (= 0 (file-position (make-broadcast-stream))))
+(assert (file-position (make-broadcast-stream) :start))
+(assert (file-position (make-broadcast-stream) 0))
+(assert (not (file-position (make-broadcast-stream) 1)))
+(let ((s (make-broadcast-stream)))
+  (write-char #\a s)
+  (assert (not (file-position s 1)))
+  (assert (= 0 (file-position s))))
+
+(let ((p "broadcast-stream-test"))
+  (ignore-errors (delete-file p))
+  (with-open-file (f p :direction :output)
+    (let ((s (make-broadcast-stream f)))
+      (assert (= 0 (file-position s)))
+      (assert (file-position s :start))
+      (assert (file-position s 0))
+      (write-char #\a s)
+      (assert (= 1 (file-position s))) ; unicode...
+      (assert (file-position s 0))))
+  (delete-file p))
 ;;; success
 (quit :unix-status 104)

diff --git a/version.lisp-expr b/version.lisp-expr
index d52bfde..1f9f5c1 100644 (file)
--- 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.10.11"
+"0.8.10.12"