0.8.21.49: Fixes for OS X 10.4 "Tiger"
[sbcl.git] / contrib / sb-bsd-sockets / tests.lisp
index 22512f5..77b1e57 100644 (file)
@@ -1,17 +1,5 @@
 (defpackage "SB-BSD-SOCKETS-TEST"
-  (:use "CL" "SB-BSD-SOCKETS" "RT"))
-
-#||
-
-<H1>Tests</h1>
-
-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 <tt>tests.lisp</tt> and also make good examples.
-
-||#
+  (:use "CL" "SB-BSD-SOCKETS" "SB-RT"))
 
 (in-package :sb-bsd-sockets-test)
 
@@ -102,8 +90,13 @@ Tests are in the file <tt>tests.lisp</tt> and also make good examples.
         ((or (>= i (length buffer)) (not c) (eq c eof)) i)
       (setf (elt buffer i) c))))
 
-;;; these require that the echo services are turned on in inetd
+#+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)))
@@ -115,6 +108,19 @@ Tests are in the file <tt>tests.lisp</tt> and also make good examples.
          (> (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
 (deftest simple-udp-client
   (let ((s (make-instance 'inet-socket :type :datagram :protocol (get-protocol-by-name "udp")))
         (data (make-string 200)))
@@ -127,39 +133,55 @@ Tests are in the file <tt>tests.lisp</tt> and also make good examples.
        (> (length data) 0))))
   t)
 
-#||
-<h2>Unix-domain sockets</h2>
-
-A fairly rudimentary test that connects to the syslog socket and sends a 
-message.  Priority 7 is kern.debug; you'll probably want to look at
-/etc/syslog.conf or local equivalent to find out where the message ended up
-||#
-
-(deftest simple-unix-client
-    (let ((s (make-instance 'unix-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 unix-domain client code; this message can safely be ignored")
-       t))
-  t)
-
-
-;;; these require that the internet (or bits of it, atleast) is available
-
+;;; A fairly rudimentary test that connects to the syslog socket and
+;;; sends a message.  Priority 7 is kern.debug; you'll probably want
+;;; to look at /etc/syslog.conf or local equivalent to find out where
+;;; the message ended up
+
+(deftest simple-local-client
+    (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
   (equalp (car (host-ent-addresses (get-host-by-name "a.root-servers.net")))
           #(198 41 0 4))
   t)
 
+#+internet-available
 (deftest get-host-by-address
     (host-ent-name (get-host-by-address #(198 41 0 4)))
   "a.root-servers.net")
 
 (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)
@@ -172,6 +194,7 @@ message.  Priority 7 is kern.debug; you'll probably want to look at
       (format stream "~A HTTP/1.0~%~%" request))
     s))
 
+#+internet-available
 (deftest simple-http-client-1
     (handler-case
        (let ((s (http-stream "ww.telent.net" 80 "HEAD /")))
@@ -185,6 +208,7 @@ message.  Priority 7 is kern.debug; you'll probably want to look at
   t)
 
 
+#+internet-available
 (deftest sockopt-receive-buffer
     ;; on Linux x86, the receive buffer size appears to be doubled in the
     ;; kernel: we set a size of x and then getsockopt() returns 2x.