Author: ehuelsmann Date: Sat Feb 16 18:48:31 2008 New Revision: 310
Modified: usocket/trunk/backend/clisp.lisp usocket/trunk/backend/cmucl.lisp usocket/trunk/backend/lispworks.lisp usocket/trunk/backend/openmcl.lisp usocket/trunk/backend/sbcl.lisp usocket/trunk/backend/scl.lisp usocket/trunk/condition.lisp Log: Adapt backends to my newly gained understanding of the CL condition system: make handle-condition less gready grabbing errors, now that with-mapped-conditions is adapted to use handler-bind instead of handler-case.
Modified: usocket/trunk/backend/clisp.lisp ============================================================================== --- usocket/trunk/backend/clisp.lisp (original) +++ usocket/trunk/backend/clisp.lisp Sat Feb 16 18:48:31 2008 @@ -49,13 +49,11 @@ (let ((usock-err (cdr (assoc (car (simple-condition-format-arguments condition)) +clisp-error-map+ :test #'member)))) - (if usock-err + (when usock-err ;; don't claim the error if we don't know + ;; it's actually a socket error ... (if (subtypep usock-err 'error) (error usock-err :socket socket) - (signal usock-err :socket socket)) - (error 'unknown-error - :socket socket - :real-error condition)))))) + (signal usock-err :socket socket)))))))
(defun socket-connect (host port &key (element-type 'character)) (let ((socket)
Modified: usocket/trunk/backend/cmucl.lisp ============================================================================== --- usocket/trunk/backend/cmucl.lisp (original) +++ usocket/trunk/backend/cmucl.lisp Sat Feb 16 18:48:31 2008 @@ -48,11 +48,7 @@ (typecase condition (ext::socket-error (cmucl-map-socket-error (ext::socket-errno condition) :socket socket - :condition condition)) - (simple-error (error 'unknown-error - :real-condition condition - :socket socket)) - (condition (error condition)))) + :condition condition))))
(defun socket-connect (host port &key (element-type 'character)) (let* ((socket))
Modified: usocket/trunk/backend/lispworks.lisp ============================================================================== --- usocket/trunk/backend/lispworks.lisp (original) +++ usocket/trunk/backend/lispworks.lisp Sat Feb 16 18:48:31 2008 @@ -45,13 +45,11 @@ (defun raise-or-signal-socket-error (errno socket) (let ((usock-err (cdr (assoc errno +lispworks-error-map+ :test #'member)))) - (if usock-err + (when usock-err ;; don't claim the error when we're not sure + ;; it's actually sockets related (if (subtypep usock-err 'error) (error usock-err :socket socket) - (signal usock-err :socket)) - (error 'unknown-error - :socket socket - :real-condition nil)))) + (signal usock-err :socket)))))
(defun raise-usock-err (errno socket &optional condition) (let* ((usock-err
Modified: usocket/trunk/backend/openmcl.lisp ============================================================================== --- usocket/trunk/backend/openmcl.lisp (original) +++ usocket/trunk/backend/openmcl.lisp Sat Feb 16 18:48:31 2008 @@ -69,10 +69,8 @@ (raise-error-from-id (openmcl-socket:socket-error-identifier condition) socket condition)) (ccl::socket-creation-error #| ugh! |# - (raise-error-from-id (ccl::socket-creationg-error-identifier condition) - socket condition)) - (error (error 'unknown-error :socket socket :real-error condition)) - (condition (signal 'unknown-condition :real-condition condition)))) + (raise-error-from-id (ccl::socket-creation-error-identifier condition) + socket condition))))
(defun to-format (element-type) (if (subtypep element-type 'character)
Modified: usocket/trunk/backend/sbcl.lisp ============================================================================== --- usocket/trunk/backend/sbcl.lisp (original) +++ usocket/trunk/backend/sbcl.lisp Sat Feb 16 18:48:31 2008 @@ -173,20 +173,15 @@ (usock-error (if (functionp usock-error) (funcall usock-error condition) usock-error))) - (if usock-error - (error usock-error :socket socket) - (error 'unknown-error - :socket socket - :real-error condition)))) + (when usock-error + (error usock-error :socket socket)))) (condition (let* ((usock-cond (cdr (assoc (type-of condition) +sbcl-condition-map+))) (usock-cond (if (functionp usock-cond) (funcall usock-cond condition) usock-cond))) (if usock-cond - (signal usock-cond :socket socket) - (signal 'unknown-condition - :real-condition condition)))))) + (signal usock-cond :socket socket))))))
(defun socket-connect (host port &key (element-type 'character))
Modified: usocket/trunk/backend/scl.lisp ============================================================================== --- usocket/trunk/backend/scl.lisp (original) +++ usocket/trunk/backend/scl.lisp Sat Feb 16 18:48:31 2008 @@ -26,11 +26,7 @@ (ext::socket-error (scl-map-socket-error (ext::socket-errno condition) :socket socket - :condition condition)) - (error - (error 'unknown-error - :real-condition condition - :socket socket)))) + :condition condition))))
(defun socket-connect (host port &key (element-type 'character)) (let* ((socket (with-mapped-conditions ()
Modified: usocket/trunk/condition.lisp ============================================================================== --- usocket/trunk/condition.lisp (original) +++ usocket/trunk/condition.lisp Sat Feb 16 18:48:31 2008 @@ -115,9 +115,8 @@ error available."))
(defmacro with-mapped-conditions ((&optional socket) &body body) - `(handler-case - (progn ,@body) - (condition (condition) (handle-condition condition ,socket)))) + `(handler-bind ((condition #'(lambda (c) (handle-condition c ,socket)))) + ,@body))
(defparameter +unix-errno-condition-map+ `(((11) . retry-condition) ;; EAGAIN