[usocket-cvs] r660 - in usocket/trunk: . backend test
Chun Tian (binghe)
ctian at common-lisp.net
Wed May 11 13:08:20 UTC 2011
Author: ctian
Date: Wed May 11 09:08:19 2011
New Revision: 660
Log:
Merge all changes from branch 0.5.x (r640-r659) before tagging 0.5.2
Added:
usocket/trunk/test/wait-for-input.lisp
- copied unchanged from r659, /usocket/branches/0.5.x/test/wait-for-input.lisp
Modified:
usocket/trunk/CHANGES
usocket/trunk/backend/abcl.lisp
usocket/trunk/backend/clisp.lisp
usocket/trunk/backend/lispworks.lisp
usocket/trunk/backend/sbcl.lisp
usocket/trunk/package.lisp
usocket/trunk/server.lisp
usocket/trunk/test/package.lisp
usocket/trunk/test/test-datagram.lisp
usocket/trunk/test/test-usocket.lisp
usocket/trunk/usocket-test.asd
usocket/trunk/usocket.lisp
Modified: usocket/trunk/CHANGES
==============================================================================
--- usocket/trunk/CHANGES (original)
+++ usocket/trunk/CHANGES Wed May 11 09:08:19 2011
@@ -1,10 +1,13 @@
-0.5.0:
+0.5.2:
-* New supported platform: Macintosh Common Lisp (5.0 and up, plus RMCL)
-* Support for UDP (datagram-usocket) was added (for all supported platform except MCL)
-* Add WAIT-FOR-INPUT support for SBCL and ECL on win32.
-* Simple TCP and UDP server API: SOCKET-SERVER
-* Lots of bug fixed since 0.4.1
+* General: [SBCL] SOCKET-CONNECT's TIMEOUT argument was limited on non-Windows platforms.
+* Bugfix: [CLISP] WAIT-FOR-INPUT now functions right (with/without READY-ONLY), this made Hunchentoot working on CLISP. (Thanks to Anton Vodonosov <avodonosov at yandex.ru>)
+* Bugfix: [ABCL] Fix SOCKET-ACCEPT to follow the documented API so that when called without an :ELEMENT-TYPE argument. (Thanks to Mark Evenson, the ABCL developer)
+* Bugfix: [LispWorks] Fixed SOCKET-ACCEPT (Windows only) on WAIT-FOR-INPUTed sockets.
+* Bugfix: [SBCL, ECL] Fixed wrongly STATE set/unset for WAIT-FOR-INPUT on Windows (report by Elliott Slaughter)
+* Enhancement: Additional NAME keyword argument for SOCKET-SERVER for setting the server thread name.
+* Enhancement: [ABCL] GET-ADDRESS now works with underlying IP6 addresses.
+* Enhancement: [CLISP] missing GET-LOCAL-* methods for STREAM-SERVER-USOCKET was now added.
0.5.1:
@@ -21,6 +24,15 @@
* Bugfix: [CMUCL] Fixed SOCKET-SEND on unconnected usockets under Unicode version of CMUCL.
* Bugfix: [CLISP] Fixed and confirmed UDP (Datagram) support (RAWSOCK version).
+0.5.0:
+
+* New supported platform: Macintosh Common Lisp (5.0 and up, plus RMCL)
+* Support for UDP (datagram-usocket) was added (for all supported platform except MCL)
+* Add WAIT-FOR-INPUT support for SBCL and ECL on win32.
+* Simple TCP and UDP server API: SOCKET-SERVER
+* Completely rewritten full-feature ABCL backends using latest Java interfaces
+* Lots of bug fixed since 0.4.1
+
[TODO]
* New feature: CLISP support some advanced TCP features which CLISP's SOCKET interface not provide
Modified: usocket/trunk/backend/abcl.lisp
==============================================================================
--- usocket/trunk/backend/abcl.lisp (original)
+++ usocket/trunk/backend/abcl.lisp Wed May 11 09:08:19 2011
@@ -67,7 +67,7 @@
(defvar $@connect/Socket/1 (jmethod $*Socket "connect" $*SocketAddress))
(defvar $@connect/Socket/2 (jmethod $*Socket "connect" $*SocketAddress $*int))
(defvar $@connect/SocketChannel/1 (jmethod $*SocketChannel "connect" $*SocketAddress))
-(defvar $@getAddress/0 (jmethod $*Inet4Address "getAddress"))
+(defvar $@getAddress/0 (jmethod $*InetAddress "getAddress"))
(defvar $@getAllByName/1 (jmethod $*InetAddress "getAllByName" $*String))
(defvar $@getByName/1 (jmethod $*InetAddress "getByName" $*String))
(defvar $@getChannel/DatagramSocket/0 (jmethod $*DatagramSocket "getChannel"))
@@ -170,9 +170,13 @@
(labels ((jbyte (n)
(let ((byte (jarray-ref array n)))
(if (minusp byte) (+ 256 byte) byte))))
- (if (= 4 length)
- (vector (jbyte 0) (jbyte 1) (jbyte 2) (jbyte 3))
- nil))))) ; not a IPv4 address?!
+ (cond
+ ((= 4 length)
+ (vector (jbyte 0) (jbyte 1) (jbyte 2) (jbyte 3)))
+ ((= 16 length)
+ (vector (jbyte 0) (jbyte 1) (jbyte 2) (jbyte 3)
+ (jbyte 4) (jbyte 5) (jbyte 6) (jbyte 7)))
+ (t nil)))))) ; neither a IPv4 nor IPv6 address?!
(defun get-hosts-by-name (name)
(with-mapped-conditions ()
@@ -249,9 +253,13 @@
;;; SOCKET-ACCEPT
-(defmethod socket-accept ((usocket stream-server-usocket) &key (element-type 'character))
+(defmethod socket-accept ((usocket stream-server-usocket)
+ &key (element-type 'character element-type-p))
(with-mapped-conditions (usocket)
(let* ((client-socket (jcall $@accept/0 (socket usocket)))
+ (element-type (if element-type-p
+ element-type
+ (element-type usocket)))
(stream (ext:get-socket-stream client-socket :element-type element-type)))
(make-stream-socket :stream stream :socket client-socket))))
Modified: usocket/trunk/backend/clisp.lisp
==============================================================================
--- usocket/trunk/backend/clisp.lisp (original)
+++ usocket/trunk/backend/clisp.lisp Wed May 11 09:08:19 2011
@@ -191,6 +191,10 @@
(socket:socket-stream-local (socket usocket) t)
(values (dotted-quad-to-vector-quad address) port)))
+(defmethod get-local-name ((usocket stream-server-usocket))
+ (values (get-local-address usocket)
+ (get-local-port usocket)))
+
(defmethod get-peer-name ((usocket stream-usocket))
(multiple-value-bind
(address port)
@@ -200,12 +204,19 @@
(defmethod get-local-address ((usocket usocket))
(nth-value 0 (get-local-name usocket)))
+(defmethod get-local-address ((usocket stream-server-usocket))
+ (dotted-quad-to-vector-quad
+ (socket:socket-server-host (socket usocket))))
+
(defmethod get-peer-address ((usocket usocket))
(nth-value 0 (get-peer-name usocket)))
(defmethod get-local-port ((usocket usocket))
(nth-value 1 (get-local-name usocket)))
+(defmethod get-local-port ((usocket stream-server-usocket))
+ (socket:socket-server-port (socket usocket)))
+
(defmethod get-peer-port ((usocket usocket))
(nth-value 1 (get-peer-name usocket)))
@@ -232,9 +243,9 @@
(socket:socket-status request-list)))
(sockets (wait-list-waiters wait-list)))
(do* ((x (pop sockets) (pop sockets))
- (y (pop status-list) (pop status-list)))
+ (y (cdr (pop status-list)) (cdr (pop status-list))))
((null x))
- (when (eq y :INPUT)
+ (when (member y '(T :INPUT))
(setf (state x) :READ)))
wait-list))))
Modified: usocket/trunk/backend/lispworks.lisp
==============================================================================
--- usocket/trunk/backend/lispworks.lisp (original)
+++ usocket/trunk/backend/lispworks.lisp Wed May 11 09:08:19 2011
@@ -318,18 +318,28 @@
#+lispworks4.1 (comm::create-tcp-socket-for-service port))))
(make-stream-server-socket sock :element-type element-type)))
+;; Note: COMM::GET-FD-FROM-SOCKET contains addition socket wait operations, which
+;; should NOT be applied on socket FDs who have already been called on W-F-I,
+;; so we have to check the %READY-P slot to decide if this waiting is necessary,
+;; or SOCKET-ACCEPT will just hang. -- Chun Tian (binghe), May 1, 2011
+
(defmethod socket-accept ((usocket stream-server-usocket) &key element-type)
- (let* ((sock (with-mapped-conditions (usocket)
- (comm::get-fd-from-socket (socket usocket))))
+ (let* ((socket (with-mapped-conditions (usocket)
+ #+win32
+ (if (%ready-p usocket)
+ (comm::accept-connection-to-socket (socket usocket))
+ (comm::get-fd-from-socket (socket usocket)))
+ #-win32
+ (comm::get-fd-from-socket (socket usocket))))
(stream (make-instance 'comm:socket-stream
- :socket sock
+ :socket socket
:direction :io
:element-type (or element-type
(element-type usocket)))))
#+win32
- (when sock
+ (when socket
(setf (%ready-p usocket) nil))
- (make-stream-socket :socket sock :stream stream)))
+ (make-stream-socket :socket socket :stream stream)))
;; Sockets and their streams are different objects
;; close the stream in order to make sure buffers
Modified: usocket/trunk/backend/sbcl.lisp
==============================================================================
--- usocket/trunk/backend/sbcl.lisp (original)
+++ usocket/trunk/backend/sbcl.lisp Wed May 11 09:08:19 2011
@@ -215,7 +215,7 @@
;;; and WITH-LOCAL-INTERRUPTS were for. :) But yeah, it's miles saner than
;;; the SB-EXT:WITH-TIMEOUT. -- Nikodemus Siivola <nikodemus at random-state.net>
-#+sbcl
+#+(and sbcl (not win32))
(defmacro %with-timeout ((seconds timeout-form) &body body)
"Runs BODY as an implicit PROGN with timeout of SECONDS. If
timeout occurs before BODY has finished, BODY is unwound and
@@ -287,13 +287,13 @@
(when (or local-host local-port)
(sb-bsd-sockets:socket-bind socket local-host local-port))
(with-mapped-conditions (usocket)
- #+sbcl
+ #+(and sbcl (not win32))
(labels ((connect ()
(sb-bsd-sockets:socket-connect socket (host-to-vector-quad host) port)))
(if timeout
(%with-timeout (timeout (error 'sb-ext:timeout)) (connect))
(connect)))
- #+ecl
+ #+(or ecl (and sbcl win32))
(sb-bsd-sockets:socket-connect socket (host-to-vector-quad host) port)
;; Now that we're connected make the stream.
(setf (socket-stream usocket)
@@ -347,22 +347,23 @@
;;; "I had to redefine SOCKET-ACCEPT method of STREAM-SERVER-USOCKET to
;;; handle this situation. Here is the redefinition:" -- Anton Kovalenko <anton at sw4me.com>
-(defmethod socket-accept ((socket stream-server-usocket) &key element-type)
- (with-mapped-conditions (socket)
- (let ((sock (sb-bsd-sockets:socket-accept (socket socket))))
- (if sock
+(defmethod socket-accept ((usocket stream-server-usocket) &key element-type)
+ (with-mapped-conditions (usocket)
+ (let ((socket (sb-bsd-sockets:socket-accept (socket usocket))))
+ (when socket
+ (prog1
(make-stream-socket
- :socket sock
+ :socket socket
:stream (sb-bsd-sockets:socket-make-stream
- sock
+ socket
:input t :output t :buffering :full
:element-type (or element-type
- (element-type socket))))
+ (element-type usocket))))
- ;; 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)))))
+ ;; 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 usocket) nil))))))
;; Sockets and their associated streams are modelled as
;; different objects. Be sure to close the stream (which
@@ -584,15 +585,18 @@
(sb-alien:with-alien ((int-ptr sb-alien:unsigned-long))
(maybe-wsa-error (wsa-ioctlsocket (os-socket-handle socket) fionread (sb-alien:addr int-ptr))
socket)
- int-ptr))
+ (prog1 int-ptr
+ (when (plusp int-ptr)
+ (setf (state socket) :read)))))
(defun wait-for-input-internal (wait-list &key timeout)
(when (waiting-required (wait-list-waiters wait-list))
(let ((rv (wsa-wait-for-multiple-events 1 (wait-list-%wait wait-list)
nil (truncate (* 1000 timeout)) nil)))
(ecase rv
- ((#.+wsa-wait-event-0+ #.+wsa-wait-timeout+)
+ ((#.+wsa-wait-event-0+)
(update-ready-and-state-slots (wait-list-waiters wait-list)))
+ ((#.+wsa-wait-timeout+)) ; do nothing here
((#.+wsa-wait-failed+)
(raise-usock-err
(sb-win32::get-last-error-message (sb-win32::get-last-error))
@@ -608,20 +612,22 @@
(defun update-ready-and-state-slots (sockets)
(dolist (socket sockets)
- (if (or (and (stream-usocket-p socket)
- (listen (socket-stream socket)))
- (%ready-p socket))
- (setf (state socket) :READ)
+ (if (%ready-p socket)
+ (progn
+ (setf (state socket) :READ))
(sb-alien:with-alien ((network-events (sb-alien:struct wsa-network-events)))
(let ((rv (wsa-enum-network-events (os-socket-handle socket) 0
(sb-alien:addr network-events))))
(if (zerop rv)
- (map-network-events #'(lambda (err-code)
- (if (zerop err-code)
- (setf (%ready-p socket) t
- (state socket) :READ)
- (raise-usock-err err-code socket)))
- network-events)
+ (map-network-events
+ #'(lambda (err-code)
+ (if (zerop err-code)
+ (progn
+ (setf (state socket) :READ)
+ (when (stream-server-usocket-p socket)
+ (setf (%ready-p socket) t)))
+ (raise-usock-err err-code socket)))
+ network-events)
(maybe-wsa-error rv socket)))))))
(defun os-wait-list-%wait (wait-list)
@@ -733,7 +739,8 @@
'%remove-waiter))
;; TODO: how to handle error (result) in this call?
- (defun bytes-available-for-read (socket)
+ (declaim (inline %bytes-available-for-read))
+ (defun %bytes-available-for-read (socket)
(ffi:c-inline ((socket-handle socket)) (:fixnum) :fixnum
"u_long nbytes;
int result;
@@ -741,28 +748,40 @@
result = ioctlsocket((SOCKET)#0, FIONREAD, &nbytes);
@(return) = nbytes;"))
+ (defun bytes-available-for-read (socket)
+ (let ((nbytes (%bytes-available-for-read socket)))
+ (when (plusp nbytes)
+ (setf (state socket) :read))
+ nbytes))
+
(defun update-ready-and-state-slots (sockets)
(dolist (socket sockets)
- (if (or (and (stream-usocket-p socket)
- (listen (socket-stream socket)))
- (%ready-p socket))
+ (if (%ready-p socket)
(setf (state socket) :READ)
(let ((events (etypecase socket
(stream-server-usocket (logior fd-connect fd-accept fd-close))
(stream-usocket (logior fd-read))
(datagram-usocket (logior fd-read)))))
;; TODO: check the iErrorCode array
- (if (ffi:c-inline ((socket-handle socket) events) (:fixnum :fixnum) :bool
- "WSANETWORKEVENTS network_events;
- int i, result;
- result = WSAEnumNetworkEvents((SOCKET)#0, 0, &network_events);
- if (!result) {
- @(return) = (#1 & network_events.lNetworkEvents)? Ct : Cnil;
- } else
- @(return) = Cnil;")
- (setf (%ready-p socket) t
- (state socket) :READ)
- (sb-bsd-sockets::socket-error 'update-ready-and-state-slots))))))
+ (multiple-value-bind (valid-p ready-p)
+ (ffi:c-inline ((socket-handle socket) events) (:fixnum :fixnum)
+ (values :bool :bool)
+ "WSANETWORKEVENTS network_events;
+ int i, result;
+ result = WSAEnumNetworkEvents((SOCKET)#0, 0, &network_events);
+ if (!result) {
+ @(return 0) = Ct;
+ @(return 1) = (#1 & network_events.lNetworkEvents)? Ct : Cnil;
+ } else {
+ @(return 0) = Cnil;
+ @(return 1) = Cnil;
+ }")
+ (if valid-p
+ (when ready-p
+ (setf (state socket) :READ)
+ (when (stream-server-usocket-p socket)
+ (setf (%ready-p socket) t)))
+ (sb-bsd-sockets::socket-error 'update-ready-and-state-slots)))))))
(defun wait-for-input-internal (wait-list &key timeout)
(when (waiting-required (wait-list-waiters wait-list))
@@ -774,8 +793,9 @@
result = WSAWaitForMultipleEvents(1, events, NULL, #1, NULL);
@(return) = result;")))
(ecase rv
- ((#.+wsa-wait-event-0+ #.+wsa-wait-timeout+)
+ ((#.+wsa-wait-event-0+)
(update-ready-and-state-slots (wait-list-waiters wait-list)))
+ ((#.+wsa-wait-timeout+)) ; do nothing here
((#.+wsa-wait-failed+)
(sb-bsd-sockets::socket-error 'wait-for-input-internal))))))
Modified: usocket/trunk/package.lisp
==============================================================================
--- usocket/trunk/package.lisp (original)
+++ usocket/trunk/package.lisp Wed May 11 09:08:19 2011
@@ -49,6 +49,14 @@
#:socket-stream
#:datagram-usocket
+ ;; predicates (for version 0.6 or 1.0 ?)
+ #|
+ #:usocket-p
+ #:stream-usocket-p
+ #:stream-server-usocket-p
+ #:datagram-usocket-p
+ |#
+
#:host-byte-order ; IP(v4) utility functions
#:hbo-to-dotted-quad
#:hbo-to-vector-quad
@@ -83,6 +91,7 @@
(in-package :usocket)
;;; Logical Pathname Translations, learn from CL-HTTP source code
+
(eval-when (:load-toplevel :execute)
(let* ((defaults #+asdf (asdf:component-pathname (asdf:find-system :usocket))
#-asdf *load-truename*)
@@ -93,4 +102,5 @@
:defaults defaults
:version :newest)))
(setf (logical-pathname-translations "usocket")
- `(("**;*.*" ,home)))))
+ `(("**;*.*.NEWEST" ,home)
+ ("**;*.*" ,home)))))
Modified: usocket/trunk/server.lisp
==============================================================================
--- usocket/trunk/server.lisp (original)
+++ usocket/trunk/server.lisp Wed May 11 09:08:19 2011
@@ -8,7 +8,8 @@
;; for udp
(timeout 1) (max-buffer-size +max-datagram-packet-size+)
;; for tcp
- element-type reuse-address multi-threading)
+ element-type reuse-address multi-threading
+ name)
(let* ((real-host (or host *wildcard-host*))
(socket (ecase protocol
(:stream
@@ -31,7 +32,7 @@
:timeout timeout
:max-buffer-size max-buffer-size)))))
(if in-new-thread
- (values (spawn-thread "USOCKET Server" #'real-call) socket)
+ (values (spawn-thread (or name "USOCKET Server") #'real-call) socket)
(real-call)))))
(defvar *remote-host*)
@@ -81,7 +82,8 @@
(unwind-protect
(apply function (socket-stream client-socket) arguments)
(close (socket-stream client-socket))
- (socket-close client-socket)))))
+ (socket-close client-socket)
+ nil))))
(unwind-protect
(loop do
(let* ((client-socket (apply #'socket-accept
Modified: usocket/trunk/test/package.lisp
==============================================================================
--- usocket/trunk/test/package.lisp (original)
+++ usocket/trunk/test/package.lisp Wed May 11 09:08:19 2011
@@ -6,6 +6,8 @@
(in-package :cl-user)
(defpackage :usocket-test
- (:use :cl :regression-test)
- (:nicknames :usoct)
- (:export :do-tests :run-usocket-tests))
+ (:use :common-lisp
+ :usocket
+ :regression-test)
+ (:export #:do-tests
+ #:run-usocket-tests))
Modified: usocket/trunk/test/test-datagram.lisp
==============================================================================
--- usocket/trunk/test/test-datagram.lisp (original)
+++ usocket/trunk/test/test-datagram.lisp Wed May 11 09:08:19 2011
@@ -6,7 +6,7 @@
(defvar *echo-server*)
(defvar *echo-server-port*)
-(eval-when (:load-toplevel :execute)
+(defun start-server ()
(multiple-value-bind (thread socket)
(usocket:socket-server "127.0.0.1" 0 #'identity nil
:in-new-thread t
@@ -28,6 +28,9 @@
;;; UDP Send Test #1: connected socket
(deftest udp-send.1
+ (progn
+ (unless (and *echo-server* *echo-server-port*)
+ (start-server))
(let ((s (usocket:socket-connect "127.0.0.1" *echo-server-port* :protocol :datagram)))
(clean-buffers)
(replace *send-buffer* #(1 2 3 4 5))
@@ -36,11 +39,14 @@
(multiple-value-bind (buffer size host port)
(usocket:socket-receive s *receive-buffer* *max-buffer-size*)
(declare (ignore buffer size host port))
- (reduce #'+ *receive-buffer* :start 0 :end 5)))
+ (reduce #'+ *receive-buffer* :start 0 :end 5))))
15)
;;; UDP Send Test #2: unconnected socket
(deftest udp-send.2
+ (progn
+ (unless (and *echo-server* *echo-server-port*)
+ (start-server))
(let ((s (usocket:socket-connect nil nil :protocol :datagram)))
(clean-buffers)
(replace *send-buffer* #(1 2 3 4 5))
@@ -49,5 +55,5 @@
(multiple-value-bind (buffer size host port)
(usocket:socket-receive s *receive-buffer* *max-buffer-size*)
(declare (ignore buffer size host port))
- (reduce #'+ *receive-buffer* :start 0 :end 5)))
+ (reduce #'+ *receive-buffer* :start 0 :end 5))))
15)
Modified: usocket/trunk/test/test-usocket.lisp
==============================================================================
--- usocket/trunk/test/test-usocket.lisp (original)
+++ usocket/trunk/test/test-usocket.lisp Wed May 11 09:08:19 2011
@@ -157,41 +157,5 @@
(usocket:socket-close sock))))
t)
-(eval-when (:compile-toplevel :load-toplevel :execute)
- (defparameter *wait-for-input-timeout* 2))
-
-(deftest wait-for-input.1
- (with-caught-conditions (nil nil)
- (let ((sock (usocket:socket-connect *common-lisp-net* 80))
- (time (get-universal-time)))
- (unwind-protect
- (progn (usocket:wait-for-input sock :timeout *wait-for-input-timeout*)
- (- (get-universal-time) time))
- (usocket:socket-close sock))))
- #.*wait-for-input-timeout*)
-
-(deftest wait-for-input.2
- (with-caught-conditions (nil nil)
- (let ((sock (usocket:socket-connect *common-lisp-net* 80))
- (time (get-universal-time)))
- (unwind-protect
- (progn (usocket:wait-for-input sock :timeout *wait-for-input-timeout* :ready-only t)
- (- (get-universal-time) time))
- (usocket:socket-close sock))))
- #.*wait-for-input-timeout*)
-
-(deftest wait-for-input.3
- (with-caught-conditions (nil nil)
- (let ((sock (usocket:socket-connect *common-lisp-net* 80)))
- (unwind-protect
- (progn
- (format (usocket:socket-stream sock)
- "GET / HTTP/1.0~2%")
- (force-output (usocket:socket-stream sock))
- (usocket:wait-for-input sock :timeout *wait-for-input-timeout*)
- (subseq (read-line (usocket:socket-stream sock)) 0 15))
- (usocket:socket-close sock))))
- "HTTP/1.1 200 OK")
-
(defun run-usocket-tests ()
(do-tests))
Modified: usocket/trunk/usocket-test.asd
==============================================================================
--- usocket/trunk/usocket-test.asd (original)
+++ usocket/trunk/usocket-test.asd Wed May 11 09:08:19 2011
@@ -26,7 +26,8 @@
:components ((:file "package")
(:file "test-usocket")
(:file "test-condition")
- (:file "test-datagram")))))
+ (:file "test-datagram")
+ (:file "wait-for-input")))))
(defmethod perform ((op test-op) (c (eql (find-system :usocket-test))))
(funcall (intern "DO-TESTS" "USOCKET-TEST")))
Modified: usocket/trunk/usocket.lisp
==============================================================================
--- usocket/trunk/usocket.lisp (original)
+++ usocket/trunk/usocket.lisp Wed May 11 09:08:19 2011
@@ -323,9 +323,10 @@
(values (if ready-only socks socket-or-sockets) to)))))
(let* ((start (get-internal-real-time))
(sockets-ready 0))
- #-(and win32 (or sbcl ecl))
(dolist (x (wait-list-waiters socket-or-sockets))
(when (setf (state x)
+ #+(and win32 (or sbcl ecl)) NIL ; they cannot relay on LISTEN
+ #-(and win32 (or sbcl ecl))
(if (and (stream-usocket-p x)
(listen (socket-stream x)))
:READ NIL))
More information about the usocket-cvs
mailing list