X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=tests%2Fstream.impure.lisp;h=598c55ab5cad690e05224f5f6c396fc6924a4a8a;hb=7abb9e44907ef12b52ac26d6482fbe21c036ee9b;hp=71a7a8c3396d31f11c39c9aa3896031e0b084049;hpb=b095510bb0f8a15bba529f31075998ce7fa883f6;p=sbcl.git

diff --git a/tests/stream.impure.lisp b/tests/stream.impure.lisp
index 71a7a8c..598c55a 100644
--- a/tests/stream.impure.lisp
+++ b/tests/stream.impure.lisp
@@ -93,5 +93,61 @@
   (with-open-file (s p)
     (assert (string= (read-line s) "THESE INSERTMBOLS")))
   (delete-file p))
+
+;;; :DIRECTION :IO didn't work on non-existent pathnames
+(let ((p "direction-io-test"))
+  (ignore-errors (delete-file p))
+  (with-open-file (s p :direction :io)
+    (format s "1")
+    (finish-output s)
+    (file-position s :start)
+    (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))
+
+;;; CLOSING a non-new streams should not delete them, and superseded
+;;; files should be restored.
+(let ((test "test-file-for-close-should-not-delete"))
+  (macrolet ((test-mode (mode)
+	       `(progn
+		 (catch :close-test-exit
+		   (with-open-file (f test :direction :output :if-exists ,mode)
+		     (write-line "test" f)
+		     (throw :close-test-exit t)))
+		 (assert (and (probe-file test) ,mode)))))
+    (unwind-protect
+	 (progn
+	   (with-open-file (f test :direction :output)
+	     (write-line "test" f))
+	   (test-mode :append)
+	   ;; FIXME: We really should recover supersede files as well, according to
+	   ;; CLOSE in CLHS, but at the moment we don't.
+	   ;; (test-mode :supersede)
+	   (test-mode :rename)
+	   (test-mode :rename-and-delete))
+      (when (probe-file test)
+	(delete-file test)))))
+
 ;;; success
 (quit :unix-status 104)