X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=contrib%2Fsb-bsd-sockets%2Ftests.lisp;h=827b7c09e2e485272036fa111c45cf919fd1f4ab;hb=1483e561a090d9f07687da27f8dd10fcd4152be1;hp=f0ceba2dfc9be747b2cc20931105ccaa2bab478c;hpb=c03ebb54770cfa613d4b706a80e5be231786a5d0;p=sbcl.git diff --git a/contrib/sb-bsd-sockets/tests.lisp b/contrib/sb-bsd-sockets/tests.lisp index f0ceba2..827b7c0 100644 --- a/contrib/sb-bsd-sockets/tests.lisp +++ b/contrib/sb-bsd-sockets/tests.lisp @@ -3,6 +3,12 @@ (in-package :sb-bsd-sockets-test) +(defmacro deftest* ((name &key fails-on) form &rest results) + `(progn + (when (sb-impl::featurep ',fails-on) + (pushnew ',name sb-rt::*expected-failures*)) + (deftest ,name ,form ,@results))) + ;;; a real address (deftest make-inet-address (equalp (make-inet-address "127.0.0.1") #(127 0 0 1)) @@ -20,6 +26,10 @@ (integerp (get-protocol-by-name "udp")) t) +;;; See https://bugs.launchpad.net/sbcl/+bug/659857 +;;; Apparently getprotobyname_r on FreeBSD says -1 and EINTR +;;; for unknown protocols... +#-(and freebsd sb-thread) (deftest get-protocol-by-name/error (handler-case (get-protocol-by-name "nonexistent-protocol") (unknown-protocol () @@ -45,7 +55,13 @@ ;; way to check the condition stuff on its own, which is a shame (handler-case (make-instance 'inet-socket :type :stream :protocol (get-protocol-by-name "udp")) - ((or socket-type-not-supported-error protocol-not-supported-error) (c) + ;; CLH FIXME! some versions of darwin just return a socket error + ;; here, not socket-type-not-supported-error or + ;; protocol-not-supported-error. + ((or #+darwin socket-error + socket-type-not-supported-error + protocol-not-supported-error) + (c) (declare (ignorable c)) t) (:no-error nil)) t) @@ -54,7 +70,14 @@ ;; same again with keywords (handler-case (make-instance 'inet-socket :type :stream :protocol :udp) - ((or protocol-not-supported-error socket-type-not-supported-error) (c) + ;; CLH FIXME! some versions of darwin just return a socket error + ;; here, not socket-type-not-supported-error or + ;; protocol-not-supported-error. + ((or + #+darwin socket-error + protocol-not-supported-error + socket-type-not-supported-error) + (c) (declare (ignorable c)) t) (:no-error nil)) t) @@ -162,9 +185,13 @@ ;; something, so don't fail this test just because the file is ;; unavailable, or if it's a symlink to some weird character ;; device. - (when (and (probe-file "/dev/log") - (sb-posix:s-issock - (sb-posix::stat-mode (sb-posix:stat "/dev/log")))) + (when (block nil + (handler-bind ((sb-posix:syscall-error + (lambda (e) + (declare (ignore e)) + (return nil)))) + (sb-posix:s-issock + (sb-posix::stat-mode (sb-posix:stat "/dev/log"))))) (let ((s (make-instance 'local-socket :type :datagram))) (format t "Connecting ~A... " s) (finish-output) @@ -196,6 +223,10 @@ (host-ent-name (get-host-by-address #(198 41 0 4))) "a.root-servers.net") +;;; These days lots of people seem to be using DNS servers that don't +;;; report resolving failures for non-existing domains. This test +;;; will fail there, so we've disabled it. +#+nil (deftest get-host-by-name-wrong (handler-case (get-host-by-name "foo.tninkpad.telent.net.")