good evening;
please find attached patches for the mcl back-end and the tests. the
system names follow from the local conventions for asdf systems, but
the other changes should be generally useful.
given these changes mcl 5.2 passes all 15. i cross-checked with
openmcl ("Version 1.3-r11936 (DarwinPPC32)") which succeded as well.
* test/test-usocket.lisp
: added timeout arguments to the no-connect tests, as both mcl and
openmcl otherwise hang
: added mcl to the caught conditions for failure tests
: wrapped typep tests to force t/nil
: corrected #\newline to be #\linefeed
: added a +local-ip+ variable
* test/usocket-test.asd
: changed dependencies to be fully qualified
* usocket.asd
: modified dependency to use cl-utilities (by fully qualified system
name)
* backend/mcl.lisp
: handle-condition : corrected to formulate the error argument as
required for the respective error class
: socket-connect : reinstated with-mapped-conditions
: socket-listen : reinstated with-mapped-conditions
: socket-accept : reinstated with-mapped-conditions
: %*-wait operators : added no-op versions
Index: test/test-usocket.lisp
===================================================================
--- test/test-usocket.lisp (revision 507)
+++ test/test-usocket.lisp (working copy)
@@ -7,12 +7,15 @@
;; The parameters below may need adjustments to match the system
;; the tests are run on.
-(defparameter +non-existing-host+ "192.168.1.1")
+(defparameter +non-existing-host+ "192.168.1.199")
(defparameter +unused-local-port+ 15213)
(defparameter *soc1* (usocket::make-stream-socket :socket :my-socket
:stream :my-stream))
(eval-when (:compile-toplevel :load-toplevel :execute)
- (defparameter +common-lisp-net+ #(80 68 86 115))) ;; common-lisp.net IP
+ (defparameter +local-ip+ #(192 168 1 25))
+ (defparameter +common-lisp-net+
+ #+ignore #(80 68 86 115) ;; common-lisp.net IP (not valid as of 2010-01-03
+ (first (usocket::get-hosts-by-name "common-lisp.net"))))
(defmacro with-caught-conditions ((expect throw) &body body)
`(catch 'caught-error
@@ -48,29 +51,29 @@
(deftest socket-no-connect.1
(with-caught-conditions ('usocket:socket-error nil)
- (usocket:socket-connect "127.0.0.0" +unused-local-port+)
+ (usocket:socket-connect "127.0.0.0" +unused-local-port+ :timeout 0)
t)
nil)
(deftest socket-no-connect.2
(with-caught-conditions ('usocket:socket-error nil)
- (usocket:socket-connect #(127 0 0 0) +unused-local-port+)
+ (usocket:socket-connect #(127 0 0 0) +unused-local-port+ :timeout 0)
t)
nil)
(deftest socket-no-connect.3
(with-caught-conditions ('usocket:socket-error nil)
- (usocket:socket-connect 2130706432 +unused-local-port+) ;; == #(127 0 0 0)
+ (usocket:socket-connect 2130706432 +unused-local-port+ :timeout 0) ;; ==
#(127 0 0 0)
t)
nil)
(deftest socket-failure.1
- (with-caught-conditions (#-(or cmu lispworks armedbear openmcl)
+ (with-caught-conditions (#-(or cmu lispworks armedbear openmcl mcl)
'usocket:network-unreachable-error
#+(or cmu lispworks armedbear)
'usocket:unknown-error
- #+openmcl
+ #+(or openmcl mcl)
'usocket:timeout-error
nil)
- (usocket:socket-connect 2130706432 +unused-local-port+) ;; == #(127 0 0 0)
+ (usocket:socket-connect 2130706432 +unused-local-port+ :timeout 0) ;; ==
#(127 0 0 0)
:unreach)
nil)
(deftest socket-failure.2
@@ -78,12 +81,12 @@
'usocket:unknown-error
#+cmu
'usocket:network-unreachable-error
- #+openmcl
+ #+(or openmcl mcl)
'usocket:timeout-error
- #-(or lispworks armedbear cmu openmcl)
+ #-(or lispworks armedbear cmu openmcl mcl)
'usocket:host-unreachable-error
nil)
- (usocket:socket-connect +non-existing-host+ 80) ;; 80 = just a port
+ (usocket:socket-connect +non-existing-host+ 80 :timeout 0) ;; 80 = just
a port
:unreach)
nil)
@@ -94,21 +97,21 @@
(with-caught-conditions (nil nil)
(let ((sock (usocket:socket-connect "common-lisp.net" 80)))
(unwind-protect
- (typep sock 'usocket:usocket)
+ (when (typep sock 'usocket:usocket) t)
(usocket:socket-close sock))))
t)
(deftest socket-connect.2
(with-caught-conditions (nil nil)
(let ((sock (usocket:socket-connect +common-lisp-net+ 80)))
(unwind-protect
- (typep sock 'usocket:usocket)
+ (when (typep sock 'usocket:usocket) t)
(usocket:socket-close sock))))
t)
(deftest socket-connect.3
(with-caught-conditions (nil nil)
(let ((sock (usocket:socket-connect (usocket::host-byte-order
+common-lisp-net+) 80)))
(unwind-protect
- (typep sock 'usocket:usocket)
+ (when (typep sock 'usocket:usocket) t)
(usocket:socket-close sock))))
t)
@@ -119,13 +122,13 @@
(unwind-protect
(progn
(format (usocket:socket-stream sock)
- "GET / HTTP/1.0~A~A~A~A"
- #\Return #\Newline #\Return #\Newline)
+ "GET / HTTP/1.0~c~c~c~c"
+ #\Return #\linefeed #\Return #\linefeed)
(force-output (usocket:socket-stream sock))
(read-line (usocket:socket-stream sock)))
(usocket:socket-close sock))))
- #+clisp "HTTP/1.1 200 OK"
- #-clisp #.(format nil "HTTP/1.1 200 OK~A" #\Return) nil)
+ #+(or mcl clisp) "HTTP/1.1 200 OK"
+ #-(or clisp mcl) #.(format nil "HTTP/1.1 200 OK~A" #\Return) nil)
(deftest socket-name.1
(with-caught-conditions (nil nil)
@@ -154,8 +157,10 @@
(unwind-protect
(usocket::get-local-address sock)
(usocket:socket-close sock))))
- #(192 168 1 65))
+ #.+local-ip+)
(defun run-usocket-tests ()
(do-tests))
+
+;;; (usoct::run-usocket-tests )
\ No newline at end of file
Index: test/usocket-test.asd
===================================================================
--- test/usocket-test.asd (revision 507)
+++ test/usocket-test.asd (working copy)
@@ -10,13 +10,13 @@
(in-package #:usocket-test-system)
-(defsystem usocket-test
- :name "usocket-test"
+(defsystem :net.common-lisp.usocket.test
:author "Erik Enge"
:version "0.1.0"
:licence "MIT"
:description "Tests for usocket"
- :depends-on (:usocket :rt)
+ :depends-on (:net.common-lisp.usocket
+ :edu.mit.rt)
:components ((:file "package")
(:file "test-usocket"
:depends-on ("package"))))
Index: usocket.asd
===================================================================
--- usocket.asd (revision 507)
+++ usocket.asd (working copy)
@@ -11,13 +11,17 @@
(in-package #:usocket-system)
+(pushnew :split-sequence-deprecated *features*)
+
(defsystem usocket
:name "usocket"
:author "Erik Enge & Erik Huelsmann"
:version "0.5.0-dev"
:licence "MIT"
:description "Universal socket library for Common Lisp"
- :depends-on (:split-sequence
+ :depends-on (;; :split-sequence
+ ;; use the splie-sequence from cl-utilities
+ :net.common-lisp.cl-utilities
#+sbcl :sb-bsd-sockets)
:components ((:file "package")
(:file "usocket"
Index: backend/mcl.lisp
===================================================================
--- backend/mcl.lisp (revision 507)
+++ backend/mcl.lisp (working copy)
@@ -9,7 +9,9 @@
(defun handle-condition (condition &optional socket)
; incomplete, needs to handle additional conditions
(flet ((raise-error (&optional socket-condition)
- (error (or socket-condition 'unknown-error) :socket socket
:real-error condition)))
+ (if socket-condition
+ (error socket-condition :socket socket)
+ (error 'unknown-error :socket socket :real-error condition))))
(typecase condition
(ccl:host-stopped-responding
(raise-error 'host-down-error))
@@ -20,24 +22,25 @@
(ccl:connection-timed-out
(raise-error 'timeout-error))
(ccl:opentransport-protocol-error
- (raise-error ''protocol-not-supported-error))
+ (raise-error 'protocol-not-supported-error))
(otherwise
(raise-error)))))
(defun socket-connect (host port &key (element-type 'character) timeout
deadline nodelay
local-host local-port)
- (let* ((socket
- (make-instance 'active-socket
- :remote-host (when host (host-to-hostname host))
- :remote-port port
- :local-host (when local-host (host-to-hostname
local-host))
- :local-port local-port
- :deadline deadline
- :nodelay nodelay
- :connect-timeout (and timeout (round (* timeout 60)))
- :element-type element-type))
- (stream (socket-open-stream socket)))
- (make-stream-socket :socket socket :stream stream)))
+ (with-mapped-conditions ()
+ (let* ((socket
+ (make-instance 'active-socket
+ :remote-host (when host (host-to-hostname host))
+ :remote-port port
+ :local-host (when local-host (host-to-hostname local-host))
+ :local-port local-port
+ :deadline deadline
+ :nodelay nodelay
+ :connect-timeout (and timeout (round (* timeout 60)))
+ :element-type element-type))
+ (stream (socket-open-stream socket)))
+ (make-stream-socket :socket socket :stream stream))))
(defun socket-listen (host port
&key reuseaddress
@@ -45,16 +48,18 @@
(backlog 5)
(element-type 'character))
(declare (ignore reuseaddress reuse-address-supplied-p))
- (let ((socket (make-instance 'passive-socket
- :local-port port
- :local-host host
- :reuse-address reuse-address
- :backlog backlog)))
+ (let ((socket (with-mapped-conditions ()
+ (make-instance 'passive-socket
+ :local-port port
+ :local-host host
+ :reuse-address reuse-address
+ :backlog backlog))))
(make-stream-server-socket socket :element-type element-type)))
(defmethod socket-accept ((usocket stream-server-usocket) &key element-type)
(let* ((socket (socket usocket))
- (stream (socket-accept socket :element-type element-type)))
+ (stream (with-mapped-conditions (usocket)
+ (socket-accept socket :element-type element-type))))
(make-stream-socket :socket socket :stream stream)))
(defmethod socket-close ((usocket usocket))
@@ -93,6 +98,17 @@
(defmethod get-peer-port ((usocket stream-usocket))
(remote-port (socket usocket)))
+
+(defun %setup-wait-list (wait-list)
+ (declare (ignore wait-list)))
+
+(defun %add-waiter (wait-list waiter)
+ (declare (ignore wait-list waiter)))
+
+(defun %remove-waiter (wait-list waiter)
+ (declare (ignore wait-list waiter)))
+
+
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; BASIC MCL SOCKET IMPLEMENTATION
_______________________________________________
usocket-devel mailing list
[email protected]
http://common-lisp.net/cgi-bin/mailman/listinfo/usocket-devel
