X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=contrib%2Fsb-bsd-sockets%2Ftests.lisp;h=95fcf43ae8ec4579fc04718fb2be34c52ed31c24;hb=2d68a49fe9d30f687da45cfe7a02b497cb91137c;hp=776878c7f5425e2829b95c6183a91c9d8ac629db;hpb=6a55e39bd39283f56e197cc8719035a9bdd93987;p=sbcl.git

diff --git a/contrib/sb-bsd-sockets/tests.lisp b/contrib/sb-bsd-sockets/tests.lisp
index 776878c..95fcf43 100644
--- a/contrib/sb-bsd-sockets/tests.lisp
+++ b/contrib/sb-bsd-sockets/tests.lisp
@@ -89,27 +89,24 @@
     (non-blocking-mode s))
   t)
 
-(defun do-gc-portably ()
-  ;; cmucl on linux has generational gc with a keyword argument,
-  ;; sbcl GC function takes same arguments no matter what collector is in
-  ;; use
-  #+(or sbcl gencgc) (SB-EXT:gc :full t)
-  ;; other platforms have full gc or nothing
-  #-(or sbcl gencgc) (sb-ext:gc))
-
 (deftest inet-socket-bind
-  (let ((s (make-instance 'inet-socket :type :stream :protocol (get-protocol-by-name "tcp"))))
-    ;; 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
-    ;; 1974 has no special significance, unless you're the same age as me
-    (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)
-      (address-in-use-error () t)))
+  (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)
 
 (deftest* (simple-sockopt-test)
@@ -365,3 +362,63 @@
         (server))
       result)
   :ok)
+
+(defmacro with-client-and-server ((server-socket-var client-socket-var) &body body)
+  (let ((listen-socket (gensym "LISTEN-SOCKET")))
+    `(let ((,listen-socket (make-instance 'inet-socket
+                                          :type :stream
+                                          :protocol :tcp))
+           (,client-socket-var (make-instance 'inet-socket
+                                              :type :stream
+                                              :protocol :tcp))
+           (,server-socket-var))
+      (unwind-protect
+           (progn
+             (setf (sockopt-reuse-address ,listen-socket) t)
+             (socket-bind ,listen-socket (make-inet-address "127.0.0.1") 0)
+             (socket-listen ,listen-socket 5)
+             (socket-connect ,client-socket-var (make-inet-address "127.0.0.1")
+                             (nth-value 1 (socket-name ,listen-socket)))
+             (setf ,server-socket-var (socket-accept ,listen-socket))
+             ,@body)
+        (socket-close ,client-socket-var)
+        (socket-close ,listen-socket)
+        (when ,server-socket-var
+          (socket-close ,server-socket-var))))))
+
+;; For stream sockets, make sure a shutdown of the output direction
+;; translates into an END-OF-FILE on the other end, no matter which
+;; end performs the shutdown and independent of the element-type of
+;; the stream.
+(macrolet
+    ((define-shutdown-test (name who-shuts-down who-reads element-type direction)
+       `(deftest ,name
+          (with-client-and-server (client server)
+            (socket-shutdown ,who-shuts-down :direction ,direction)
+            (handler-case
+                (sb-ext:with-timeout 2
+                  (,(if (eql element-type 'character)
+                        'read-char 'read-byte)
+                   (socket-make-stream
+                    ,who-reads :input t :output t
+                    :element-type ',element-type)))
+              (end-of-file ()
+                :ok)
+              (sb-ext:timeout () :timeout)))
+          :ok))
+     (define-shutdown-tests (direction)
+       (flet ((make-name (name)
+                (intern (concatenate
+                         'string (string name) "." (string direction)))))
+         `(progn
+            (define-shutdown-test ,(make-name 'shutdown.server.character)
+              server client character ,direction)
+            (define-shutdown-test ,(make-name 'shutdown.server.ub8)
+              server client (unsigned-byte 8) ,direction)
+            (define-shutdown-test ,(make-name 'shutdown.client.character)
+              client server character ,direction)
+            (define-shutdown-test ,(make-name 'shutdown.client.ub8)
+              client server (unsigned-byte 8) ,direction)))))
+
+  (define-shutdown-tests :output)
+  (define-shutdown-tests :io))