Run sb-bsd-sockets tests on windows
authorDavid Lichteblau <david@lichteblau.com>
Fri, 5 Oct 2012 17:37:28 +0000 (19:37 +0200)
committerDavid Lichteblau <david@lichteblau.com>
Fri, 5 Oct 2012 17:38:45 +0000 (19:38 +0200)
Previously, we did not attempt tests for this contrib on Windows at
all, presumably because this (otherwise functional) contrib would
have failed some tests and hence would not have been installed.

Instead, mark the remaining failures as expected, so that they get
reported without preventing installation of the contrib.

contrib/sb-bsd-sockets/sb-bsd-sockets.asd
contrib/sb-bsd-sockets/tests.lisp

index 1163cbd..7bbf5d9 100644 (file)
 (defmethod perform :after ((o load-op) (c (eql (find-system :sb-bsd-sockets))))
   (provide 'sb-bsd-sockets))
 
-#-win32
 (defmethod perform ((o test-op) (c (eql (find-system :sb-bsd-sockets))))
   (operate 'load-op 'sb-bsd-sockets-tests)
   (operate 'test-op 'sb-bsd-sockets-tests))
 
-#-win32
 (defsystem sb-bsd-sockets-tests
   :depends-on (sb-rt sb-bsd-sockets #-win32 sb-posix)
   :components ((:file "tests")))
 
-#-win32
 (defmethod perform ((o test-op) (c (eql (find-system :sb-bsd-sockets-tests))))
-  (or (funcall (intern "DO-TESTS" (find-package "SB-RT")))
-      (error "test-op failed")))
-
+  (multiple-value-bind (soft strict pending)
+      (funcall (intern "DO-TESTS" (find-package "SB-RT")))
+    (fresh-line)
+    (unless strict
+      #+sb-testing-contrib
+      ;; We create TEST-PASSED from a shell script if tests passed.  But
+      ;; since the shell script only `touch'es it, we can actually create
+      ;; it ahead of time -- as long as we're certain that tests truly
+      ;; passed, hence the check for SOFT.
+      (when soft
+        (with-open-file (s #p"SYS:CONTRIB;SB-BSD-SOCKETS;TEST-PASSED"
+                           :direction :output)
+          (dolist (pend pending)
+            (format s "Expected failure: ~A~%" pend))))
+      (warn "ignoring expected failures in test-op"))
+    (unless soft
+      (error "test-op failed with unexpected failures"))))
index 827b7c0..f624297 100644 (file)
@@ -50,7 +50,7 @@
       (and (> (socket-file-descriptor s) 1) t))
   t)
 
-(deftest make-inet-socket-wrong
+(deftest* (make-inet-socket-wrong :fails-on :win32)
     ;; fail to make a socket: check correct error return.  There's no nice
     ;; way to check the condition stuff on its own, which is a shame
     (handler-case
@@ -66,7 +66,7 @@
       (:no-error nil))
   t)
 
-(deftest make-inet-socket-keyword-wrong
+(deftest* (make-inet-socket-keyword-wrong :fails-on :win32)
     ;; same again with keywords
     (handler-case
         (make-instance 'inet-socket :type :stream :protocol :udp)
@@ -83,7 +83,7 @@
   t)
 
 
-(deftest non-block-socket
+(deftest* (non-block-socket :fails-on :win32)
   (let ((s (make-instance 'inet-socket :type :stream :protocol :tcp)))
     (setf (non-blocking-mode s) t)
     (non-blocking-mode s))
       (address-in-use-error () t)))
   t)
 
-(deftest simple-sockopt-test
+(deftest* (simple-sockopt-test :fails-on :win32)
   ;; test we can set SO_REUSEADDR on a socket and retrieve it, and in
   ;; the process that all the weird macros in sockopt happened right.
   (let ((s (make-instance 'inet-socket :type :stream :protocol (get-protocol-by-name "tcp"))))
 ;;; to look at /etc/syslog.conf or local equivalent to find out where
 ;;; the message ended up
 
+#-win32
 (deftest simple-local-client
-    #-win32
     (progn
       ;; SunOS (Solaris) and Darwin systems don't have a socket at
       ;; /dev/log.  We might also be building in a chroot or