[usocket-cvs] r399 - in usocket/trunk: . backend

[ehuelsmann at common-lisp.net]

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