[usocket-cvs] r510 - in usocket/trunk: . backend test
Chun Tian (binghe)
ctian at common-lisp.net
Mon Jan 4 07:49:40 UTC 2010
Author: ctian
Date: Mon Jan 4 02:49:39 2010
New Revision: 510
Log:
MCL and usocket-test fixes from James Anderson <james.anderson at 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")))))
More information about the usocket-cvs
mailing list