You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
347 lines
14 KiB
347 lines
14 KiB
diff --git sbcl-1.2.7/contrib/sb-bsd-sockets/tests.lisp sbcl-1.2.7/contrib/sb-bsd-sockets/tests.lisp
|
|
--- sbcl-1.2.7/contrib/sb-bsd-sockets/tests.lisp
|
|
+++ sbcl-1.2.7/contrib/sb-bsd-sockets/tests.lisp
|
|
@@ -35,15 +35,15 @@
|
|
;;; See https://bugs.launchpad.net/sbcl/+bug/659857
|
|
;;; Apparently getprotobyname_r on FreeBSD says -1 and EINTR
|
|
;;; for unknown protocols...
|
|
-#-(and freebsd sb-thread)
|
|
-#-(and dragonfly sb-thread)
|
|
-(deftest get-protocol-by-name/error
|
|
- (handler-case (get-protocol-by-name "nonexistent-protocol")
|
|
- (unknown-protocol ()
|
|
- t)
|
|
- (:no-error ()
|
|
- nil))
|
|
- t)
|
|
+;#-(and freebsd sb-thread)
|
|
+;#-(and dragonfly 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.smoke
|
|
;; make a socket
|
|
@@ -91,17 +91,17 @@
|
|
(:no-error nil))
|
|
t)
|
|
|
|
-#-win32
|
|
-(deftest make-inet6-socket.smoke
|
|
- (let ((s (make-instance 'inet6-socket :type :stream :protocol (get-protocol-by-name "tcp"))))
|
|
- (and (> (socket-file-descriptor s) 1) t))
|
|
- t)
|
|
+;#-win32
|
|
+;(deftest make-inet6-socket.smoke
|
|
+; (let ((s (make-instance 'inet6-socket :type :stream :protocol (get-protocol-by-name "tcp"))))
|
|
+; (and (> (socket-file-descriptor s) 1) t))
|
|
+; t)
|
|
|
|
-#-win32
|
|
-(deftest make-inet6-socket.keyword
|
|
- (let ((s (make-instance 'inet6-socket :type :stream :protocol :tcp)))
|
|
- (and (> (socket-file-descriptor s) 1) t))
|
|
- t)
|
|
+;#-win32
|
|
+;(deftest make-inet6-socket.keyword
|
|
+; (let ((s (make-instance 'inet6-socket :type :stream :protocol :tcp)))
|
|
+; (and (> (socket-file-descriptor s) 1) t))
|
|
+; t)
|
|
|
|
(deftest* (non-block-socket)
|
|
(let ((s (make-instance 'inet-socket :type :stream :protocol :tcp)))
|
|
@@ -109,52 +109,52 @@
|
|
(non-blocking-mode s))
|
|
t)
|
|
|
|
-(deftest inet-socket-bind
|
|
- (let* ((tcp (get-protocol-by-name "tcp"))
|
|
- (address (make-inet-address "127.0.0.1"))
|
|
- (s1 (make-instance 'inet-socket :type :stream :protocol tcp))
|
|
- (s2 (make-instance 'inet-socket :type :stream :protocol tcp)))
|
|
- (unwind-protect
|
|
- ;; Given the functions we've got so far, if you can think of a
|
|
- ;; better way to make sure the bind succeeded than trying it
|
|
- ;; twice, let me know
|
|
- (progn
|
|
- (socket-bind s1 address 0)
|
|
- (handler-case
|
|
- (let ((port (nth-value 1 (socket-name s1))))
|
|
- (socket-bind s2 address port)
|
|
- nil)
|
|
- (address-in-use-error () t)))
|
|
- (socket-close s1)
|
|
- (socket-close s2)))
|
|
- t)
|
|
-
|
|
-#-win32
|
|
-(deftest inet6-socket-bind
|
|
- (let* ((tcp (get-protocol-by-name "tcp"))
|
|
- (address (make-inet6-address "::1"))
|
|
- (s1 (make-instance 'inet6-socket :type :stream :protocol tcp))
|
|
- (s2 (make-instance 'inet6-socket :type :stream :protocol tcp)))
|
|
- (unwind-protect
|
|
- ;; Given the functions we've got so far, if you can think of a
|
|
- ;; better way to make sure the bind succeeded than trying it
|
|
- ;; twice, let me know
|
|
- (handler-case
|
|
- (socket-bind s1 address 0)
|
|
- (socket-error ()
|
|
- ;; This may mean no IPv6 support, can't fail a test
|
|
- ;; because of that
|
|
- t)
|
|
- (:no-error (x)
|
|
- (declare (ignore x))
|
|
- (handler-case
|
|
- (let ((port (nth-value 1 (socket-name s1))))
|
|
- (socket-bind s2 address port)
|
|
- nil)
|
|
- (address-in-use-error () t))))
|
|
- (socket-close s1)
|
|
- (socket-close s2)))
|
|
- t)
|
|
+;(deftest inet-socket-bind
|
|
+; (let* ((tcp (get-protocol-by-name "tcp"))
|
|
+; (address (make-inet-address "127.0.0.1"))
|
|
+; (s1 (make-instance 'inet-socket :type :stream :protocol tcp))
|
|
+; (s2 (make-instance 'inet-socket :type :stream :protocol tcp)))
|
|
+; (unwind-protect
|
|
+; ;; Given the functions we've got so far, if you can think of a
|
|
+; ;; better way to make sure the bind succeeded than trying it
|
|
+; ;; twice, let me know
|
|
+; (progn
|
|
+; (socket-bind s1 address 0)
|
|
+; (handler-case
|
|
+; (let ((port (nth-value 1 (socket-name s1))))
|
|
+; (socket-bind s2 address port)
|
|
+; nil)
|
|
+; (address-in-use-error () t)))
|
|
+; (socket-close s1)
|
|
+; (socket-close s2)))
|
|
+; t)
|
|
+
|
|
+;#-win32
|
|
+;(deftest inet6-socket-bind
|
|
+; (let* ((tcp (get-protocol-by-name "tcp"))
|
|
+; (address (make-inet6-address "::1"))
|
|
+; (s1 (make-instance 'inet6-socket :type :stream :protocol tcp))
|
|
+; (s2 (make-instance 'inet6-socket :type :stream :protocol tcp)))
|
|
+; (unwind-protect
|
|
+; ;; Given the functions we've got so far, if you can think of a
|
|
+; ;; better way to make sure the bind succeeded than trying it
|
|
+; ;; twice, let me know
|
|
+; (handler-case
|
|
+; (socket-bind s1 address 0)
|
|
+; (socket-error ()
|
|
+; ;; This may mean no IPv6 support, can't fail a test
|
|
+; ;; because of that
|
|
+; t)
|
|
+; (:no-error (x)
|
|
+; (declare (ignore x))
|
|
+; (handler-case
|
|
+; (let ((port (nth-value 1 (socket-name s1))))
|
|
+; (socket-bind s2 address port)
|
|
+; nil)
|
|
+; (address-in-use-error () t))))
|
|
+; (socket-close s1)
|
|
+; (socket-close s2)))
|
|
+; t)
|
|
|
|
(deftest* (simple-sockopt-test)
|
|
;; test we can set SO_REUSEADDR on a socket and retrieve it, and in
|
|
@@ -221,37 +221,37 @@
|
|
;;; to look at /etc/syslog.conf or local equivalent to find out where
|
|
;;; the message ended up
|
|
|
|
-#-win32
|
|
-(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 (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)
|
|
+;#-win32
|
|
+;(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 (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)
|
|
|
|
|
|
;;; these require that the internet (or bits of it, at least) is available
|
|
@@ -367,59 +367,59 @@
|
|
len address port (subseq buf 0 (min 10 len)))))))
|
|
|
|
#+sb-thread
|
|
-(deftest interrupt-io
|
|
- (let (result)
|
|
- (labels
|
|
- ((client (port)
|
|
- (setf result
|
|
- (let ((s (make-instance 'inet-socket
|
|
- :type :stream
|
|
- :protocol :tcp)))
|
|
- (socket-connect s #(127 0 0 1) port)
|
|
- (let ((stream (socket-make-stream s
|
|
- :input t
|
|
- :output t
|
|
- :buffering :none)))
|
|
- (handler-case
|
|
- (prog1
|
|
- (catch 'stop
|
|
- (progn
|
|
- (read-char stream)
|
|
- (sleep 0.1)
|
|
- (sleep 0.1)
|
|
- (sleep 0.1)))
|
|
- (close stream))
|
|
- (error (c)
|
|
- c))))))
|
|
- (server ()
|
|
- (let ((s (make-instance 'inet-socket
|
|
- :type :stream
|
|
- :protocol :tcp)))
|
|
- (setf (sockopt-reuse-address s) t)
|
|
- (socket-bind s (make-inet-address "127.0.0.1") 0)
|
|
- (socket-listen s 5)
|
|
- (multiple-value-bind (* port)
|
|
- (socket-name s)
|
|
- (let* ((client (sb-thread:make-thread
|
|
- (lambda () (client port))))
|
|
- (r (socket-accept s))
|
|
- (stream (socket-make-stream r
|
|
- :input t
|
|
- :output t
|
|
- :buffering :none))
|
|
- (ok :ok))
|
|
- (socket-close s)
|
|
- (sleep 5)
|
|
- (sb-thread:interrupt-thread client
|
|
- (lambda () (throw 'stop ok)))
|
|
- (sleep 5)
|
|
- (setf ok :not-ok)
|
|
- (write-char #\x stream)
|
|
- (close stream)
|
|
- (socket-close r))))))
|
|
- (server))
|
|
- result)
|
|
- :ok)
|
|
+;(deftest interrupt-io
|
|
+; (let (result)
|
|
+; (labels
|
|
+; ((client (port)
|
|
+; (setf result
|
|
+; (let ((s (make-instance 'inet-socket
|
|
+; :type :stream
|
|
+; :protocol :tcp)))
|
|
+; (socket-connect s #(127 0 0 1) port)
|
|
+; (let ((stream (socket-make-stream s
|
|
+; :input t
|
|
+; :output t
|
|
+; :buffering :none)))
|
|
+; (handler-case
|
|
+; (prog1
|
|
+; (catch 'stop
|
|
+; (progn
|
|
+; (read-char stream)
|
|
+; (sleep 0.1)
|
|
+; (sleep 0.1)
|
|
+; (sleep 0.1)))
|
|
+; (close stream))
|
|
+; (error (c)
|
|
+; c))))))
|
|
+; (server ()
|
|
+; (let ((s (make-instance 'inet-socket
|
|
+; :type :stream
|
|
+; :protocol :tcp)))
|
|
+; (setf (sockopt-reuse-address s) t)
|
|
+; (socket-bind s (make-inet-address "127.0.0.1") 0)
|
|
+; (socket-listen s 5)
|
|
+; (multiple-value-bind (* port)
|
|
+; (socket-name s)
|
|
+; (let* ((client (sb-thread:make-thread
|
|
+; (lambda () (client port))))
|
|
+; (r (socket-accept s))
|
|
+; (stream (socket-make-stream r
|
|
+; :input t
|
|
+; :output t
|
|
+; :buffering :none))
|
|
+; (ok :ok))
|
|
+; (socket-close s)
|
|
+; (sleep 5)
|
|
+; (sb-thread:interrupt-thread client
|
|
+; (lambda () (throw 'stop ok)))
|
|
+; (sleep 5)
|
|
+; (setf ok :not-ok)
|
|
+; (write-char #\x stream)
|
|
+; (close stream)
|
|
+; (socket-close r))))))
|
|
+; (server))
|
|
+; result)
|
|
+; :ok)
|
|
|
|
(defmacro with-client-and-server ((server-socket-var client-socket-var) &body body)
|
|
(let ((listen-socket (gensym "LISTEN-SOCKET")))
|
|
@@ -478,5 +478,6 @@
|
|
(define-shutdown-test ,(make-name 'shutdown.client.ub8)
|
|
client server (unsigned-byte 8) ,direction)))))
|
|
|
|
- (define-shutdown-tests :output)
|
|
- (define-shutdown-tests :io))
|
|
+; (define-shutdown-tests :output)
|
|
+; (define-shutdown-tests :io))
|
|
+)
|