Author: ctian
Date: Wed Oct 22 01:11:56 2008
New Revision: 451
Log:
Merge all changes on branch 0.4.x so far back to trunk, seems the only different between trunk and branch 0.4.x is the file backend/clisp.lisp which also contains some udp-related code.
Modified:
usocket/trunk/backend/armedbear.lisp
usocket/trunk/backend/clisp.lisp
usocket/trunk/backend/cmucl.lisp
usocket/trunk/backend/lispworks.lisp
usocket/trunk/backend/sbcl.lisp
usocket/trunk/backend/scl.lisp
usocket/trunk/condition.lisp
Modified: usocket/trunk/backend/armedbear.lisp
==============================================================================
--- usocket/trunk/backend/armedbear.lisp (original)
+++ usocket/trunk/backend/armedbear.lisp Wed Oct 22 01:11:56 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/trunk/backend/clisp.lisp
==============================================================================
--- usocket/trunk/backend/clisp.lisp (original)
+++ usocket/trunk/backend/clisp.lisp Wed Oct 22 01:11:56 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/trunk/backend/cmucl.lisp
==============================================================================
--- usocket/trunk/backend/cmucl.lisp (original)
+++ usocket/trunk/backend/cmucl.lisp Wed Oct 22 01:11:56 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-08 (19E)"))
+ (when (and local-port-p (not local-bind-p))
+ (unsupported 'local-port 'socket-connect :minimum "Snapshot 2008-08 (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/trunk/backend/lispworks.lisp
==============================================================================
--- usocket/trunk/backend/lispworks.lisp (original)
+++ usocket/trunk/backend/lispworks.lisp Wed Oct 22 01:11:56 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/trunk/backend/sbcl.lisp
==============================================================================
--- usocket/trunk/backend/sbcl.lisp (original)
+++ usocket/trunk/backend/sbcl.lisp Wed Oct 22 01:11:56 2008
@@ -203,7 +203,10 @@
(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
@@ -211,7 +214,7 @@
;; package today. There's no guarantee the functions
;; we need are available, but we can make sure not to
;; call them if they aren't
- (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
@@ -226,8 +229,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/trunk/backend/scl.lisp
==============================================================================
--- usocket/trunk/backend/scl.lisp (original)
+++ usocket/trunk/backend/scl.lisp Wed Oct 22 01:11:56 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/trunk/condition.lisp
==============================================================================
--- usocket/trunk/condition.lisp (original)
+++ usocket/trunk/condition.lisp Wed Oct 22 01:11:56 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."))
@@ -110,13 +119,16 @@
((real-error :initarg :real-error
:accessor usocket-real-error))
(:report (lambda (c stream)
- (format stream
- (simple-condition-format-control (usocket-real-error c))
- (simple-condition-format-arguments (usocket-real-error c)))))
+ (typecase c
+ (simple-condition
+ (format stream
+ (simple-condition-format-control (usocket-real-error c))
+ (simple-condition-format-arguments (usocket-real-error c))))
+ (otherwise
+ (format stream "The condition ~A occurred." (usocket-real-error c))))))
(:documentation "Error raised when there's no other - more applicable -
error available."))
-
(define-usocket-condition-classes
(ns-try-again)
(ns-condition))
@@ -140,9 +152,13 @@
((real-error :initarg :real-error
:accessor ns-real-error))
(:report (lambda (c stream)
- (format stream
- (simple-condition-format-control (ns-real-error c))
- (simple-condition-format-arguments (ns-real-error c)))))
+ (typecase c
+ (simple-condition
+ (format stream
+ (simple-condition-format-control (usocket-real-error c))
+ (simple-condition-format-arguments (usocket-real-error c))))
+ (otherwise
+ (format stream "The condition ~A occurred." (usocket-real-error c))))))
(:documentation "Error raised when there's no other - more applicable -
error available."))
@@ -201,8 +217,10 @@
(defmacro unsupported (feature context &key minimum)
- `(cerror 'unsupported :feature ,feature
- :context ,context :minimum ,minimum))
+ `(cerror "Ignore it and continue" 'unsupported
+ :feature ,feature
+ :context ,context
+ :minimum ,minimum))
(defmacro unimplemented (feature context)
`(signal 'unimplemented :feature ,feature :context ,context))
