Author: ehuelsmann Date: Mon Jul 28 17:33:19 2008 New Revision: 397
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/openmcl.lisp usocket/trunk/backend/sbcl.lisp usocket/trunk/backend/scl.lisp Log: Merge hans/ branch into trunk.
Modified: usocket/trunk/backend/allegro.lisp ============================================================================== --- usocket/trunk/backend/allegro.lisp (original) +++ usocket/trunk/backend/allegro.lisp Mon Jul 28 17:33:19 2008 @@ -49,7 +49,10 @@ :text :binary))
-(defun socket-connect (host port &key (element-type 'character) timeout) +(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")) (let ((socket)) (setf socket (with-mapped-conditions (socket)
Modified: usocket/trunk/backend/armedbear.lisp ============================================================================== --- usocket/trunk/backend/armedbear.lisp (original) +++ usocket/trunk/backend/armedbear.lisp Mon Jul 28 17:33:19 2008 @@ -186,7 +186,8 @@ (typecase condition (error (error 'unknown-error :socket socket :real-error condition))))
-(defun socket-connect (host port &key (element-type 'character) timeout) +(defun socket-connect (host port &key (element-type 'character) timeout nodelay) + (declare (ignore nodelay)) (when timeout (warn "SOCKET-CONNECT timeout not supported in ABCL")) (let ((usock))
Modified: usocket/trunk/backend/clisp.lisp ============================================================================== --- usocket/trunk/backend/clisp.lisp (original) +++ usocket/trunk/backend/clisp.lisp Mon Jul 28 17:33:19 2008 @@ -55,7 +55,10 @@ (error usock-err :socket socket) (signal usock-err :socket socket)))))))
-(defun socket-connect (host port &key (element-type 'character) timeout) +(defun socket-connect (host port &key (element-type 'character) timeout nodelay) + (declare (ignore nodelay)) + (when timeout + (warn "SOCKET-CONNECT timeout not supported in CLISP")) (let ((socket) (hostname (host-to-hostname host))) (with-mapped-conditions (socket) @@ -239,7 +242,7 @@ (when (wait-list usocket) (remove-waiter (wait-list usocket) usocket)) (rawsock:sock-close (socket usocket))) - + )
#-rawsock @@ -248,4 +251,4 @@ To enable UDP socket support, please be sure to use the -Kfull parameter at startup, or to enable RAWSOCK support during compilation.")
- ) \ No newline at end of file + )
Modified: usocket/trunk/backend/cmucl.lisp ============================================================================== --- usocket/trunk/backend/cmucl.lisp (original) +++ usocket/trunk/backend/cmucl.lisp Mon Jul 28 17:33:19 2008 @@ -50,7 +50,8 @@ :socket socket :condition condition))))
-(defun socket-connect (host port &key (element-type 'character) timeout) +(defun socket-connect (host port &key (element-type 'character) timeout nodelay) + (declare (ignore nodelay)) (when timeout (warn "SOCKET-CONNECT timeout not supported in CMUCL")) (let* ((socket))
Modified: usocket/trunk/backend/lispworks.lisp ============================================================================== --- usocket/trunk/backend/lispworks.lisp (original) +++ usocket/trunk/backend/lispworks.lisp Mon Jul 28 17:33:19 2008 @@ -73,7 +73,8 @@ (declare (ignore host port err-msg)) (raise-usock-err errno socket condition)))))
-(defun socket-connect (host port &key (element-type 'base-char) timeout) +(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")) (let ((hostname (host-to-hostname host))
Modified: usocket/trunk/backend/openmcl.lisp ============================================================================== --- usocket/trunk/backend/openmcl.lisp (original) +++ usocket/trunk/backend/openmcl.lisp Mon Jul 28 17:33:19 2008 @@ -61,6 +61,8 @@ (openmcl-socket:socket-error (raise-error-from-id (openmcl-socket:socket-error-identifier condition) socket condition)) + (ccl:input-timeout + (error 'timeout-error :socket socket :real-error condition)) (ccl:communication-deadline-expired (error 'timeout-error :socket socket :real-error condition)) (ccl::socket-creation-error #| ugh! |# @@ -72,13 +74,14 @@ :text :binary))
-(defun socket-connect (host port &key (element-type 'character) timeout deadline) +(defun socket-connect (host port &key (element-type 'character) timeout deadline nodelay) (with-mapped-conditions () (let ((mcl-sock (openmcl-socket:make-socket :remote-host (host-to-hostname host) :remote-port port :format (to-format element-type) :deadline deadline + :nodelay nodelay :connect-timeout (and timeout (* timeout internal-time-units-per-second))))) (openmcl-socket:socket-connect mcl-sock)
Modified: usocket/trunk/backend/sbcl.lisp ============================================================================== --- usocket/trunk/backend/sbcl.lisp (original) +++ usocket/trunk/backend/sbcl.lisp Mon Jul 28 17:33:19 2008 @@ -130,7 +130,7 @@ } @(return) = select(#3 + 1, (fd_set*)#2, NULL, NULL, (#0 != Cnil) ? &tv : NULL); -"))) +" :one-liner nil))) (cond ((= 0 count) (values nil nil)) @@ -199,7 +199,8 @@ (signal usock-cond :socket socket))))))
-(defun socket-connect (host port &key (element-type 'character) timeout deadline) +(defun socket-connect (host port &key (element-type 'character) timeout deadline nodelay) + (declare (ignore nodelay)) (declare (ignore deadline)) (when timeout (warn "SOCKET-CONNECT timeout not supported in SBCL"))
Modified: usocket/trunk/backend/scl.lisp ============================================================================== --- usocket/trunk/backend/scl.lisp (original) +++ usocket/trunk/backend/scl.lisp Mon Jul 28 17:33:19 2008 @@ -28,7 +28,8 @@ :socket socket :condition condition))))
-(defun socket-connect (host port &key (element-type 'character) timeout) +(defun socket-connect (host port &key (element-type 'character) timeout nodelay) + (declare (ignore nodelay)) (when timeout (warn "SOCKET-CONNECT timeout not supported in SCL")) (let* ((socket (with-mapped-conditions ()