X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=contrib%2Fsb-bsd-sockets%2Ftests.lisp;h=3fec556b729eec3257e0cb32248452188b8c84e8;hb=fb8533122551bbb7aea669f40bc91c1211809b58;hp=804fe5ba0b50ddec2948793d526b25cae9e39849;hpb=2e274c84832d4b9a18adc66b5f15b29e217d012b;p=sbcl.git diff --git a/contrib/sb-bsd-sockets/tests.lisp b/contrib/sb-bsd-sockets/tests.lisp index 804fe5b..3fec556 100644 --- a/contrib/sb-bsd-sockets/tests.lisp +++ b/contrib/sb-bsd-sockets/tests.lisp @@ -1,5 +1,5 @@ (defpackage "SB-BSD-SOCKETS-TEST" - (:use "CL" "SB-BSD-SOCKETS" "RT")) + (:use "CL" "SB-BSD-SOCKETS" "SB-RT")) #|| @@ -102,6 +102,11 @@ Tests are in the file tests.lisp and also make good examples. ((or (>= i (length buffer)) (not c) (eq c eof)) i) (setf (elt buffer i) c)))) +#+internet-available +(deftest name-service-return-type + (vectorp (host-ent-address (get-host-by-address #(127 0 0 1)))) + t) + ;;; these require that the echo services are turned on in inetd #+internet-available (deftest simple-tcp-client @@ -116,6 +121,18 @@ Tests are in the file tests.lisp and also make good examples. 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)))) + (socket-close s))) + t) + +#+internet-available (deftest simple-udp-client (let ((s (make-instance 'inet-socket :type :datagram :protocol (get-protocol-by-name "udp"))) (data (make-string 200))) @@ -133,19 +150,35 @@ 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 -#-sunos (deftest simple-local-client - (let ((s (make-instance 'local-socket :type :datagram))) - (format t "~A~%" s) - (socket-connect s "/dev/log") - (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)) + (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")))) + t) t) -;;; these require that the internet (or bits of it, atleast) is available +;;; these require that the internet (or bits of it, at least) is available #+internet-available (deftest get-host-by-name