[usocket-cvs] r547 - in usocket/trunk: backend test

[Chun Tian (binghe)]

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))