Author: ctian Date: Tue Oct 21 19:18:02 2008 New Revision: 448
Log: unsupport feature enhancements.
Modified: usocket/branches/0.4.x/backend/armedbear.lisp usocket/branches/0.4.x/backend/clisp.lisp usocket/branches/0.4.x/backend/cmucl.lisp usocket/branches/0.4.x/backend/lispworks.lisp usocket/branches/0.4.x/backend/sbcl.lisp usocket/branches/0.4.x/backend/scl.lisp usocket/branches/0.4.x/condition.lisp
Modified: usocket/branches/0.4.x/backend/armedbear.lisp ============================================================================== --- usocket/branches/0.4.x/backend/armedbear.lisp (original) +++ usocket/branches/0.4.x/backend/armedbear.lisp Tue Oct 21 19:18:02 2008 @@ -190,9 +190,8 @@ timeout deadline (nodelay nil nodelay-specified) local-host local-port) (when deadline (unsupported 'deadline 'socket-connect)) - (when (or local-host local-port) - (unimplemented 'local-host 'socket-connect) - (unimplemented 'local-port 'socket-connect)) + (when local-host (unimplemented 'local-host 'socket-connect)) + (when local-port (unimplemented 'local-port 'socket-connect))
(let ((usock)) (with-mapped-conditions (usock)
Modified: usocket/branches/0.4.x/backend/clisp.lisp ============================================================================== --- usocket/branches/0.4.x/backend/clisp.lisp (original) +++ usocket/branches/0.4.x/backend/clisp.lisp Tue Oct 21 19:18:02 2008 @@ -62,9 +62,8 @@ (when timeout (unsupported 'timeout 'socket-connect)) (when deadline (unsupported 'deadline 'socket-connect)) (when nodelay-specified (unsupported 'nodelay 'socket-connect)) - (when (or local-host local-port) - (unsupported 'local-host 'socket-connect) - (unsupported 'local-port 'socket-connect)) + (when local-host (unsupported 'local-host 'socket-connect)) + (when local-port (unsupported 'local-port 'socket-connect))
(let ((socket) (hostname (host-to-hostname host)))
Modified: usocket/branches/0.4.x/backend/cmucl.lisp ============================================================================== --- usocket/branches/0.4.x/backend/cmucl.lisp (original) +++ usocket/branches/0.4.x/backend/cmucl.lisp Tue Oct 21 19:18:02 2008 @@ -52,19 +52,26 @@
(defun socket-connect (host port &key (element-type 'character) timeout deadline (nodelay t nodelay-specified) - local-host local-port) + (local-host nil local-host-p) + (local-port nil local-port-p) + &aux + (local-bind-p (fboundp 'ext::bind-inet-socket))) (declare (ignore nodelay)) (when timeout (unsupported 'timeout 'socket-connect)) (when deadline (unsupported 'deadline 'socket-connect)) (when nodelay-specified (unsupported 'nodelay 'socket-connect)) - (when (or local-host local-port) - (unsupported 'local-host 'socket-connect) - (unsupported 'local-port 'socket-connect)) + (when (and local-host-p (not local-bind-p)) + (unsupported 'local-host 'socket-connect :minimum "Snapshot 2008-10 (19E)")) + (when (and local-port-p (not local-bind-p)) + (unsupported 'local-port 'socket-connect :minimum "Snapshot 2008-10 (19E)"))
(let* ((socket)) (setf socket - (with-mapped-conditions (socket) - (ext:connect-to-inet-socket (host-to-hbo host) port :stream))) + (let ((args (list (host-to-hbo host) port :stream))) + (when (and local-bind-p (or local-host-p local-port-p)) + (nconc args (list :local-host local-host :local-port local-port))) + (with-mapped-conditions (socket) + (apply #'ext:connect-to-inet-socket args)))) (if socket (let* ((stream (sys:make-fd-stream socket :input t :output t :element-type element-type
Modified: usocket/branches/0.4.x/backend/lispworks.lisp ============================================================================== --- usocket/branches/0.4.x/backend/lispworks.lisp (original) +++ usocket/branches/0.4.x/backend/lispworks.lisp Tue Oct 21 19:18:02 2008 @@ -98,10 +98,11 @@
#+(and (not lispworks4) (not lispworks5.0)) (when nodelay-specified (unimplemented 'nodelay 'socket-connect)) - #+lispworks4 - (when (or local-host local-port) - (unsupported 'local-host 'socket-connect :minimum "LispWorks 5.0+ (verified)") - (unsupported 'local-port 'socket-connect :minimum "LispWorks 5.0+ (verified)")) + #+lispworks4 #+lispworks4 + (when local-host + (unsupported 'local-host 'socket-connect :minimum "LispWorks 5.0")) + (when local-port + (unsupported 'local-port 'socket-connect :minimum "LispWorks 5.0"))
(let ((hostname (host-to-hostname host)) (stream))
Modified: usocket/branches/0.4.x/backend/sbcl.lisp ============================================================================== --- usocket/branches/0.4.x/backend/sbcl.lisp (original) +++ usocket/branches/0.4.x/backend/sbcl.lisp Tue Oct 21 19:18:02 2008 @@ -202,11 +202,14 @@
(defun socket-connect (host port &key (element-type 'character) timeout deadline (nodelay t nodelay-specified) - local-host local-port) + local-host local-port + &aux + (sockopt-tcp-nodelay-p + (fboundp 'sb-bsd-sockets::sockopt-tcp-nodelay))) (when deadline (unsupported 'deadline 'socket-connect)) (when timeout (unsupported 'timeout 'socket-connect)) (when (and nodelay-specified - (not (fboundp 'sb-bsd-sockets::sockopt-tcp-nodelay))) + (not sockopt-tcp-nodelay-p)) (unsupported 'nodelay 'socket-connect))
(let ((socket (make-instance 'sb-bsd-sockets:inet-socket @@ -221,8 +224,7 @@ ;;###FIXME: The above line probably needs an :external-format (usocket (make-stream-socket :stream stream :socket socket)) (ip (host-to-vector-quad host))) - (when (and nodelay-specified - (fboundp 'sb-bsd-sockets::sockopt-tcp-nodelay)) + (when (and nodelay-specified sockopt-tcp-nodelay-p) (setf (sb-bsd-sockets:sockopt-tcp-nodelay socket) nodelay)) (when (or local-host local-port) (sb-bsd-sockets:socket-bind socket
Modified: usocket/branches/0.4.x/backend/scl.lisp ============================================================================== --- usocket/branches/0.4.x/backend/scl.lisp (original) +++ usocket/branches/0.4.x/backend/scl.lisp Tue Oct 21 19:18:02 2008 @@ -30,18 +30,24 @@
(defun socket-connect (host port &key (element-type 'character) timeout deadline (nodelay t nodelay-specified) - local-host local-port) + (local-host nil local-host-p) + (local-port nil local-port-p) + &aux + (patch-udp-p (fboundp 'ext::inet-socket-send-to))) (declare (ignore nodelay)) (when nodelay-specified (unsupported 'nodelay 'socket-connect)) (when deadline (unsupported 'deadline 'socket-connect)) (when timeout (unsupported 'timeout 'socket-connect)) - (when (or local-host local-port) - (unsupported 'local-host 'socket-connect) - (unsupported 'local-port 'socket-connect)) - - (let* ((socket (with-mapped-conditions () - (ext:connect-to-inet-socket (host-to-hbo host) port - :kind :stream))) + (when (and local-host-p (not patch-udp-p)) + (unsupported 'local-host 'socket-connect :minimum "1.3.8.2")) + (when (and local-port-p (not patch-udp-p)) + (unsupported 'local-port 'socket-connect :minimum "1.3.8.2")) + + (let* ((socket (let ((args (list (host-to-hbo host) port :kind :stream))) + (when (and patch-udp-p (or local-host-p local-port-p)) + (nconc args (list :local-host local-host :local-port local-port))) + (with-mapped-conditions () + (apply #'ext:connect-to-inet-socket args)))) (stream (sys:make-fd-stream socket :input t :output t :element-type element-type :buffering :full)))
Modified: usocket/branches/0.4.x/condition.lisp ============================================================================== --- usocket/branches/0.4.x/condition.lisp (original) +++ usocket/branches/0.4.x/condition.lisp Tue Oct 21 19:18:02 2008 @@ -25,6 +25,12 @@ ((minimum :initarg :minimum :reader minimum :documentation "Indicates the minimal version of the implementation required to support the requested feature.")) + (:report (lambda (c stream) + (format stream "~A in ~A is unsupported." + (feature c) (context c)) + (when (minimum c) + (format stream " Minimum version (~A) is required." + (minimum c))))) (:documentation "Signalled when the underlying implementation doesn't allow supporting the requested feature.
@@ -32,6 +38,9 @@
(define-condition unimplemented (insufficient-implementation) () + (:report (lambda (c stream) + (format stream "~A in ~A is unimplemented." + (feature c) (context c)))) (:documentation "Signalled if a certain feature might be implemented, based on the features of the underlying implementation, but hasn't been implemented yet."))