[usocket-cvs] r589 - usocket/branches/0.5.x/backend

[Chun Tian (binghe)]

Author: ctian
Date: Mon Mar 28 13:23:37 2011
New Revision: 589

Log:
[SBCL] SOCKET-CONNECT's TIMEOUT argument now works as a "connection timeout".

Modified:
   usocket/branches/0.5.x/backend/sbcl.lisp

Modified: usocket/branches/0.5.x/backend/sbcl.lisp
==============================================================================
--- usocket/branches/0.5.x/backend/sbcl.lisp	(original)
+++ usocket/branches/0.5.x/backend/sbcl.lisp	Mon Mar 28 13:23:37 2011
@@ -173,6 +173,8 @@
     (sb-bsd-sockets:operation-timeout-error . timeout-error)
     #-ecl
     (sb-sys:io-timeout . timeout-error)
+    #+sbcl
+    (sb-ext:timeout . timeout-error)
     (sb-bsd-sockets:socket-error . ,#'map-socket-error)
 
     ;; Nameservice errors: mapped to unknown-error
@@ -248,15 +250,17 @@
               (when (or local-host local-port)
                 (sb-bsd-sockets:socket-bind socket local-host local-port))
               (with-mapped-conditions (usocket)
-                (sb-bsd-sockets:socket-connect socket (host-to-vector-quad host) port)
+		(labels ((connect ()
+			   (sb-bsd-sockets:socket-connect socket (host-to-vector-quad host) port)))
+		  (if timeout
+		      (sb-ext:with-timeout timeout (connect))
+		      (connect)))
                 ;; Now that we're connected make the stream.
                 (setf (socket-stream usocket)
                       (sb-bsd-sockets:socket-make-stream socket
                                                          :input t
                                                          :output t
                                                          :buffering :full
-                                                         #+sbcl #+sbcl
-                                                         :timeout timeout
                                                          :element-type element-type))))
              (:datagram
               (when (or local-host local-port)
@@ -317,6 +321,7 @@
 
 	  ;; next time wait for event again if we had EAGAIN/EINTR
 	  ;; or else we'd enter a tight loop of failed accepts
+	  #+win32
 	  (setf (%ready-p socket) nil)))))
 
 ;; Sockets and their associated streams are modelled as