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