(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)
+
+(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"))))
;; 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)
(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)
#+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)
(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
;;; 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)
(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)
#+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)
;; 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
(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)))))))
+
+
projects / sbcl.git / blobdiff