From 0fe5525f1f9d9f5eff63e583b5b7b19c0e1cb933 Mon Sep 17 00:00:00 2001 From: Christophe Rhodes Date: Wed, 1 Jun 2005 13:59:02 +0000 Subject: [PATCH] 0.9.1.16: Implement SOCKET-OPEN-P mostly per Tony Martinez sbcl-devel 2004-10-23. ... add a test or two for it, which look a bit weird to me but what do I know? --- NEWS | 3 ++- contrib/sb-bsd-sockets/defpackage.lisp | 4 ++-- contrib/sb-bsd-sockets/sb-bsd-sockets.texinfo | 2 ++ contrib/sb-bsd-sockets/sockets.lisp | 30 ++++++++++++++++--------- contrib/sb-bsd-sockets/tests.lisp | 17 ++++++++++++++ version.lisp-expr | 2 +- 6 files changed, 44 insertions(+), 14 deletions(-) diff --git a/NEWS b/NEWS index 8754595..1951018 100644 --- a/NEWS +++ b/NEWS @@ -15,7 +15,8 @@ changes in sbcl-0.9.2 relative to sbcl-0.9.1: * bug fix: more cleanups to the floating point exception handling on x86-64 (thanks to James Knight) * contrib improvement: it's harder to cause SOCKET-CLOSE to close() - the wrong file descriptor. (thanks to Tony Martinez) + the wrong file descriptor; implementation of SOCKET-OPEN-P. + (thanks to Tony Martinez) * fixed some bugs revealed by Paul Dietz' test suite: ** Invalid dotted lists no longer raise a read error when *READ-SUPPRESS* is T diff --git a/contrib/sb-bsd-sockets/defpackage.lisp b/contrib/sb-bsd-sockets/defpackage.lisp index 6779880..6e07ad5 100644 --- a/contrib/sb-bsd-sockets/defpackage.lisp +++ b/contrib/sb-bsd-sockets/defpackage.lisp @@ -35,8 +35,8 @@ socket-send socket-receive socket-recv socket-name socket-peername socket-listen socket-close socket-file-descriptor - socket-family socket-protocol socket-type - socket-make-stream get-protocol-by-name + socket-family socket-protocol socket-open-p + socket-type socket-make-stream get-protocol-by-name get-host-by-name get-host-by-address host-ent diff --git a/contrib/sb-bsd-sockets/sb-bsd-sockets.texinfo b/contrib/sb-bsd-sockets/sb-bsd-sockets.texinfo index 730f55a..3276ba2 100644 --- a/contrib/sb-bsd-sockets/sb-bsd-sockets.texinfo +++ b/contrib/sb-bsd-sockets/sb-bsd-sockets.texinfo @@ -69,6 +69,8 @@ than "network-endian integers". @include fun-sb-bsd-sockets-socket-listen.texinfo +@include fun-sb-bsd-sockets-socket-open-p.texinfo + @include fun-sb-bsd-sockets-socket-close.texinfo @include fun-sb-bsd-sockets-socket-make-stream.texinfo diff --git a/contrib/sb-bsd-sockets/sockets.lisp b/contrib/sb-bsd-sockets/sockets.lisp index efbd0e4..bb4e7c1 100644 --- a/contrib/sb-bsd-sockets/sockets.lisp +++ b/contrib/sb-bsd-sockets/sockets.lisp @@ -221,10 +221,20 @@ grow to before new connection attempts are refused. See also listen(2)")) (if (= r -1) (socket-error "listen")))) +(defgeneric socket-open-p (socket) + (:documentation "Return true if SOCKET is open; otherwise, return false.") + (:method ((socket t)) (error 'type-error + :datum socket :expected-type 'socket))) + +(defmethod socket-open-p ((socket socket)) + (if (slot-boundp socket 'stream) + (open-stream-p (slot-value socket 'stream)) + (/= -1 (socket-file-descriptor socket)))) + (defgeneric socket-close (socket) - (:documentation "Close SOCKET. May throw any kind of error that write(2) would have -thrown. If SOCKET-MAKE-STREAM has been called, calls CLOSE on that -stream instead")) + (:documentation "Close SOCKET. May throw any kind of error that +write(2) would have thrown. If SOCKET-MAKE-STREAM has been called, +calls CLOSE on that stream instead")) (defmethod socket-close ((socket socket)) ;; the close(2) manual page has all kinds of warning about not @@ -244,9 +254,9 @@ stream instead")) (cond ((eql fd -1) ; already closed nil) ((slot-boundp socket 'stream) - (close (slot-value socket 'stream)) ;; closes fd - (setf (slot-value socket 'file-descriptor) -1) - (slot-makunbound socket 'stream)) + (unwind-protect (close (slot-value socket 'stream)) ;; closes fd + (setf (slot-value socket 'file-descriptor) -1) + (slot-makunbound socket 'stream))) (t (sb-ext:cancel-finalization socket) (handler-case @@ -259,12 +269,12 @@ stream instead")) nil)))))) -(defgeneric socket-make-stream (socket &rest args) - (:documentation "Find or create a STREAM that can be used for IO -on SOCKET (which must be connected). ARGS are passed onto +(defgeneric socket-make-stream (socket &rest args) + (:documentation "Find or create a STREAM that can be used for IO on +SOCKET (which must be connected). ARGS are passed onto SB-SYS:MAKE-FD-STREAM.")) -(defmethod socket-make-stream ((socket socket) &rest args) +(defmethod socket-make-stream ((socket socket) &rest args) (let ((stream (and (slot-boundp socket 'stream) (slot-value socket 'stream)))) (unless stream diff --git a/contrib/sb-bsd-sockets/tests.lisp b/contrib/sb-bsd-sockets/tests.lisp index 77b1e57..e2abc15 100644 --- a/contrib/sb-bsd-sockets/tests.lisp +++ b/contrib/sb-bsd-sockets/tests.lisp @@ -225,6 +225,23 @@ (network-unreachable-error () 'network-unreachable)) t) +(deftest socket-open-p-true.1 + (socket-open-p (make-instance 'inet-socket :type :stream :protocol :tcp)) + t) +#+internet-available +(deftest socket-open-p-true.2 + (let ((s (make-instance 'inet-socket :type :stream :protocol :tcp))) + (unwind-protect + (progn + (socket-connect s #(127 0 0 1) 7) + (socket-open-p s)) + (socket-close s))) + t) +(deftest socket-open-p-false + (let ((s (make-instance 'inet-socket :type :stream :protocol :tcp))) + (socket-close s) + (socket-open-p s)) + nil) ;;; we don't have an automatic test for some of this yet. There's no ;;; simple way to run servers and have something automatically connect diff --git a/version.lisp-expr b/version.lisp-expr index 9a41525..60cf6f4 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -17,4 +17,4 @@ ;;; checkins which aren't released. (And occasionally for internal ;;; versions, especially for internal versions off the main CVS ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".) -"0.9.1.15" +"0.9.1.16" -- 1.7.10.4