Author: ehuelsmann Date: Mon Jul 28 17:57:23 2008 New Revision: 399
Modified: usocket/trunk/backend/allegro.lisp 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 Log: Signal to the caller whenever a certain feature is unavailable.
Modified: usocket/trunk/backend/allegro.lisp ============================================================================== --- usocket/trunk/backend/allegro.lisp (original) +++ usocket/trunk/backend/allegro.lisp Mon Jul 28 17:57:23 2008 @@ -49,10 +49,11 @@ :text :binary))
-(defun socket-connect (host port &key (element-type 'character) timeout nodelay) - (declare (ignore nodelay)) - (when timeout - (warn "SOCKET-CONNECT timeout not supported in Allegro CL")) +(defun socket-connect (host port &key (element-type 'character) timeout + (nodelay t)) ;; nodelay == t is the ACL default + (declare (ignorable timeout)) + (unsupported 'timeout 'socket-connect) + (let ((socket)) (setf socket (with-mapped-conditions (socket) @@ -60,10 +61,12 @@ (mp:with-timeout (timeout nil) (socket:make-socket :remote-host (host-to-hostname host) :remote-port port - :format (to-format element-type))) + :format (to-format element-type) + :nodelay nodelay)) (socket:make-socket :remote-host (host-to-hostname host) :remote-port port - :format (to-format element-type))))) + :format (to-format element-type) + :nodelay nodelay)))) (make-stream-socket :socket socket :stream socket)))
Modified: usocket/trunk/backend/armedbear.lisp ============================================================================== --- usocket/trunk/backend/armedbear.lisp (original) +++ usocket/trunk/backend/armedbear.lisp Mon Jul 28 17:57:23 2008 @@ -187,9 +187,10 @@ (error (error 'unknown-error :socket socket :real-error condition))))
(defun socket-connect (host port &key (element-type 'character) timeout nodelay) - (declare (ignore nodelay)) - (when timeout - (warn "SOCKET-CONNECT timeout not supported in ABCL")) + (declare (ignore nodelay timeout)) + (unsupported 'timeout 'socket-connect) + (unimplemented 'nodelay 'socket-connect) + (let ((usock)) (with-mapped-conditions (usock) (let* ((sock-addr (jdi:jcoerce
Modified: usocket/trunk/backend/clisp.lisp ============================================================================== --- usocket/trunk/backend/clisp.lisp (original) +++ usocket/trunk/backend/clisp.lisp Mon Jul 28 17:57:23 2008 @@ -56,9 +56,10 @@ (signal usock-err :socket socket)))))))
(defun socket-connect (host port &key (element-type 'character) timeout nodelay) - (declare (ignore nodelay)) - (when timeout - (warn "SOCKET-CONNECT timeout not supported in CLISP")) + (declare (ignore nodelay timeout)) + (unsupported 'nodelay 'socket-connect) + (unsupported 'timeout 'socket-connect) + (let ((socket) (hostname (host-to-hostname host))) (with-mapped-conditions (socket)
Modified: usocket/trunk/backend/cmucl.lisp ============================================================================== --- usocket/trunk/backend/cmucl.lisp (original) +++ usocket/trunk/backend/cmucl.lisp Mon Jul 28 17:57:23 2008 @@ -51,9 +51,10 @@ :condition condition))))
(defun socket-connect (host port &key (element-type 'character) timeout nodelay) - (declare (ignore nodelay)) - (when timeout - (warn "SOCKET-CONNECT timeout not supported in CMUCL")) + (declare (ignore nodelay timeout)) + (unsupported 'nodelay 'socket-connect) + (unsupported 'timeout 'socket-connect) + (let* ((socket)) (setf socket (with-mapped-conditions (socket)
Modified: usocket/trunk/backend/lispworks.lisp ============================================================================== --- usocket/trunk/backend/lispworks.lisp (original) +++ usocket/trunk/backend/lispworks.lisp Mon Jul 28 17:57:23 2008 @@ -75,8 +75,8 @@
(defun socket-connect (host port &key (element-type 'base-char) timeout nodelay) (declare (ignore nodelay)) - (when timeout - (warn "SOCKET-CONNECT timeout not supported in Lispworks")) + (unsupported 'timeout 'socket-connect) + (unimplemented 'nodelay 'socket-connect) (let ((hostname (host-to-hostname host)) (stream)) (setf stream @@ -93,6 +93,10 @@ (reuse-address nil reuse-address-supplied-p) (backlog 5) (element-type 'base-char)) + #+lispworks4.1 + (unsupported 'host 'socket-listen) + #+lispworks4.1 + (unsupported 'backlog 'socket-listen) (let* ((reuseaddress (if reuse-address-supplied-p reuse-address reuseaddress)) (comm::*use_so_reuseaddr* reuseaddress) (hostname (host-to-hostname host))
Modified: usocket/trunk/backend/sbcl.lisp ============================================================================== --- usocket/trunk/backend/sbcl.lisp (original) +++ usocket/trunk/backend/sbcl.lisp Mon Jul 28 17:57:23 2008 @@ -204,6 +204,9 @@ (declare (ignore deadline)) (when timeout (warn "SOCKET-CONNECT timeout not supported in SBCL")) + (unsupported 'deadline 'socket-connect) + (unsupported 'timeout 'socket-connect) + (unimplemented 'nodelay 'socket-connect) (let* ((socket (make-instance 'sb-bsd-sockets:inet-socket :type :stream :protocol :tcp)) (stream (sb-bsd-sockets:socket-make-stream socket
Modified: usocket/trunk/backend/scl.lisp ============================================================================== --- usocket/trunk/backend/scl.lisp (original) +++ usocket/trunk/backend/scl.lisp Mon Jul 28 17:57:23 2008 @@ -29,9 +29,10 @@ :condition condition))))
(defun socket-connect (host port &key (element-type 'character) timeout nodelay) - (declare (ignore nodelay)) - (when timeout - (warn "SOCKET-CONNECT timeout not supported in SCL")) + (declare (ignore nodelay timeout)) + (unsupported 'nodelay 'socket-connect) + (unsupported 'timeout 'socket-connect) + (let* ((socket (with-mapped-conditions () (ext:connect-to-inet-socket (host-to-hbo host) port :kind :stream)))
Modified: usocket/trunk/condition.lisp ============================================================================== --- usocket/trunk/condition.lisp (original) +++ usocket/trunk/condition.lisp Mon Jul 28 17:57:23 2008 @@ -190,3 +190,11 @@ (2 . ns-try-again-condition) (3 . ns-no-recovery-error)))
+ + +(defmacro unsupported (feature context &key minimum) + `(signal 'unsupported :feature ,feature + :context ,context :minimum ,minimum)) + +(defmacro unimplemented (feature context) + `(signal 'unimplemented :feature ,feature :context ,context)) \ No newline at end of file