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

[Chun Tian (binghe)]

Author: ctian
Date: Fri Jul  9 10:57:15 2010
New Revision: 540

Log:
Tests: handle 'usocket:unsupported condition in tests.

Modified:
   usocket/trunk/backend/openmcl.lisp
   usocket/trunk/test/test-usocket.lisp

Modified: usocket/trunk/backend/openmcl.lisp
==============================================================================
--- usocket/trunk/backend/openmcl.lisp	(original)
+++ usocket/trunk/backend/openmcl.lisp	Fri Jul  9 10:57:15 2010
@@ -190,7 +190,6 @@
      (list (hbo-to-vector-quad (openmcl-socket:lookup-hostname
                                 (host-to-hostname name))))))
 
-
 (defun %setup-wait-list (wait-list)
   (declare (ignore wait-list)))
 
@@ -205,5 +204,5 @@
     (let* ((ticks-timeout (truncate (* (or timeout 1)
                                        ccl::*ticks-per-second*))))
       (input-available-p (wait-list-waiters wait-list)
-                               (when timeout ticks-timeout))
+			 (when timeout ticks-timeout))
       wait-list)))

Modified: usocket/trunk/test/test-usocket.lisp
==============================================================================
--- usocket/trunk/test/test-usocket.lisp	(original)
+++ usocket/trunk/test/test-usocket.lisp	Fri Jul  9 10:57:15 2010
@@ -23,76 +23,79 @@
 (defmacro with-caught-conditions ((expect throw) &body body)
   `(catch 'caught-error
      (handler-case
-      (progn , at body)
-      (usocket:unknown-error (c) (if (typep c ,expect)
-                                     (throw 'caught-error ,throw)
-                                   (progn
-                                     (describe c)
-                                     (describe
-                                      (usocket::usocket-real-error c))
-                                     c)))
-      (error (c) (if (typep c ,expect)
-                     (throw 'caught-error ,throw)
-                   (progn
-                     (describe c)
-                     c)))
-      (usocket:unknown-condition (c) (if (typep c ,expect)
-                                         (throw 'caught-error ,throw)
-                                       (progn
-                                         (describe c)
-                                         (describe
-                                          (usocket::usocket-real-condition c))
-                                         c)))
-      (condition (c) (if (typep c ,expect)
-                         (throw 'caught-error ,throw)
-                       (progn
-                         (describe c)
-                         c))))))
+         (handler-bind ((usocket:unsupported
+                         #'(lambda (c)
+                             (declare (ignore c)) (continue))))
+           (progn , at body))
+       (usocket:unknown-error (c) (if (typep c ',expect)
+                                      (throw 'caught-error ,throw)
+                                    (progn
+                                      (describe c)
+                                      (describe
+                                       (usocket::usocket-real-error c))
+                                      c)))
+       (error (c) (if (typep c ',expect)
+                      (throw 'caught-error ,throw)
+                    (progn
+                      (describe c)
+                      c)))
+       (usocket:unknown-condition (c) (if (typep c ',expect)
+                                          (throw 'caught-error ,throw)
+                                        (progn
+                                          (describe c)
+                                          (describe
+                                           (usocket::usocket-real-condition c))
+                                          c)))
+       (condition (c) (if (typep c ',expect)
+                          (throw 'caught-error ,throw)
+                        (progn
+                          (describe c)
+                          c))))))
 
 (deftest make-socket.1 (usocket:socket *fake-usocket*) :my-socket)
 (deftest make-socket.2 (usocket:socket-stream *fake-usocket*) :my-stream)
 
 (deftest socket-no-connect.1
-  (with-caught-conditions ('usocket:socket-error nil)
-      (usocket:socket-connect "127.0.0.0" +unused-local-port+ :timeout 0)
-      t)
+  (with-caught-conditions (usocket:socket-error nil)
+    (usocket:socket-connect "127.0.0.0" +unused-local-port+ :timeout 1)
+    t)
   nil)
 
 (deftest socket-no-connect.2
-  (with-caught-conditions ('usocket:socket-error nil)
-    (usocket:socket-connect #(127 0 0 0) +unused-local-port+ :timeout 0)
+  (with-caught-conditions (usocket:socket-error nil)
+    (usocket:socket-connect #(127 0 0 0) +unused-local-port+ :timeout 1)
     t)
   nil)
 
 (deftest socket-no-connect.3
-  (with-caught-conditions ('usocket:socket-error nil)
-    (usocket:socket-connect 2130706432 +unused-local-port+ :timeout 0) ;; == #(127 0 0 0)
+  (with-caught-conditions (usocket:socket-error nil)
+    (usocket:socket-connect 2130706432 +unused-local-port+ :timeout 1) ;; == #(127 0 0 0)
     t)
   nil)
 
 (deftest socket-failure.1
   (with-caught-conditions (#-(or cmu lispworks armedbear openmcl mcl)
-                             'usocket:network-unreachable-error
+                           usocket:network-unreachable-error
                            #+(or cmu lispworks armedbear)
-                             'usocket:unknown-error
+                           usocket:unknown-error
                            #+(or openmcl mcl)
-                             'usocket:timeout-error
+                           usocket:timeout-error
                            nil)
-    (usocket:socket-connect 2130706432 +unused-local-port+ :timeout 0) ;; == #(127 0 0 0)
+    (usocket:socket-connect 2130706432 +unused-local-port+ :timeout 1) ;; == #(127 0 0 0)
     :unreach)
   nil)
 
 (deftest socket-failure.2
   (with-caught-conditions (#+(or lispworks armedbear)
-                             'usocket:unknown-error
+                           usocket:unknown-error
                            #+cmu
-                             'usocket:network-unreachable-error
+                           usocket:network-unreachable-error
                            #+(or openmcl mcl)
-                             'usocket:timeout-error
+                           usocket:timeout-error
                            #-(or lispworks armedbear cmu openmcl mcl)
-                             'usocket:host-unreachable-error
+                           usocket:host-unreachable-error
                            nil)
-    (usocket:socket-connect +non-existing-host+ 80 :timeout 0) ;; 80 = just a port
+    (usocket:socket-connect +non-existing-host+ 80 :timeout 1) ;; 80 = just a port
     :unreach)
   nil)