X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=tests%2Fstream.impure.lisp;h=8d0fc37ce138a422199d06248d07b341acde2c5e;hb=31f68584d0732dc0d17f379773e5f87f1e5a78ad;hp=0071bccdc08bc1d1177c02132015c4d09ed75976;hpb=bbf1b4cac9ec8069e33dfc4d34122d6dafec63c1;p=sbcl.git

diff --git a/tests/stream.impure.lisp b/tests/stream.impure.lisp
index 0071bcc..8d0fc37 100644
--- a/tests/stream.impure.lisp
+++ b/tests/stream.impure.lisp
@@ -80,7 +80,8 @@
                        type-error))
 (assert (raises-error? (with-open-file (s "/dev/zero")
                          (read-byte s))
-                       type-error))
+                       #-win32 type-error
+                       #+win32 sb-int:simple-file-error))
 ;;; bidirectional streams getting confused about their position
 (let ((p "bidirectional-stream-test"))
   (with-open-file (s p :direction :output :if-exists :supersede)
@@ -131,27 +132,28 @@
 
 ;;; 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)
-           (test-mode :overwrite)
-           ;; 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)))))
+(with-test (:name :test-file-for-close-should-not-delete :fails-on :win32)
+  (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)
+            (test-mode :overwrite)
+            ;; 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))))))
 
 ;;; test for read-write invariance of signed bytes, from Bruno Haible
 ;;; cmucl-imp 2004-09-06
@@ -592,7 +594,7 @@
 ;;; READ-CHAR-NO-HANG on bivalent streams (as returned by RUN-PROGRAM)
 ;;; was wrong.  CSR managed to promote the wrongness to all streams in
 ;;; the 1.0.32.x series, breaking slime instantly.
-(with-test (:name :read-char-no-hang-after-unread-char)
+(with-test (:name :read-char-no-hang-after-unread-char :skipped-on :win32)
   (let* ((process (run-program "/bin/sh" '("-c" "echo a && sleep 10")
                                :output :stream :wait nil))
          (stream (process-output process))
@@ -607,11 +609,9 @@
       (read-char-no-hang stream)
       (assert (< (- (get-universal-time) time) 2)))))
 
-#-win32
 (require :sb-posix)
-
 #-win32
-(with-test (:name :interrupt-open)
+(with-test (:name :interrupt-open :skipped-on :win32)
   (let ((fifo nil)
         (to 0))
     (unwind-protect
@@ -640,9 +640,7 @@
         (ignore-errors (delete-file fifo))))))
 
 #-win32
-(require :sb-posix)
-#-win32
-(with-test (:name :overeager-character-buffering)
+(with-test (:name :overeager-character-buffering :skipped-on :win32)
   (let ((fifo nil)
         (proc nil))
     (maphash
@@ -678,7 +676,8 @@
            (setf fifo nil))))
      sb-impl::*external-formats*)))
 
-(with-test (:name :bug-657183)
+(with-test (:name :bug-657183 :skipped-on '(not :sb-unicode))
+  #+sb-unicode
   (let ((name (merge-pathnames "stream-impure.temp-test"))
         (text '(#\GREEK_SMALL_LETTER_LAMDA
                 #\JAPANESE_BANK_SYMBOL
@@ -709,4 +708,29 @@
              (assert (eql (file-length f) 9))))
       (ignore-errors (delete-file name)))))
 
+(with-test (:name :bug-561642)
+  (let ((p "bug-561642-test.tmp"))
+    (unwind-protect
+         (progn
+           (with-open-file (f p
+                              :if-exists :supersede
+                              :if-does-not-exist :create
+                              :direction :output)
+             (write-line "FOOBAR" f))
+           (with-open-file (f p
+                              :if-exists :append
+                              :direction :output)
+             (let ((p0 (file-position f))
+                   (p1 (progn
+                         (write-char #\newline f)
+                         (file-position f)))
+                   (p2 (progn
+                         (write-char #\newline f)
+                         (finish-output f)
+                         (file-position f))))
+               (assert (eql 7 p0))
+               (assert (eql 8 p1))
+               (assert (eql 9 p2)))))
+      (ignore-errors (delete-file p)))))
+
 ;;; success