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?

diff --git a/NEWS b/NEWS
index 8754595..1951018 100644 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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"