[usocket-cvs] r403 - usocket/trunk/backend - usocket-cvs@common-lisp.net - mailman3.common-lisp.net

29 Jul 2008

Author: ehuelsmann
Date: Tue Jul 29 17:13:43 2008
New Revision: 403
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
Log:
Make reporting of unimplemented and unsupported features dependent on their use.
Modified: usocket/trunk/backend/allegro.lisp
==============================================================================

--- usocket/trunk/backend/allegro.lisp	(original)
+++ usocket/trunk/backend/allegro.lisp	Tue Jul 29 17:13:43 2008
@@ -52,9 +52,8 @@
 (defun socket-connect (host port &key (element-type 'character)
                        timeout deadline
                        (nodelay t)) ;; nodelay == t is the ACL default
-  (declare (ignorable timeout))
-  (unsupported 'timeout 'socket-connect)
-  (unsupported 'deadline 'socket-connect)
+  (when timeout (unsupported 'timeout 'socket-connect))
+  (when deadline (unsupported 'deadline 'socket-connect))
(let ((socket))
     (setf socket
Modified: usocket/trunk/backend/armedbear.lisp
==============================================================================
--- usocket/trunk/backend/armedbear.lisp	(original)
+++ usocket/trunk/backend/armedbear.lisp	Tue Jul 29 17:13:43 2008
@@ -189,8 +189,7 @@
 (defun socket-connect (host port &key (element-type 'character)
                        timeout deadline (nodelay nil nodelay-specified))
   (declare (ignore nodelay timeout))
-  (unsupported 'timeout 'socket-connect)
-  (unimplemented 'deadline 'socket-connect)
+  (when deadline (unsupported 'deadline 'socket-connect))
(let ((usock))
     (with-mapped-conditions (usock)
@@ -207,6 +206,9 @@
                                (if nodelay
                                    (java:make-immediate-object t :boolean)
                                    (java:make-immediate-object nil :boolean))))
+        (when timeout
+          (jdi:do-jmethod-call sock "setSoTimeout"
+                                    (truncate (* 1000 timeout))))
         (setf usock
               (make-stream-socket
                :socket jchan
Modified: usocket/trunk/backend/clisp.lisp
==============================================================================
--- usocket/trunk/backend/clisp.lisp	(original)
+++ usocket/trunk/backend/clisp.lisp	Tue Jul 29 17:13:43 2008
@@ -56,11 +56,11 @@
                (signal usock-err :socket socket)))))))
(defun socket-connect (host port &key (element-type 'character)
-                       timeout deadline nodelay)
-  (declare (ignore nodelay timeout))
-  (unsupported 'timeout 'socket-connect)
-  (unsupported 'deadline 'socket-connect)
-  (unsupported 'nodelay 'socket-connect)
+                       timeout deadline (nodelay t nodelay-specified))
+  (declare (ignore nodelay))
+  (when timeout (unsupported 'timeout 'socket-connect))
+  (when deadline (unsupported 'deadline 'socket-connect))
+  (when nodelay-specified (unsupported 'nodelay '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	Tue Jul 29 17:13:43 2008
@@ -51,11 +51,11 @@
                                                :condition condition))))
(defun socket-connect (host port &key (element-type 'character)
-                       timeout deadline nodelay)
-  (declare (ignore nodelay timeout))
-  (unsupported 'timeout 'socket-connect)
-  (unsupported 'deadline 'socket-connect)
-  (unsupported 'nodelay 'socket-connect)
+                       timeout deadline (nodelay t nodelay-specified))
+  (declare (ignore nodelay))
+  (when timeout (unsupported 'timeout 'socket-connect))
+  (when deadline (unsupported 'deadline 'socket-connect))
+  (when nodelay-specified (unsupported 'nodelay 'socket-connect))
(let* ((socket))
     (setf socket
Modified: usocket/trunk/backend/lispworks.lisp
==============================================================================
--- usocket/trunk/backend/lispworks.lisp	(original)
+++ usocket/trunk/backend/lispworks.lisp	Tue Jul 29 17:13:43 2008
@@ -74,17 +74,23 @@
                     (raise-usock-err errno socket condition)))))
(defun socket-connect (host port &key (element-type 'base-char)
-                       timeout deadline nodelay)
-  (declare (ignore nodelay))
-  (unsupported 'timeout 'socket-connect)
-  (unsupported 'deadline 'socket-connect)
-  (unimplemented 'nodelay 'socket-connect)
+                       timeout deadline (nodelay t nodelay-specified))
+  (declare (ignorable nodelay))
+  (when timeout (unimplemented 'timeout 'socket-connect))
+  (when deadline (unsupported 'deadline 'socket-connect "LispWorks 5.1"))
+  
+  #+(and (not lispworks4) (not lispworks5.0))
+  (when nodelay-specified (unimplemented 'nodelay 'socket-connect))
+
   (let ((hostname (host-to-hostname host))
         (stream))
     (setf stream
           (with-mapped-conditions ()
              (comm:open-tcp-stream hostname port
-                                   :element-type element-type)))
+                                   :element-type element-type
+                                   #+(and (not lispworks4) (not lispworks5.0))
+                                   #+(and (not lispworks4) (not lispworks5.0))
+                                   :nodelay nodelay)))
     (if stream
         (make-stream-socket :socket (comm:socket-stream-socket stream)
                             :stream stream)
@@ -96,9 +102,10 @@
                            (backlog 5)
                            (element-type 'base-char))
   #+lispworks4.1
-  (unsupported 'host 'socket-listen)
+  (unsupported 'host 'socket-listen "LispWorks 4.0 or newer than 4.1")
   #+lispworks4.1
-  (unsupported 'backlog 'socket-listen)
+  (unsupported 'backlog 'socket-listen "LispWorks 4.0 or newer than 4.1")
+
   (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	Tue Jul 29 17:13:43 2008
@@ -201,9 +201,8 @@
(defun socket-connect (host port &key (element-type 'character)
                        timeout deadline (nodelay t nodelay-specified))
-  (declare (ignore deadline timeout))
-  (unsupported 'deadline 'socket-connect)
-  (unsupported 'timeout 'socket-connect)
+  (when deadline (unsupported 'deadline 'socket-connect))
+  (when timeout (unsupported 'timeout 'socket-connect))
(let* ((socket (make-instance 'sb-bsd-sockets:inet-socket
                                 :type :stream :protocol :tcp))
Modified: usocket/trunk/backend/scl.lisp
==============================================================================
--- usocket/trunk/backend/scl.lisp	(original)
+++ usocket/trunk/backend/scl.lisp	Tue Jul 29 17:13:43 2008
@@ -29,11 +29,11 @@
                :condition condition))))
(defun socket-connect (host port &key (element-type 'character)
-                       timeout deadline nodelay)
-  (declare (ignore nodelay timeout))
-  (unsupported 'nodelay 'socket-connect)
-  (unsupported 'deadline 'socket-connect)
-  (unsupported 'timeout 'socket-connect)
+                       timeout deadline (nodelay t nodelay-specified))
+  (declare (ignore nodelay))
+  (when nodelay-specified (unsupported 'nodelay 'socket-connect))
+  (when deadline (unsupported 'deadline 'socket-connect))
+  (when timeout (unsupported 'timeout 'socket-connect))
(let* ((socket (with-mapped-conditions ()
                   (ext:connect-to-inet-socket (host-to-hbo host) port

    