[usocket-cvs] r75 - usocket/trunk/test

[ehuelsmann at common-lisp.net]

Author: ehuelsmann
Date: Sat Feb 11 16:09:28 2006
New Revision: 75

Modified:
   usocket/trunk/test/test-usocket.lisp
Log:
Always print error information.

Modified: usocket/trunk/test/test-usocket.lisp
==============================================================================
--- usocket/trunk/test/test-usocket.lisp	(original)
+++ usocket/trunk/test/test-usocket.lisp	Sat Feb 11 16:09:28 2006
@@ -5,6 +5,34 @@
 
 (in-package :usocket-test)
 
+(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))))))
 
 (defparameter +non-existing-host+ "10.0.0.13")
 (defparameter *soc1* (usocket::make-socket :socket :my-socket
@@ -14,87 +42,79 @@
 (deftest make-socket.2 (usocket:socket-stream *soc1*) :my-stream)
 
 (deftest socket-no-connect.1
-  (catch 'caught-error
-    (handler-bind ((usocket:socket-error
-                    #'(lambda (c) (throw 'caught-error nil))))
+  (with-caught-conditions ('usocket:socket-error nil)
       (usocket:socket-connect "127.0.0.0" 80)
-      t))
+      t)
   nil)
 (deftest socket-no-connect.2
-  (catch 'caught-error
-    (handler-bind ((usocket:socket-error
-                    #'(lambda (c) (throw 'caught-error nil))))
-      (usocket:socket-connect #(127 0 0 0) 80)
-      t))
+  (with-caught-conditions ('usocket:socket-error nil)
+    (usocket:socket-connect #(127 0 0 0) 80)
+    t)
   nil)
 (deftest socket-no-connect.3
-  (catch 'caught-error
-    (handler-bind ((usocket:socket-error
-                    #'(lambda (c) (throw 'caught-error nil))))
-      (usocket:socket-connect 2130706432 80) ;; == #(127 0 0 0)
-      t))
+  (with-caught-conditions ('usocket:socket-error nil)
+    (usocket:socket-connect 2130706432 80) ;; == #(127 0 0 0)
+    t)
   nil)
 
 (deftest socket-failure.1
-  (catch 'caught-error
-    (handler-bind ((usocket:network-unreachable-error
-                    #'(lambda (c) (throw 'caught-error nil)))
-                   ;; some lisps don't report as specific as above
-                   #+(or cmu lispworks armedbear)
-                   (usocket:unknown-error
-                    #'(lambda (c) (throw 'caught-error nil)))
-                   (condition
-                    #'(lambda (c) (throw 'caught-error t))))
-      (usocket:socket-connect 2130706432 80) ;; == #(127 0 0 0)
-      :unreach))
+  (with-caught-conditions (#-(or cmu lispworks armedbear)
+                             'usocket:network-unreachable-error
+                           #+(or cmu lispworks armedbear)
+                             'usocket:unknown-error
+                           nil)
+    (usocket:socket-connect 2130706432 80) ;; == #(127 0 0 0)
+    :unreach)
   nil)
 (deftest socket-failure.2
-  (catch 'caught-error
-    (handler-bind ((usocket:host-unreachable-error
-                    #'(lambda (c) (throw 'caught-error nil)))
-                   ;; some lisps don't report as specific as above
-                   #+(or cmu lispworks armedbear)
-                   (usocket:unknown-error
-                    #'(lambda (c) (throw 'caught-error nil)))
-                   (condition
-                    #'(lambda (c) (throw 'caught-error t))))
+  (with-caught-conditions (#+(or lispworks armedbear)
+                             'usocket:unknown-error
+                           #+cmu
+                             'usocket:network-unreachable-error
+                           #-(or lispworks armedbear cmu)
+                             'usocket:host-unreachable-error
+                           nil)
       (usocket:socket-connect +non-existing-host+ 80) ;; == #(127 0 0 0)
-      :unreach))
+      :unreach)
   nil)
 
 
 ;; let's hope c-l.net doesn't move soon, or that people start to
 ;; test usocket like crazy..
 (deftest socket-connect.1
-  (let ((sock (usocket:socket-connect "common-lisp.net" 80)))
-    (unwind-protect
-        (typep sock 'usocket:usocket)
-      (usocket:socket-close sock)))
-  t) 
+  (with-caught-conditions (nil nil)
+    (let ((sock (usocket:socket-connect "common-lisp.net" 80)))
+      (unwind-protect
+          (typep sock 'usocket:usocket)
+        (usocket:socket-close sock))))
+  t)
 (deftest socket-connect.2
-  (let ((sock (usocket:socket-connect #(65 110 12 237) 80)))
-    (unwind-protect
-        (typep sock 'usocket:usocket)
-      (usocket:socket-close sock)))
+  (with-caught-conditions (nil nil)
+    (let ((sock (usocket:socket-connect #(65 110 12 237) 80)))
+      (unwind-protect
+          (typep sock 'usocket:usocket)
+        (usocket:socket-close sock))))
   t)
 (deftest socket-connect.3
-  (let ((sock (usocket:socket-connect 1097731309 80)))
-    (unwind-protect
-        (typep sock 'usocket:usocket)
-      (usocket:socket-close sock)))
+  (with-caught-conditions (nil nil)
+    (let ((sock (usocket:socket-connect 1097731309 80)))
+      (unwind-protect
+          (typep sock 'usocket:usocket)
+        (usocket:socket-close sock))))
   t)
 
 ;; let's hope c-l.net doesn't change its software any time soon
 (deftest socket-stream.1
-  (let ((sock (usocket:socket-connect "common-lisp.net" 80)))
-    (unwind-protect
-        (progn
-          (format (usocket:socket-stream sock)
-                  "GET / HTTP/1.0~A~A~A~A"
-                  #\Return #\Newline #\Return #\Newline)
-          (force-output (usocket:socket-stream sock))
-          (read-line (usocket:socket-stream sock)))
-      (usocket:socket-close sock)))
+  (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~A~A~A~A"
+                    #\Return #\Newline #\Return #\Newline)
+            (force-output (usocket:socket-stream sock))
+            (read-line (usocket:socket-stream sock)))
+        (usocket:socket-close sock))))
   #+clisp "HTTP/1.1 200 OK"
   #-clisp #.(format nil "HTTP/1.1 200 OK~A" #\Return) nil)