X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=contrib%2Fsb-bsd-sockets%2Ftests.lisp;h=7ce9d39ae5e717e4ac355864ab4fc84a2a202cac;hb=a37b7e2a4c93398af954c3f03c5412ead1c1c828;hp=3fec556b729eec3257e0cb32248452188b8c84e8;hpb=891ba76c8476bb95951c4049e7c20d5895cb2233;p=sbcl.git diff --git a/contrib/sb-bsd-sockets/tests.lisp b/contrib/sb-bsd-sockets/tests.lisp index 3fec556..7ce9d39 100644 --- a/contrib/sb-bsd-sockets/tests.lisp +++ b/contrib/sb-bsd-sockets/tests.lisp @@ -1,20 +1,14 @@ (defpackage "SB-BSD-SOCKETS-TEST" (:use "CL" "SB-BSD-SOCKETS" "SB-RT")) -#|| - -

Tests

- -There should be at least one test for pretty much everything you can do -with the package. In some places I've been more diligent than others; more -tests gratefully accepted. - -Tests are in the file tests.lisp and also make good examples. - -||# - (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)) @@ -24,6 +18,26 @@ Tests are in the file tests.lisp and also make good examples. (equalp (make-inet-address "242.1.211.3") #(242 1 211 3)) t) +(deftest get-protocol-by-name/tcp + (integerp (get-protocol-by-name "tcp")) + t) + +(deftest get-protocol-by-name/udp + (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 () + t) + (:no-error () + nil)) + t) + (deftest make-inet-socket ;; make a socket (let ((s (make-instance 'inet-socket :type :stream :protocol (get-protocol-by-name "tcp")))) @@ -36,56 +50,66 @@ Tests are in the file tests.lisp and also make good examples. (and (> (socket-file-descriptor s) 1) t)) t) -(deftest make-inet-socket-wrong +(deftest* (make-inet-socket-wrong) ;; 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 - (make-instance 'inet-socket :type :stream :protocol (get-protocol-by-name "udp")) - ((or socket-type-not-supported-error protocol-not-supported-error) (c) - (declare (ignorable c)) t) + (make-instance 'inet-socket :type :stream :protocol (get-protocol-by-name "udp")) + ;; 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) -(deftest make-inet-socket-keyword-wrong +(deftest* (make-inet-socket-keyword-wrong) ;; 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) - (declare (ignorable c)) t) + (make-instance 'inet-socket :type :stream :protocol :udp) + ;; 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) -(deftest non-block-socket +(deftest* (non-block-socket) (let ((s (make-instance 'inet-socket :type :stream :protocol :tcp))) (setf (non-blocking-mode s) t) (non-blocking-mode s)) t) -(defun do-gc-portably () - ;; cmucl on linux has generational gc with a keyword argument, - ;; sbcl GC function takes same arguments no matter what collector is in - ;; use - #+(or sbcl gencgc) (SB-EXT:gc :full t) - ;; other platforms have full gc or nothing - #-(or sbcl gencgc) (sb-ext:gc)) - (deftest inet-socket-bind - (let ((s (make-instance 'inet-socket :type :stream :protocol (get-protocol-by-name "tcp")))) - ;; Given the functions we've got so far, if you can think of a - ;; better way to make sure the bind succeeded than trying it - ;; twice, let me know - ;; 1974 has no special significance, unless you're the same age as me - (do-gc-portably) ;gc should clear out any old sockets bound to this port - (socket-bind s (make-inet-address "127.0.0.1") 1974) - (handler-case - (let ((s2 (make-instance 'inet-socket :type :stream :protocol (get-protocol-by-name "tcp")))) - (socket-bind s2 (make-inet-address "127.0.0.1") 1974) - nil) - (address-in-use-error () t))) + (let* ((tcp (get-protocol-by-name "tcp")) + (address (make-inet-address "127.0.0.1")) + (s1 (make-instance 'inet-socket :type :stream :protocol tcp)) + (s2 (make-instance 'inet-socket :type :stream :protocol tcp))) + (unwind-protect + ;; Given the functions we've got so far, if you can think of a + ;; better way to make sure the bind succeeded than trying it + ;; twice, let me know + (progn + (socket-bind s1 address 0) + (handler-case + (let ((port (nth-value 1 (socket-name s1)))) + (socket-bind s2 address port) + nil) + (address-in-use-error () t))) + (socket-close s1) + (socket-close s2))) t) -(deftest simple-sockopt-test +(deftest* (simple-sockopt-test) ;; 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")))) @@ -111,24 +135,24 @@ Tests are in the file tests.lisp and also make good examples. #+internet-available (deftest simple-tcp-client (let ((s (make-instance 'inet-socket :type :stream :protocol :tcp)) - (data (make-string 200))) + (data (make-string 200))) (socket-connect s #(127 0 0 1) 7) (let ((stream (socket-make-stream s :input t :output t :buffering :none))) - (format stream "here is some text") - (let ((data (subseq data 0 (read-buf-nonblock data stream)))) - (format t "~&Got ~S back from TCP echo server~%" data) - (> (length data) 0)))) + (format stream "here is some text") + (let ((data (subseq data 0 (read-buf-nonblock data stream)))) + (format t "~&Got ~S back from TCP echo server~%" data) + (> (length data) 0)))) t) #+internet-available (deftest sockaddr-return-type (let ((s (make-instance 'inet-socket :type :stream :protocol :tcp))) - (unwind-protect - (progn - (socket-connect s #(127 0 0 1) 7) - (multiple-value-bind (host port) (socket-peername s) - (and (vectorp host) - (numberp port)))) + (unwind-protect + (progn + (socket-connect s #(127 0 0 1) 7) + (multiple-value-bind (host port) (socket-peername s) + (and (vectorp host) + (numberp port)))) (socket-close s))) t) @@ -141,8 +165,8 @@ Tests are in the file tests.lisp and also make good examples. (let ((stream (socket-make-stream s :input t :output t :buffering :none))) (format stream "here is some text") (let ((data (subseq data 0 (read-buf-nonblock data stream)))) - (format t "~&Got ~S back from UDP echo server~%" data) - (> (length data) 0)))) + (format t "~&Got ~S back from UDP echo server~%" data) + (> (length data) 0)))) t) ;;; A fairly rudimentary test that connects to the syslog socket and @@ -150,6 +174,7 @@ Tests are in the file tests.lisp and also make good examples. ;;; to look at /etc/syslog.conf or local equivalent to find out where ;;; the message ended up +#-win32 (deftest simple-local-client (progn ;; SunOS (Solaris) and Darwin systems don't have a socket at @@ -157,23 +182,27 @@ Tests are in the file tests.lisp and also make good examples. ;; 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")))) - (let ((s (make-instance 'local-socket :type :datagram))) - (format t "Connecting ~A... " s) - (finish-output) - (handler-case - (socket-connect s "/dev/log") - (sb-bsd-sockets::socket-error () - (setq s (make-instance 'local-socket :type :stream)) - (format t "failed~%Retrying with ~A... " s) - (finish-output) - (socket-connect s "/dev/log"))) - (format t "ok.~%") - (let ((stream (socket-make-stream s :input t :output t :buffering :none))) - (format stream - "<7>bsd-sockets: Don't panic. We're testing local-domain client code; this message can safely be ignored")))) + (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) + (handler-case + (socket-connect s "/dev/log") + (sb-bsd-sockets::socket-error () + (setq s (make-instance 'local-socket :type :stream)) + (format t "failed~%Retrying with ~A... " s) + (finish-output) + (socket-connect s "/dev/log"))) + (format t "ok.~%") + (let ((stream (socket-make-stream s :input t :output t :buffering :none))) + (format stream + "<7>bsd-sockets: Don't panic. We're testing local-domain client code; this message can safely be ignored")))) t) t) @@ -191,9 +220,13 @@ Tests are in the file tests.lisp and also make good examples. (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") + (get-host-by-name "foo.tninkpad.telent.net.") (NAME-SERVICE-ERROR () t) (:no-error nil)) t) @@ -209,13 +242,13 @@ Tests are in the file tests.lisp and also make good examples. #+internet-available (deftest simple-http-client-1 (handler-case - (let ((s (http-stream "ww.telent.net" 80 "HEAD /"))) - (let ((data (make-string 200))) - (setf data (subseq data 0 - (read-buf-nonblock data - (socket-make-stream s)))) - (princ data) - (> (length data) 0))) + (let ((s (http-stream "ww.telent.net" 80 "HEAD /"))) + (let ((data (make-string 200))) + (setf data (subseq data 0 + (read-buf-nonblock data + (socket-make-stream s)))) + (princ data) + (> (length data) 0))) (network-unreachable-error () 'network-unreachable)) t) @@ -226,17 +259,34 @@ Tests are in the file tests.lisp and also make good examples. ;; kernel: we set a size of x and then getsockopt() returns 2x. ;; This is why we compare with >= instead of = (handler-case - (let ((s (http-stream "ww.telent.net" 80 "HEAD /"))) - (setf (sockopt-receive-buffer s) 1975) - (let ((data (make-string 200))) - (setf data (subseq data 0 - (read-buf-nonblock data - (socket-make-stream s)))) - (and (> (length data) 0) - (>= (sockopt-receive-buffer s) 1975)))) + (let ((s (http-stream "ww.telent.net" 80 "HEAD /"))) + (setf (sockopt-receive-buffer s) 1975) + (let ((data (make-string 200))) + (setf data (subseq data 0 + (read-buf-nonblock data + (socket-make-stream s)))) + (and (> (length data) 0) + (>= (sockopt-receive-buffer s) 1975)))) (network-unreachable-error () 'network-unreachable)) t) +(deftest socket-open-p-true.1 + (socket-open-p (make-instance 'inet-socket :type :stream :protocol :tcp)) + t) +#+internet-available +(deftest socket-open-p-true.2 + (let ((s (make-instance 'inet-socket :type :stream :protocol :tcp))) + (unwind-protect + (progn + (socket-connect s #(127 0 0 1) 7) + (socket-open-p s)) + (socket-close s))) + t) +(deftest socket-open-p-false + (let ((s (make-instance 'inet-socket :type :stream :protocol :tcp))) + (socket-close s) + (socket-open-p s)) + nil) ;;; we don't have an automatic test for some of this yet. There's no ;;; simple way to run servers and have something automatically connect @@ -256,6 +306,59 @@ Tests are in the file tests.lisp and also make good examples. (loop (multiple-value-bind (buf len address port) (socket-receive s nil 500) (format t "Received ~A bytes from ~A:~A - ~A ~%" - len address port (subseq buf 0 (min 10 len))))))) - - + len address port (subseq buf 0 (min 10 len))))))) + +#+sb-thread +(deftest interrupt-io + (let (result) + (labels + ((client (port) + (setf result + (let ((s (make-instance 'inet-socket + :type :stream + :protocol :tcp))) + (socket-connect s #(127 0 0 1) port) + (let ((stream (socket-make-stream s + :input t + :output t + :buffering :none))) + (handler-case + (prog1 + (catch 'stop + (progn + (read-char stream) + (sleep 0.1) + (sleep 0.1) + (sleep 0.1))) + (close stream)) + (error (c) + c)))))) + (server () + (let ((s (make-instance 'inet-socket + :type :stream + :protocol :tcp))) + (setf (sockopt-reuse-address s) t) + (socket-bind s (make-inet-address "127.0.0.1") 0) + (socket-listen s 5) + (multiple-value-bind (* port) + (socket-name s) + (let* ((client (sb-thread:make-thread + (lambda () (client port)))) + (r (socket-accept s)) + (stream (socket-make-stream r + :input t + :output t + :buffering :none)) + (ok :ok)) + (socket-close s) + (sleep 5) + (sb-thread:interrupt-thread client + (lambda () (throw 'stop ok))) + (sleep 5) + (setf ok :not-ok) + (write-char #\x stream) + (close stream) + (socket-close r)))))) + (server)) + result) + :ok)