Author: ctian Date: Fri Jul 16 04:23:10 2010 New Revision: 547
Log: SBCL: fixed type error in calling of wsa-enum-network-events
Modified: usocket/trunk/backend/sbcl.lisp usocket/trunk/test/test-usocket.lisp
Modified: usocket/trunk/backend/sbcl.lisp ============================================================================== --- usocket/trunk/backend/sbcl.lisp (original) +++ usocket/trunk/backend/sbcl.lisp Fri Jul 16 04:23:10 2010 @@ -521,20 +521,21 @@
(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) - (sb-alien:with-alien ((network-events (sb-alien:struct wsa-network-events))) - (let ((rv (wsa-enum-network-events (os-socket-handle socket) 0 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) - (maybe-wsa-error rv socket))))))) + (if (or (and (stream-usocket-p socket) + (listen (socket-stream socket))) + (%ready-p socket)) + (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) + (maybe-wsa-error rv socket)))))))
(defun os-wait-list-%wait (wait-list) (sb-alien:deref (wait-list-%wait wait-list)))
Modified: usocket/trunk/test/test-usocket.lisp ============================================================================== --- usocket/trunk/test/test-usocket.lisp (original) +++ usocket/trunk/test/test-usocket.lisp Fri Jul 16 04:23:10 2010 @@ -196,5 +196,20 @@ (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~c~c~c~c" + #\Return #\linefeed #\Return #\linefeed) + (force-output (usocket:socket-stream sock)) + (usocket:wait-for-input sock :timeout *wait-for-input-timeout*) + (read-line (usocket:socket-stream sock))) + (usocket:socket-close sock)))) + #+(or mcl clisp) "HTTP/1.1 200 OK" + #-(or mcl clisp) #.(format nil "HTTP/1.1 200 OK~A" #\Return) nil) + (defun run-usocket-tests () (do-tests))