[usocket-cvs] r448 - in usocket/branches/0.4.x: . backend
Chun Tian (binghe)
ctian at common-lisp.net
Tue Oct 21 19:18:03 UTC 2008
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."))
More information about the usocket-cvs
mailing list