X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=contrib%2Fsb-bsd-sockets%2Ftests.lisp;h=ba41bc5fb354e892e29dcf9725a0a119b736ead2;hb=d1441ffce0db0043ccbcb27fa5ab590e44a85994;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..ba41bc5 100644
--- a/contrib/sb-bsd-sockets/tests.lisp
+++ b/contrib/sb-bsd-sockets/tests.lisp
@@ -1,18 +1,6 @@
(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)
;;; a real address
@@ -102,6 +90,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 +109,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,27 +138,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 "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)
- (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
+ (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, at least) is available
#+internet-available
(deftest get-host-by-name