X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=contrib%2Fsb-bsd-sockets%2Ftests.lisp;h=827b7c09e2e485272036fa111c45cf919fd1f4ab;hb=1483e561a090d9f07687da27f8dd10fcd4152be1;hp=f96e82a3d40f891fde11729d649b70c99e561076;hpb=07111ea2a4131f731f5ac23e79cb3d715970a92e;p=sbcl.git
diff --git a/contrib/sb-bsd-sockets/tests.lisp b/contrib/sb-bsd-sockets/tests.lisp
index f96e82a..827b7c0 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"))))
@@ -40,18 +54,31 @@ Tests are in the file tests.lisp and also make good examples.
;; 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)
@@ -79,9 +106,9 @@ Tests are in the file tests.lisp and also make good examples.
(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)
@@ -102,17 +129,34 @@ 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
(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))))
+ (socket-close s)))
t)
#+internet-available
@@ -124,8 +168,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
@@ -133,27 +177,40 @@ 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 "Connecting ~A... " s)
- (finish-output)
- (handler-case
- (socket-connect s "/dev/log")
- (socket-error ()
- (setq s (make-instance 'local-socket :type :stream))
- (format t "failed~%Retrying with ~A... " s)
+ #-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 (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)
- (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))
+ (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
@@ -166,9 +223,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)
@@ -184,13 +245,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)
@@ -201,17 +262,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
@@ -231,6 +309,6 @@ 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)))))))
+
+