From: David Lichteblau <david@lichteblau.com>
Date: Thu, 19 Jul 2012 12:42:03 +0000 (+0200)
Subject: win32: Mark all currently failing tests as such
X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=f9663e4a4c35614fcba5812882f9ed812cbcf62d;p=sbcl.git

win32: Mark all currently failing tests as such

This change is not to be taken as an indication that these tests are not
going to be fixed.  Instead, it establishes a baseline against which to
measure future improvements, and it guards against further regression.

Please let's mark any newly added, problematic tests in the same fashion.
---

diff --git a/tests/alien.impure.lisp b/tests/alien.impure.lisp
index 98e88f2..70ac73b 100644
--- a/tests/alien.impure.lisp
+++ b/tests/alien.impure.lisp
@@ -247,8 +247,11 @@
 
 ;;; void conflicted with derived type
 (declaim (inline bug-316075))
+#-win32 ;kludge: This reader conditional masks a bug, but allows the test
+        ;to fail cleanly.
 (sb-alien:define-alien-routine bug-316075 void (result char :out))
-(with-test (:name bug-316075)
+(with-test (:name bug-316075 :fails-on :win32)
+  #+win32 (error "fail")
   (handler-bind ((warning #'error))
     (compile nil '(lambda () (multiple-value-list (bug-316075))))))
 
@@ -293,7 +296,7 @@
     (verify (signed 16)   #x003f8042 #x-7fbe)
     (verify (signed 16)   #x003f7042 #x7042)))
 
-(with-test (:name :bug-654485)
+(with-test (:name :bug-654485 :fails-on :win32)
   ;; DEBUG 2 used to prevent let-conversion of the open-coded ALIEN-FUNCALL body,
   ;; which in turn led the dreaded %SAP-ALIEN note.
   (handler-case
@@ -306,7 +309,7 @@
     (compiler-note (n)
       (error "bad note: ~A" n))))
 
-(with-test (:name :bug-721087)
+(with-test (:name :bug-721087 :fails-on :win32)
   (assert (typep nil '(alien c-string)))
   (assert (not (typep nil '(alien (c-string :not-null t)))))
   (assert (eq :ok
diff --git a/tests/clos-interrupts.impure.lisp b/tests/clos-interrupts.impure.lisp
index 8935ab7..e3a100e 100644
--- a/tests/clos-interrupts.impure.lisp
+++ b/tests/clos-interrupts.impure.lisp
@@ -77,7 +77,8 @@
 (defmethod compute-test ((x symbol) (y symbol))
   'symbol)
 
-(compute-test 1 2)
+(test-util:with-test (:name :compute-test :fails-on :win32)
+  (compute-test 1 2)
 
-;;; Check that we actually interrupted something.
-(assert (equal (list #'compute-test) *interrupted-gfs*))
+  ;; Check that we actually interrupted something.
+  (assert (equal (list #'compute-test) *interrupted-gfs*)))
diff --git a/tests/compiler.impure.lisp b/tests/compiler.impure.lisp
index 43e3bee..01270c6 100644
--- a/tests/compiler.impure.lisp
+++ b/tests/compiler.impure.lisp
@@ -1190,7 +1190,7 @@
 (defun bug-308914-storage (x)
   (the (simple-array flt (*)) (bug-308914-unknown x)))
 
-(with-test (:name :bug-308914-workaround)
+(with-test (:name :bug-308914-workaround :fails-on :win32)
   ;; This used to hang in ORDER-UVL-SETS.
   (handler-case
       (with-timeout 10
diff --git a/tests/compiler.pure.lisp b/tests/compiler.pure.lisp
index d047047..3003a2f 100644
--- a/tests/compiler.pure.lisp
+++ b/tests/compiler.pure.lisp
@@ -3710,7 +3710,7 @@
                             (declare (ignore x y k1))
                             t))))))
 
-(with-test (:name :bug-309448)
+(with-test (:name :bug-309448 :fails-on :win32)
   ;; Like all tests trying to verify that something doesn't blow up
   ;; compile-times this is bound to be a bit brittle, but at least
   ;; here we try to establish a decent baseline.
diff --git a/tests/condition.impure.lisp b/tests/condition.impure.lisp
index 9475f9a..4812ba6 100644
--- a/tests/condition.impure.lisp
+++ b/tests/condition.impure.lisp
@@ -96,22 +96,23 @@
 (define-condition my-stream-error-1-0-9 (stream-error) ())
 (define-condition parse-foo-error-1-0-9 (parse-error) ())
 (define-condition read-bar-error-1-0-9 (reader-error) ())
-(let (;; instances created initializing all the slots specified in
-      ;; ANSI CL
-      (parse-foo-error-1-0-9 (make-condition 'parse-foo-error-1-0-9
-                                             :stream *standard-input*))
-      (read-foo-error-1-0-9 (make-condition 'read-bar-error-1-0-9
-                                            :stream *standard-input*))
-      (my-stream-error-1-0-9 (make-condition 'my-stream-error-1-0-9
-                                             :stream *standard-input*)))
-  ;; should be printable
-  (dolist (c (list
-              my-stream-error-1-0-9
-              parse-foo-error-1-0-9
-              read-foo-error-1-0-9))
-    ;; whether escaped or not
-    (dolist (*print-escape* '(nil t))
-      (write c :stream (make-string-output-stream)))))
+(with-test (:name :printable-conditions :fails-on :win32)
+  (let (;; instances created initializing all the slots specified in
+        ;; ANSI CL
+        (parse-foo-error-1-0-9 (make-condition 'parse-foo-error-1-0-9
+                                               :stream *standard-input*))
+        (read-foo-error-1-0-9 (make-condition 'read-bar-error-1-0-9
+                                              :stream *standard-input*))
+        (my-stream-error-1-0-9 (make-condition 'my-stream-error-1-0-9
+                                               :stream *standard-input*)))
+    ;; should be printable
+    (dolist (c (list
+                my-stream-error-1-0-9
+                parse-foo-error-1-0-9
+                read-foo-error-1-0-9))
+      ;; whether escaped or not
+      (dolist (*print-escape* '(nil t))
+        (write c :stream (make-string-output-stream))))))
 
 ;;; Reported by Michael Weber: restart computation in :TEST-FUNCTION used to
 ;;; cause infinite recursion.
diff --git a/tests/deadline.impure.lisp b/tests/deadline.impure.lisp
index 9242b3c..3e265a9 100644
--- a/tests/deadline.impure.lisp
+++ b/tests/deadline.impure.lisp
@@ -15,11 +15,11 @@
   (sb-ext:run-program "sleep" (list (format nil "~D" seconds))
                       :search t :wait t))
 
-(with-test (:name (:deadline :run-program :trivial))
+(with-test (:name (:deadline :run-program :trivial) :fails-on :win32)
   (assert-timeout (sb-sys:with-deadline (:seconds 1)
                     (run-sleep 3))))
 
-(with-test (:name (:deadline :defer-deadline-1))
+(with-test (:name (:deadline :defer-deadline-1) :fails-on :win32)
   (let ((n 0)
         (final nil))
     (handler-case
@@ -35,7 +35,7 @@
     (assert (= n 2))
     (assert final)))
 
-(with-test (:name (:deadline :defer-deadline-2))
+(with-test (:name (:deadline :defer-deadline-2) :fails-on :win32)
   (let ((n 0)
         (final nil))
     (handler-case
@@ -50,7 +50,7 @@
     (assert (plusp n))
     (assert (not final))))
 
-(with-test (:name (:deadline :cancel-deadline))
+(with-test (:name (:deadline :cancel-deadline) :fails-on :win32)
   (let ((n 0)
         (final nil))
     (handler-case
diff --git a/tests/exhaust.impure.lisp b/tests/exhaust.impure.lisp
index 7bf0fdc..085036d 100644
--- a/tests/exhaust.impure.lisp
+++ b/tests/exhaust.impure.lisp
@@ -97,7 +97,9 @@
           (setq ok t)))
       (assert ok))))
 
-(with-test (:name (:exhaust :alien-stack) :skipped-on '(not :c-stack-is-control-stack))
+(with-test (:name (:exhaust :alien-stack)
+                  :skipped-on '(not :c-stack-is-control-stack)
+                  :fails-on :win32)
   (let ((ok nil))
     (labels ((exhaust-alien-stack (i)
                (with-alien ((integer-array (array int 500)))
diff --git a/tests/external-format.impure.lisp b/tests/external-format.impure.lisp
index d8888c1..4af0da3 100644
--- a/tests/external-format.impure.lisp
+++ b/tests/external-format.impure.lisp
@@ -124,7 +124,8 @@
     (write-byte #xe0 s)
     (dotimes (i 40)
       (write-sequence a s))))
-(with-test (:name (:character-decode-large :attempt-resync))
+(with-test (:name (:character-decode-large :attempt-resync)
+                  :fails-on :win32)
   (with-open-file (s *test-path* :direction :input
                      :external-format :utf-8)
     (let ((count 0))
@@ -992,7 +993,7 @@
     (with-open-file (s *test-path* :external-format :utf-32be)
       (assert (string= " ???? " (read-line s))))))
 
-(with-test (:name :invalid-external-format)
+(with-test (:name :invalid-external-format :fails-on :win32)
   (labels ((test-error (e)
              (assert (typep e 'error))
              (unless (equal "Undefined external-format: :BAD-FORMAT"
diff --git a/tests/filesys.pure.lisp b/tests/filesys.pure.lisp
index f6ac941..0c98791 100644
--- a/tests/filesys.pure.lisp
+++ b/tests/filesys.pure.lisp
@@ -98,7 +98,7 @@
 ;;; given only safe characters in the namestring, NATIVE-PATHNAME will
 ;;; never error, and NATIVE-NAMESTRING on the result will return the
 ;;; original namestring.
-(with-test (:name :random-native-namestrings)
+(with-test (:name :random-native-namestrings :fails-on :win32)
   (let ((safe-chars
          (coerce
           (cons #\Newline
diff --git a/tests/foreign-stack-alignment.impure.lisp b/tests/foreign-stack-alignment.impure.lisp
index 069c5e8..ee14cd9 100644
--- a/tests/foreign-stack-alignment.impure.lisp
+++ b/tests/foreign-stack-alignment.impure.lisp
@@ -43,34 +43,37 @@
 ;;;; fork/exec, so that no lisp is on the stack. This is our known-good
 ;;;; number.
 
-(run "/bin/sh" "run-compiler.sh" "-sbcl-pic"
-     "stack-alignment-offset.c" "-o" "stack-alignment-offset")
+#-win32
+(progn
+  (run "/bin/sh" "run-compiler.sh" "-sbcl-pic"
+       "stack-alignment-offset.c" "-o" "stack-alignment-offset")
 
-(defparameter *good-offset*
-  (parse-integer (run "./stack-alignment-offset"
-                      (princ-to-string *required-alignment*))))
+  (defparameter *good-offset*
+    (parse-integer (run "./stack-alignment-offset"
+                        (princ-to-string *required-alignment*))))
 
-;;;; Build the tool again, this time as a shared object, and load it
+  ;; Build the tool again, this time as a shared object, and load it
 
-(run "/bin/sh" "run-compiler.sh" "-sbcl-pic" "-sbcl-shared"
-     "stack-alignment-offset.c" "-o" "stack-alignment-offset.so")
+  (run "/bin/sh" "run-compiler.sh" "-sbcl-pic" "-sbcl-shared"
+       "stack-alignment-offset.c" "-o" "stack-alignment-offset.so")
 
-(load-shared-object (truename "stack-alignment-offset.so"))
+  (load-shared-object (truename "stack-alignment-offset.so"))
 
-(define-alien-routine stack-alignment-offset int (alignment int))
-(define-alien-routine trampoline int (callback (function int)))
+  (define-alien-routine stack-alignment-offset int (alignment int))
+  (define-alien-routine trampoline int (callback (function int))))
 
 ;;;; Now get the offset by calling from lisp, first with a regular foreign function
 ;;;; call, then with an intervening callback.
 
-(with-test (:name :regular)
+(with-test (:name :regular :fails-on :win32)
   (assert (= *good-offset* (stack-alignment-offset *required-alignment*))))
 
-(with-test (:name :callback)
+(with-test (:name :callback :fails-on :win32)
   (assert (= *good-offset* (trampoline (alien-lambda int ()
                                        (stack-alignment-offset *required-alignment*))))))
 
-(delete-file "stack-alignment-offset")
-(delete-file "stack-alignment-offset.so")
+(when (probe-file "stack-alignment-offset.so")
+  (delete-file "stack-alignment-offset")
+  (delete-file "stack-alignment-offset.so"))
 
 ;;;; success!
diff --git a/tests/interface.pure.lisp b/tests/interface.pure.lisp
index 1e76ccd..5957ce0 100644
--- a/tests/interface.pure.lisp
+++ b/tests/interface.pure.lisp
@@ -61,7 +61,7 @@
 (assert (not (special-operator-p 'declare)))
 
 ;;; WITH-TIMEOUT should accept more than one form in its body.
-(with-test (:name :with-timeout-forms)
+(with-test (:name :with-timeout-forms :fails-on :win32)
   (handler-bind ((sb-ext:timeout #'continue))
     (sb-ext:with-timeout 3
       (sleep 2)
diff --git a/tests/load.impure.lisp b/tests/load.impure.lisp
index 78b6d5c..bdc4116 100644
--- a/tests/load.impure.lisp
+++ b/tests/load.impure.lisp
@@ -84,8 +84,10 @@
            *loaded-pathname* *loaded-truename*)
        (load ,load-argument :print t :verbose t)
        (assert (and (= (1+ ,before) *counter*)
+                    #-win32 ;kludge
                     (equal ,(if pathname `(merge-pathnames ,pathname))
                            *loaded-pathname*)
+                    #-win32 ;kludge
                     (equal ,(if pathname `(merge-pathnames ,truename))
                            *loaded-truename*))))))
 
@@ -272,7 +274,7 @@
                                      (invoke-restart 'sb-fasl::object)))))
       (load-and-assert spec fasl fasl))))
 
-(with-test (:name :bug-332)
+(with-test (:name :bug-332 :fails-on :win32)
   (flet ((stimulate-sbcl ()
            (let ((filename (format nil "/tmp/~A.lisp" (gensym))))
              ;; create a file which redefines a structure incompatibly
diff --git a/tests/pathnames.impure.lisp b/tests/pathnames.impure.lisp
index 732f9d8..e05e8db 100644
--- a/tests/pathnames.impure.lisp
+++ b/tests/pathnames.impure.lisp
@@ -32,7 +32,7 @@
 ;;; some things SBCL-0.6.9 used not to parse correctly:
 ;;;
 ;;; SBCL used to throw an error saying there's no translation.
-(with-test (:name (:logical-pathname 1))
+(with-test (:name (:logical-pathname 1) :fails-on :win32)
   (assert (equal (namestring (translate-logical-pathname "demo0:file.lisp"))
                  "/tmp/file.lisp")))
 
@@ -49,12 +49,12 @@
                     "/tmp/**/foo.lisp"))))
 
 ;;; That should be correct:
-(with-test (:name (:logical-pathname 4))
+(with-test (:name (:logical-pathname 4) :fails-on :win32)
   (assert (equal (namestring (translate-logical-pathname "demo1:foo.lisp"))
                  "/tmp/foo.lisp")))
 
 ;;; Check for absolute/relative path confusion:
-(with-test (:name (:logical-pathname 5))
+(with-test (:name (:logical-pathname 5) :fails-on :win32)
   (assert (not (equal (namestring (translate-logical-pathname "demo1:;foo.lisp"))
                       "tmp/rel/foo.lisp")))
   (assert (equal (namestring (translate-logical-pathname "demo1:;foo.lisp"))
@@ -153,7 +153,7 @@
 ;;; there's some code in this section which should be attributed
 ;;; to something in the ANSI spec, but I don't know what code it is
 ;;; or what section of the specification has the related code.
-(with-test (:name (:logical-pathname 14))
+(with-test (:name (:logical-pathname 14) :fails-on :win32)
   (setf (logical-pathname-translations "test0")
         '(("**;*.*.*"              "/library/foo/**/")))
   (assert (equal (namestring (translate-logical-pathname
@@ -179,7 +179,7 @@
 ;;; ANSI section 19.3.1.1.5 specifies that translation to a filesystem
 ;;; which doesn't have versions should ignore the version slot. CMU CL
 ;;; didn't ignore this as it should, but we do.
-(with-test (:name (:logical-pathname 15))
+(with-test (:name (:logical-pathname 15) :fails-on :win32)
   (assert (equal (namestring (translate-logical-pathname
                               "test0:foo;bar;baz;mum.quux.3"))
                  "/library/foo/foo/bar/baz/mum.quux")))
@@ -325,7 +325,7 @@
 
 ;;; ensure read/print consistency (or print-not-readable-error) on
 ;;; pathnames:
-(with-test (:name :print/read-consistency)
+(with-test (:name :print/read-consistency :fails-on :win32)
   (let ((pathnames (list
                     (make-pathname :name "foo" :type "txt" :version :newest)
                     (make-pathname :name "foo" :type "txt" :version 1)
@@ -398,7 +398,7 @@
 
 ;;; we got (truename "/") wrong for about 6 months.  Check that it's
 ;;; still right.
-(with-test (:name :root-truename)
+(with-test (:name :root-truename :fails-on :win32)
   (let ((pathname (truename "/")))
     (assert (equalp pathname #p"/"))
     (assert (equal (pathname-directory pathname) '(:absolute)))))
@@ -412,7 +412,7 @@
     (assert (string= (write-to-string pathname :readably t) "#P\"SYS:**;*\""))))
 
 ;;; reported by James Y Knight on sbcl-devel 2006-05-17
-(with-test (:name :merge-back)
+(with-test (:name :merge-back :fails-on :win32)
   (let ((p1 (make-pathname :directory '(:relative "bar")))
         (p2 (make-pathname :directory '(:relative :back "foo"))))
     (assert (equal (merge-pathnames p1 p2)
@@ -535,7 +535,7 @@
   (assert (equal (make-pathname :directory '(:absolute))
                  (read-from-string "#p\"\\\\\\\\\""))))
 
-(with-test (:name :load-logical-pathname-translations)
+(with-test (:name :load-logical-pathname-translations :fails-on :win32)
   (let* ((cwd (truename "."))
          (foo (merge-pathnames "llpnt-foo.translations" cwd))
          (bar (merge-pathnames "llpnt-bar.translations" cwd))
@@ -567,7 +567,7 @@
       (ignore-errors (delete-file bar))
       (setf (logical-pathname-translations "SYS") translations))))
 
-(with-test (:name :tilde-expansion)
+(with-test (:name :tilde-expansion :fails-on :win32)
   (assert (equal '(:absolute :home "foo") (pathname-directory "~/foo/bar.txt")))
   (assert (equal '(:absolute (:home "jdoe") "quux") (pathname-directory "~jdoe/quux/")))
   (assert (equal "~/foo/x" (namestring (make-pathname :directory '(:absolute :home "foo")
@@ -592,7 +592,8 @@
   ;; * / :WILD
   (assert (equal (pathname-directory #p"\\*/") '(:relative "*"))))
 
-(with-test (:name :ensure-directories-exist-with-odd-d-p-d)
+(with-test (:name :ensure-directories-exist-with-odd-d-p-d
+                  :fails-on :win32)
   (let ((*default-pathname-defaults* #p"/tmp/foo"))
     (ensure-directories-exist "/")))
 
diff --git a/tests/print.impure.lisp b/tests/print.impure.lisp
index 46a06a6..4b6fed3 100644
--- a/tests/print.impure.lisp
+++ b/tests/print.impure.lisp
@@ -268,11 +268,12 @@
 
 ;;; bug 350: bignum printing so memory-hungry that heap runs out
 ;;; -- just don't stall here forever on a slow box
-(handler-case
-    (with-timeout 10
-      (print (ash 1 1000000)))
-  (timeout ()
-    (print 'timeout!)))
+(with-test (:name bug-350 :fails-on :win32)
+  (handler-case
+      (with-timeout 10
+        (print (ash 1 1000000)))
+    (timeout ()
+      (print 'timeout!))))
 
 ;;; bug 371: bignum print/read inconsistency
 (defvar *bug-371* -7043009959286724629649270926654940933664689003233793014518979272497911394287216967075767325693021717277238746020477538876750544587281879084559996466844417586093291189295867052594478662802691926547232838591510540917276694295393715934079679531035912244103731582711556740654671309980075069010778644542022/670550434139267031632063192770201289106737062379324644110801846820471752716238484923370056920388400273070254958650831435834503195629325418985020030706879602898158806736813101434594805676212779217311897830937606064579213895527844045511878668289820732425014254579493444623868748969110751636786165152601)
diff --git a/tests/run-program.impure.lisp b/tests/run-program.impure.lisp
index 8a4b3a3..95da2dc 100644
--- a/tests/run-program.impure.lisp
+++ b/tests/run-program.impure.lisp
@@ -19,7 +19,7 @@
 ;; (sometimes the handler will manage to WAIT3 a process before
 ;; run-tests WAITPIDs it).
 
-(with-test (:name :run-program-cat-1)
+(with-test (:name :run-program-cat-1 :skipped-on :win32)
   (let* ((process (sb-ext:run-program "/bin/cat" '() :wait nil
                                       :output :stream :input :stream))
          (out (process-input process))
@@ -31,7 +31,7 @@
               (assert (= (read-byte in) i)))
       (process-close process))))
 
-(with-test (:name :run-program-cat-2 :skipped-on '(not :sb-thread))
+(with-test (:name :run-program-cat-2 :skipped-on '(or (not :sb-thread) :win32))
   ;; Tests that reading from a FIFO is interruptible.
   (let* ((process (sb-ext:run-program "/bin/cat" '()
                                       :wait nil
@@ -97,7 +97,7 @@
              :start2 start :end2 end)
     seq))
 
-(with-test (:name :run-program-cat-3)
+(with-test (:name :run-program-cat-3 :skipped-on :win32)
   ;; User-defined binary input and output streams.
   (let ((in (make-instance 'buffer-stream))
         (out (make-instance 'buffer-stream))
@@ -109,7 +109,7 @@
       (assert (= 0 (read-sequence (make-array 8) out)))
       (assert (equalp buf data)))))
 
-(with-test (:name :run-program-cat-4)
+(with-test (:name :run-program-cat-4 :skipped-on :win32)
   ;; Null broadcast stream as output
   (let* ((process (sb-ext:run-program "/bin/cat" '() :wait nil
                                       :output (make-broadcast-stream)
@@ -127,24 +127,26 @@
 
 (require :sb-posix)
 
-(defun make-pipe ()
-  (multiple-value-bind (in out) (sb-posix:pipe)
-    (let ((input (sb-sys:make-fd-stream in
-                                        :input t
-                                        :external-format :ascii
-                                        :buffering :none :name "in"))
-          (output (sb-sys:make-fd-stream out
-                                         :output t
-                                         :external-format :ascii
-                                         :buffering :none :name "out")))
-      (make-two-way-stream input output))))
-
-(defparameter *cat-in-pipe* (make-pipe))
-(defparameter *cat-in* (make-synonym-stream '*cat-in-pipe*))
-(defparameter *cat-out-pipe* (make-pipe))
-(defparameter *cat-out* (make-synonym-stream '*cat-out-pipe*))
-
-(with-test (:name :run-program-cat-5)
+#-win32
+(progn
+  (defun make-pipe ()
+    (multiple-value-bind (in out) (sb-posix:pipe)
+      (let ((input (sb-sys:make-fd-stream in
+                                          :input t
+                                          :external-format :ascii
+                                          :buffering :none :name "in"))
+            (output (sb-sys:make-fd-stream out
+                                           :output t
+                                           :external-format :ascii
+                                           :buffering :none :name "out")))
+        (make-two-way-stream input output))))
+
+  (defparameter *cat-in-pipe* (make-pipe))
+  (defparameter *cat-in* (make-synonym-stream '*cat-in-pipe*))
+  (defparameter *cat-out-pipe* (make-pipe))
+  (defparameter *cat-out* (make-synonym-stream '*cat-out-pipe*)))
+
+(with-test (:name :run-program-cat-5 :fails-on :win32)
   (let ((cat (run-program "/bin/cat" nil :input *cat-in* :output *cat-out*
                           :wait nil)))
     (dolist (test '("This is a test!"
@@ -158,6 +160,9 @@
 ;;; buffering of stdin and stdout depends on their TTYness, and ed isn't sufficiently
 ;;; agressive about flushing them. So, here's another test using :PTY.
 
+#-win32 ( ;; kludge: It would be nicer to disable individual test cases,
+          ;; but we are not using WITH-TEST yet here.
+
 (defparameter *tmpfile* "run-program-ed-test.tmp")
 
 (with-open-file (f *tmpfile*
@@ -201,6 +206,8 @@
          (assert (equal "baz" (read-line f)))))
   (delete-file *tmpfile*))
 
+) ;; #-win32
+
 ;; Around 1.0.12 there was a regression when :INPUT or :OUTPUT was a
 ;; pathname designator.  Since these use the same code, it should
 ;; suffice to test just :INPUT.
@@ -217,7 +224,7 @@
 
 ;;; This used to crash on Darwin and trigger recursive lock errors on
 ;;; every platform.
-(with-test (:name (:run-program :stress))
+(with-test (:name (:run-program :stress) :fails-on :win32)
   ;; Do it a hundred times in batches of 10 so that with a low limit
   ;; of the number of processes the test can have a chance to pass.
   (loop
@@ -230,7 +237,7 @@
                                   ("It would be nice if this didn't crash.")
                                   :wait nil :output nil)))))
 
-(with-test (:name (:run-program :pty-stream))
+(with-test (:name (:run-program :pty-stream) :fails-on :win32)
   (assert (equal "OK"
                  (subseq
                   (with-output-to-string (s)
@@ -247,7 +254,7 @@
 ;; We can't check for the signal itself since run-program.c resets the
 ;; forked process' signal mask to defaults. But the default is `stop'
 ;; of which we can be notified asynchronously by providing a status hook.
-(with-test (:name (:run-program :inherit-stdin))
+(with-test (:name (:run-program :inherit-stdin) :fails-on :win32)
   (let (stopped)
     (flet ((status-hook (proc)
              (case (sb-ext:process-status proc)
@@ -267,7 +274,8 @@
 
 ;; Check that in when you do run-program with :wait t that causes
 ;; encoding error, it does not affect the following run-program
-(with-test (:name (:run-program :clean-exit-after-encoding-error))
+(with-test (:name (:run-program :clean-exit-after-encoding-error)
+                  :fails-on :win32)
   (let ((had-error-p nil))
     (flet ((barf (&optional (format :default))
              (with-output-to-string (stream)
@@ -307,6 +315,7 @@
                     (error (e)
                       (princ-to-string e))))))
 
+#-win32
 (with-test (:name (:run-program :if-input-does-not-exist))
   (let ((file (pathname (sb-posix:mktemp "rpXXXXXX"))))
     (assert (null (sb-ext:run-program "/bin/cat" '() :input file)))
diff --git a/tests/signals.impure.lisp b/tests/signals.impure.lisp
index 093bf23..ea6e895 100644
--- a/tests/signals.impure.lisp
+++ b/tests/signals.impure.lisp
@@ -13,7 +13,7 @@
 
 (use-package :test-util)
 
-(with-test (:name (:async-unwind :specials))
+(with-test (:name (:async-unwind :specials) :fails-on :win32)
   (let ((*x0* nil) (*x1* nil) (*x2* nil) (*x3* nil) (*x4* nil))
     (declare (special *x0* *x1* *x2* *x3* *x4*))
     (loop repeat 10 do
@@ -38,7 +38,7 @@
 
 (require :sb-posix)
 
-(with-test (:name (:signal :errno))
+(with-test (:name (:signal :errno) :fails-on :win32)
   (let* (saved-errno
          (returning nil)
          (timer (make-timer (lambda ()
@@ -57,7 +57,7 @@
     (loop repeat 1000000000)
     (assert (= saved-errno (sb-unix::get-errno)))))
 
-(with-test (:name :handle-interactive-interrupt)
+(with-test (:name :handle-interactive-interrupt :fails-on :win32)
   (assert (eq :condition
               (handler-case
                   (sb-thread::kill-safely
diff --git a/tests/stream.impure.lisp b/tests/stream.impure.lisp
index a4922cc..6e63ceb 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,9 +609,8 @@
       (read-char-no-hang stream)
       (assert (< (- (get-universal-time) time) 2)))))
 
-#-win32
 (require :sb-posix)
-
+#-win32
 (with-test (:name :interrupt-open :skipped-on :win32)
   (let ((fifo nil)
         (to 0))
@@ -639,7 +640,6 @@
         (ignore-errors (delete-file fifo))))))
 
 #-win32
-(require :sb-posix)
 (with-test (:name :overeager-character-buffering :skipped-on :win32)
   (let ((fifo nil)
         (proc nil))
diff --git a/tests/stream.pure.lisp b/tests/stream.pure.lisp
index f0f9a24..526f76b 100644
--- a/tests/stream.pure.lisp
+++ b/tests/stream.pure.lisp
@@ -324,7 +324,7 @@
 ;;; immediately be completely filled for normal files, and that the
 ;;; buffer-fill routine is responsible for figuring out when we've
 ;;; reached EOF.
-(with-test (:name (stream listen-vs-select))
+(with-test (:name (stream listen-vs-select) :fails-on :win32)
   (let ((listen-testfile-name "stream.impure.lisp.testqfile")
         ;; If non-NIL, size (in bytes) of the file that will exercise
         ;; the LISTEN problem.
diff --git a/tests/swap-lispobjs.impure.lisp b/tests/swap-lispobjs.impure.lisp
index d187ac7..267ed6d 100644
--- a/tests/swap-lispobjs.impure.lisp
+++ b/tests/swap-lispobjs.impure.lisp
@@ -29,21 +29,23 @@
              output))
     output))
 
-(run "/bin/sh" "run-compiler.sh"
-     "-sbcl-pic" "-sbcl-shared"
-     "-O3" "-I" "../src/runtime/"
-     "swap-lispobjs.c" "-o" "swap-lispobjs.so")
+(with-test (:name :swap-lispobjs/prepare :broken-on :win32)
+  (run "/bin/sh" "run-compiler.sh"
+       "-sbcl-pic" "-sbcl-shared"
+       "-O3" "-I" "../src/runtime/"
+       "swap-lispobjs.c" "-o" "swap-lispobjs.so")
 
-(load-shared-object (truename "swap-lispobjs.so"))
+  (load-shared-object (truename "swap-lispobjs.so"))
 
-(define-alien-routine try-to-zero-with-swap-lispobjs int
-  (lispobj-adress unsigned-long))
+  (define-alien-routine try-to-zero-with-swap-lispobjs int
+    (lispobj-adress unsigned-long)))
 
-(with-test (:name :swap-lispobjs)
+(with-test (:name :swap-lispobjs :fails-on :win32)
   (let ((x (cons 13 27)))
     (try-to-zero-with-swap-lispobjs
      (logandc2 (sb-kernel:get-lisp-obj-address x)
                sb-vm:lowtag-mask))
     (assert (equal x (cons 0 27)))))
 
-(delete-file "swap-lispobjs.so")
+(when (probe-file "swap-lispobjs.so")
+  (delete-file "swap-lispobjs.so"))
diff --git a/tests/threads.pure.lisp b/tests/threads.pure.lisp
index 2a2a6c4..f99e01a 100644
--- a/tests/threads.pure.lisp
+++ b/tests/threads.pure.lisp
@@ -412,14 +412,14 @@
     (assert (and (null value)
                  error))))
 
-(with-test (:name (:wait-for :basics))
+(with-test (:name (:wait-for :basics) :fails-on :win32)
   (assert (not (sb-ext:wait-for nil :timeout 0.1)))
   (assert (eql 42 (sb-ext:wait-for 42)))
   (let ((n 0))
     (assert (eql 100 (sb-ext:wait-for (when (= 100 (incf n))
                                         n))))))
 
-(with-test (:name (:wait-for :deadline))
+(with-test (:name (:wait-for :deadline) :fails-on :win32)
   (assert (eq :ok
               (sb-sys:with-deadline (:seconds 10)
                 (assert (not (sb-ext:wait-for nil :timeout 0.1)))
@@ -431,7 +431,7 @@
                     (error "oops"))
                 (sb-sys:deadline-timeout () :deadline)))))
 
-(with-test (:name (:condition-wait :timeout :one-thread))
+(with-test (:name (:condition-wait :timeout :one-thread) :fails-on :win32)
   (let ((mutex (make-mutex))
         (waitqueue (make-waitqueue)))
     (assert (not (with-mutex (mutex)
@@ -464,7 +464,7 @@
       (unless (eql 50 ok)
         (error "Wanted 50, got ~S" ok)))))
 
-(with-test (:name (:wait-on-semaphore :timeout :one-thread))
+(with-test (:name (:wait-on-semaphore :timeout :one-thread) :fails-on :win32)
   (let ((sem (make-semaphore))
         (n 0))
     (signal-semaphore sem 10)
diff --git a/tests/unwind-to-frame-and-call.impure.lisp b/tests/unwind-to-frame-and-call.impure.lisp
index a4a7915..f6a4419 100644
--- a/tests/unwind-to-frame-and-call.impure.lisp
+++ b/tests/unwind-to-frame-and-call.impure.lisp
@@ -88,13 +88,13 @@
     ;; Check that the binding stack was correctly unwound.
     (assert (eql *foo* 'x))))
 
-(with-test (:name (:restart-frame :special))
+(with-test (:name (:restart-frame :special) :fails-on :win32)
   (test-restart 'restart/special))
 
-(with-test (:name (:restart-frame :optional-special))
+(with-test (:name (:restart-frame :optional-special) :fails-on :win32)
   (test-restart 'restart/optional-special))
 
-(with-test (:name (:restart-frame :normal))
+(with-test (:name (:restart-frame :normal) :fails-on :win32)
   (test-restart 'restart/normal))
 
 
@@ -140,22 +140,23 @@
     ;; Check that the binding stack was correctly unwound.
     (assert (eql *foo* 'x))))
 
-(with-test (:name (:return-from-frame :special))
+(with-test (:name (:return-from-frame :special) :fails-on :win32)
   (test-return 'return/special))
 
-(with-test (:name (:return-from-frame :optional-special))
+(with-test (:name (:return-from-frame :optional-special) :fails-on :win32)
   (test-return 'return/optional-special))
 
-(with-test (:name (:return-from-frame :normal))
+(with-test (:name (:return-from-frame :normal) :fails-on :win32)
   (test-return 'return/normal))
 
 (defun throw-y () (throw 'y 'y))
 
 ;; Check that *CURRENT-CATCH-BLOCK* was correctly restored.
-(assert (eql (catch 'y
-               (test-return 'return/catch)
-               (throw-y))
-             'y))
+(with-test (:name :current-catch-block-restored :fails-on :win32)
+  (assert (eql (catch 'y
+                 (test-return 'return/catch)
+                 (throw-y))
+               'y)))
 
 
 ;;;; Test RETURN-FROM-FRAME with local functions
@@ -211,10 +212,10 @@
       (assert (equal *b* '(z))))
     (assert (eql *foo* 'x))))
 
-(with-test (:name (:return-from-frame :local-function))
+(with-test (:name (:return-from-frame :local-function) :fails-on :win32)
   (test-locals 'locals))
 
-(with-test (:name (:return-from-frame :hairy-local-function))
+(with-test (:name (:return-from-frame :hairy-local-function) :fails-on :win32)
   (test-locals 'hairy-locals))
 
 
@@ -262,16 +263,17 @@
         (assert (eql *foo* 'y)))
       (assert (eql *foo* 'x)))))
 
-(with-test (:name (:return-from-frame :anonymous :toplevel))
+(with-test (:name (:return-from-frame :anonymous :toplevel) :fails-on :win32)
   (test-anon *anon-1* 'foo (namestring *load-truename*)))
 
-(with-test (:name (:return-from-frame :anonymous :toplevel-special))
+(with-test (:name (:return-from-frame :anonymous :toplevel-special)
+                  :fails-on :win32)
   (test-anon *anon-2* '*foo* (namestring *load-truename*)))
 
-(with-test (:name (:return-from-frame :anonymous))
+(with-test (:name (:return-from-frame :anonymous) :fails-on :win32)
   (test-anon *anon-3* 'foo 'make-anon-3))
 
-(with-test (:name (:return-from-frame :anonymous :special))
+(with-test (:name (:return-from-frame :anonymous :special) :fails-on :win32)
   (test-anon *anon-4* '*foo* 'make-anon-4))
 
 
@@ -308,8 +310,10 @@
           (assert (eql *foo* 'y)))
         (assert (eql *foo* 'x))))))
 
-(test-unwind 'unwind-1 '(:unwind-1))
-(test-unwind 'unwind-2 '(:unwind-2 :unwind-1))
+(with-test (:name :test-unwind-1 :fails-on :win32)
+  (test-unwind 'unwind-1 '(:unwind-1)))
+(with-test (:name :test-unwind-2 :fails-on :win32)
+  (test-unwind 'unwind-2 '(:unwind-2 :unwind-1)))
 
 ;;; Regression in 1.0.10.47 reported by James Knight