[usocket-cvs] r397 - usocket/trunk/backend

[ehuelsmann at common-lisp.net]

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 ()