X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=contrib%2Fsb-bsd-sockets%2Ftests.lisp;h=7ce9d39ae5e717e4ac355864ab4fc84a2a202cac;hb=a37b7e2a4c93398af954c3f03c5412ead1c1c828;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..7ce9d39 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)