Revision: 4451 Author: hans URL: http://bknr.net/trac/changeset/4451

Update from upstream r498 Fix condition instanciation in openmcl port

U trunk/thirdparty/usocket/backend/openmcl.lisp U trunk/thirdparty/usocket/backend/sbcl.lisp U trunk/thirdparty/usocket/condition.lisp U trunk/thirdparty/usocket/usocket.lisp

Modified: trunk/thirdparty/usocket/backend/openmcl.lisp =================================================================== --- trunk/thirdparty/usocket/backend/openmcl.lisp 2009-09-02 08:24:18 UTC (rev 4450) +++ trunk/thirdparty/usocket/backend/openmcl.lisp 2009-09-17 07:01:40 UTC (rev 4451) @@ -62,9 +62,9 @@ (raise-error-from-id (openmcl-socket:socket-error-identifier condition) socket condition)) (ccl:input-timeout - (error 'timeout-error :socket socket :real-error condition)) + (error 'timeout-error :socket socket)) (ccl:communication-deadline-expired - (error 'deadline-error :socket socket :real-error condition)) + (error 'deadline-error :socket socket)) (ccl::socket-creation-error #| ugh! |# (raise-error-from-id (ccl::socket-creation-error-identifier condition) socket condition))))

Modified: trunk/thirdparty/usocket/backend/sbcl.lisp =================================================================== --- trunk/thirdparty/usocket/backend/sbcl.lisp 2009-09-02 08:24:18 UTC (rev 4450) +++ trunk/thirdparty/usocket/backend/sbcl.lisp 2009-09-17 07:01:40 UTC (rev 4451) @@ -68,7 +68,7 @@

(defun fdset-alloc () (ffi:c-inline () () :pointer-void - "cl_alloc_atomic(sizeof(fd_set))" :one-liner t)) + "ecl_alloc_atomic(sizeof(fd_set))" :one-liner t))

(defun fdset-zero (fdset) (ffi:c-inline (fdset) (:pointer-void) :void @@ -96,7 +96,7 @@ (defun get-host-name () (ffi:c-inline () () :object - "{ char *buf = cl_alloc_atomic(257); + "{ char *buf = ecl_alloc_atomic(257);

if (gethostname(buf,256) == 0) @(return) = make_simple_base_string(buf); @@ -174,6 +174,8 @@ . socket-type-not-supported-error) (sb-bsd-sockets:network-unreachable-error . network-unreachable-error) (sb-bsd-sockets:operation-timeout-error . timeout-error) + #-ecl + (sb-sys:io-timeout . timeout-error) (sb-bsd-sockets:socket-error . ,#'map-socket-error)

;; Nameservice errors: mapped to unknown-error

Modified: trunk/thirdparty/usocket/condition.lisp =================================================================== --- trunk/thirdparty/usocket/condition.lisp 2009-09-02 08:24:18 UTC (rev 4450) +++ trunk/thirdparty/usocket/condition.lisp 2009-09-17 07:01:40 UTC (rev 4451) @@ -111,6 +111,7 @@ host-unreachable-error shutdown-error timeout-error + #+openmcl deadline-error invalid-socket-error invalid-socket-stream-error) (socket-error))

Modified: trunk/thirdparty/usocket/usocket.lisp =================================================================== --- trunk/thirdparty/usocket/usocket.lisp 2009-09-02 08:24:18 UTC (rev 4450) +++ trunk/thirdparty/usocket/usocket.lisp 2009-09-17 07:01:40 UTC (rev 4451) @@ -351,6 +351,13 @@ (push (parse-integer element) new-list)) new-list))

+(defun ip-address-string-p (string) + "Return a true value if the given string could be an IP address." + (every (lambda (char) + (or (digit-char-p char) + (eql char #.))) + string)) + (defun hbo-to-dotted-quad (integer) "Host-byte-order integer to dotted-quad string conversion utility." (let ((first (ldb (byte 8 24) integer)) @@ -438,7 +445,7 @@ "Translate a host specification (vector quad, dotted quad or domain name) to a vector quad." (etypecase host - (string (let* ((ip (ignore-errors + (string (let* ((ip (when (ip-address-string-p host) (dotted-quad-to-vector-quad host)))) (if (and ip (= 4 (length ip))) ;; valid IP dotted quad? @@ -451,7 +458,7 @@

(defun host-to-hbo (host) (etypecase host - (string (let ((ip (ignore-errors + (string (let ((ip (when (ip-address-string-p host) (dotted-quad-to-vector-quad host)))) (if (and ip (= 4 (length ip))) (host-byte-order ip)