X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=contrib%2Fsb-bsd-sockets%2Ftests.lisp;h=6f2201736b848271f272779889452bfe3e68ff95;hb=4e168fe00bbbb10196ef0bbfad2e85f7d361f5ae;hp=ba41bc5fb354e892e29dcf9725a0a119b736ead2;hpb=8a3c76ab9725a199aa06a0abc018e096271a0f75;p=sbcl.git diff --git a/contrib/sb-bsd-sockets/tests.lisp b/contrib/sb-bsd-sockets/tests.lisp index ba41bc5..6f22017 100644 --- a/contrib/sb-bsd-sockets/tests.lisp +++ b/contrib/sb-bsd-sockets/tests.lisp @@ -12,6 +12,26 @@ (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")))) @@ -28,18 +48,31 @@ ;; 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 ;; 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) @@ -67,9 +100,9 @@ (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) + (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))) t) @@ -99,24 +132,24 @@ #+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) @@ -129,8 +162,8 @@ (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 @@ -139,29 +172,34 @@ ;;; the message ended up (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 ;; 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) @@ -179,9 +217,13 @@ (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) @@ -197,13 +239,13 @@ #+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) @@ -214,17 +256,34 @@ ;; 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 @@ -244,6 +303,6 @@ (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))))))) + +