Author: ctian Date: Mon Jan 4 02:49:39 2010 New Revision: 510 Log: MCL and usocket-test fixes from James Anderson <james.anderson@setf.de> Added: usocket/trunk/usocket-test.asd Removed: usocket/trunk/test/usocket-test.asd Modified: usocket/trunk/backend/mcl.lisp usocket/trunk/test/test-usocket.lisp usocket/trunk/usocket.asd Modified: usocket/trunk/backend/mcl.lisp ============================================================================== --- usocket/trunk/backend/mcl.lisp (original) +++ usocket/trunk/backend/mcl.lisp Mon Jan 4 02:49:39 2010 @@ -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 Modified: usocket/trunk/test/test-usocket.lisp ============================================================================== --- usocket/trunk/test/test-usocket.lisp (original) +++ usocket/trunk/test/test-usocket.lisp Mon Jan 4 02:49:39 2010 @@ -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 Added: usocket/trunk/usocket-test.asd ============================================================================== --- (empty file) +++ usocket/trunk/usocket-test.asd Mon Jan 4 02:49:39 2010 @@ -0,0 +1,26 @@ +;;;; -*- Mode: Lisp -*- +;;;; $Id: usocket-test.asd 46 2006-02-06 20:50:07Z ehuelsmann $ +;;;; $URL: svn+ssh://common-lisp.net/project/usocket/svn/usocket/trunk/test/usocket-test.asd $ + +;;;; See the LICENSE file for licensing information. + +(in-package :cl-user) + +(unless (find-package ':usocket-system) + (make-package ':usocket-system + :use '(:cl :asdf))) + +(in-package :usocket-system) + +(defsystem usocket-test + :name "usocket test" + :author "Erik Enge" + :version "0.1.0" + :licence "MIT" + :description "Tests for usocket" + :depends-on (:usocket + :rt) + :components ((:module "test" + :components ((:file "package") + (:file "test-usocket" + :depends-on ("package")))))) Modified: usocket/trunk/usocket.asd ============================================================================== --- usocket/trunk/usocket.asd (original) +++ usocket/trunk/usocket.asd Mon Jan 4 02:49:39 2010 @@ -1,4 +1,4 @@ - +;;;; -*- Mode: Lisp -*- ;;;; $Id$ ;;;; $URL$ @@ -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" + :version "0.5.0" :licence "MIT" :description "Universal socket library for Common Lisp" - :depends-on (:split-sequence + :depends-on (;; :split-sequence + ;; use the splie-sequence from cl-utilities + :cl-utilities #+sbcl :sb-bsd-sockets) :components ((:file "package") (:file "usocket" @@ -25,15 +29,15 @@ (:file "condition" :depends-on ("usocket")) (:module "vendor" - :components (#+mcl (:file "kqueue"))) + :components (#+mcl (:file "kqueue"))) (:module "backend" - :depends-on ("condition" "vendor") - :components (#+clisp (:file "clisp") - #+cmu (:file "cmucl") - #+scl (:file "scl") - #+(or sbcl ecl) (:file "sbcl") - #+lispworks (:file "lispworks") - #+mcl (:file "mcl") - #+openmcl (:file "openmcl") - #+allegro (:file "allegro") - #+armedbear (:file "armedbear"))))) + :depends-on ("condition" "vendor") + :components (#+clisp (:file "clisp") + #+cmu (:file "cmucl") + #+scl (:file "scl") + #+(or sbcl ecl) (:file "sbcl") + #+lispworks (:file "lispworks") + #+mcl (:file "mcl") + #+openmcl (:file "openmcl") + #+allegro (:file "allegro") + #+armedbear (:file "armedbear")))))