[usocket-cvs] r310 - in usocket/trunk: . backend

[ehuelsmann at common-lisp.net]

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 , at body)
-     (condition (condition) (handle-condition condition ,socket))))
+  `(handler-bind ((condition #'(lambda (c) (handle-condition c ,socket))))
+    , at body))
 
 (defparameter +unix-errno-condition-map+
   `(((11) . retry-condition) ;; EAGAIN