From cbe488f1e264bc8f7b0501430b260db1887b055d Mon Sep 17 00:00:00 2001 From: Christophe Rhodes Date: Wed, 5 May 2004 12:10:00 +0000 Subject: [PATCH] 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. --- NEWS | 2 ++ src/code/stream.lisp | 8 ++++++++ tests/stream.impure.lisp | 21 +++++++++++++++++++++ version.lisp-expr | 2 +- 4 files changed, 32 insertions(+), 1 deletion(-) diff --git a/NEWS b/NEWS index cdc1a20..6be01de 100644 --- 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 --- 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 --- a/tests/stream.impure.lisp +++ b/tests/stream.impure.lisp @@ -104,5 +104,26 @@ (assert (char= (read-char s) #\1))) (delete-file p)) +;;; 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 --- 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" -- 1.7.10.4