From d0f4d5a8caeb1982083cb973cb1e6844457ed58f Mon Sep 17 00:00:00 2001 From: David Lichteblau Date: Fri, 5 Oct 2012 19:37:28 +0200 Subject: [PATCH] Run sb-bsd-sockets tests on windows 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 | 23 +++++++++++++++++------ contrib/sb-bsd-sockets/tests.lisp | 10 +++++----- 2 files changed, 22 insertions(+), 11 deletions(-) diff --git a/contrib/sb-bsd-sockets/sb-bsd-sockets.asd b/contrib/sb-bsd-sockets/sb-bsd-sockets.asd index 1163cbd..7bbf5d9 100644 --- a/contrib/sb-bsd-sockets/sb-bsd-sockets.asd +++ b/contrib/sb-bsd-sockets/sb-bsd-sockets.asd @@ -43,18 +43,29 @@ (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")))) diff --git a/contrib/sb-bsd-sockets/tests.lisp b/contrib/sb-bsd-sockets/tests.lisp index 827b7c0..f624297 100644 --- a/contrib/sb-bsd-sockets/tests.lisp +++ b/contrib/sb-bsd-sockets/tests.lisp @@ -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)) @@ -112,7 +112,7 @@ (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")))) @@ -177,8 +177,8 @@ ;;; 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 -- 1.7.10.4