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