Author: ehuelsmann Date: Sun Feb 12 14:17:34 2006 New Revision: 84
Modified: usocket/trunk/backend/openmcl.lisp usocket/trunk/test/test-usocket.lisp Log: More OpenMCL fixes.
Modified: usocket/trunk/backend/openmcl.lisp ============================================================================== --- usocket/trunk/backend/openmcl.lisp (original) +++ usocket/trunk/backend/openmcl.lisp Sun Feb 12 14:17:34 2006 @@ -23,15 +23,20 @@ (:access-denied . operation-not-permitted-error)))
+(defun raise-error-from-id (condition-id socket real-condition) + (let ((usock-err (cdr (assoc condition-id +openmcl-error-map+)))) + (if usock-err + (error usock-err :socket socket) + (error 'unknown-error :socket socket :real-error real-condition))) + (defun handle-condition (condition &optional socket) (typecase condition (openmcl-socket:socket-error - (let ((usock-err - (cdr (assoc (openmcl-socket:socket-error-identifier condition) - +openmcl-error-map+)))) - (if usock-err - (error usock-err :socket socket) - (error 'unknown-error :socket socket :real-error condition)))) + (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-idenitifier condition) + socket condition)) (error (error 'unknown-error :socket socket :real-error condition)) (condition (signal 'unknown-condition :real-condition condition))))
Modified: usocket/trunk/test/test-usocket.lisp ============================================================================== --- usocket/trunk/test/test-usocket.lisp (original) +++ usocket/trunk/test/test-usocket.lisp Sun Feb 12 14:17:34 2006 @@ -58,10 +58,12 @@ nil)
(deftest socket-failure.1 - (with-caught-conditions (#-(or cmu lispworks armedbear) + (with-caught-conditions (#-(or cmu lispworks armedbear openmcl) 'usocket:network-unreachable-error #+(or cmu lispworks armedbear) 'usocket:unknown-error + #+openmcl + 'usocket:timeout-error nil) (usocket:socket-connect 2130706432 80) ;; == #(127 0 0 0) :unreach) @@ -71,7 +73,9 @@ 'usocket:unknown-error #+cmu 'usocket:network-unreachable-error - #-(or lispworks armedbear cmu) + #+openmcl + 'usocket:timeout-error + #-(or lispworks armedbear cmu openmcl) 'usocket:host-unreachable-error nil) (usocket:socket-connect +non-existing-host+ 80) ;; == #(127 0 0 0)