usocket-cvs June 2010

usocket-cvs@common-lisp.net

1 participants
8 discussions

[usocket-cvs] r530 - in usocket/trunk: . test
by Chun Tian 29 Jun '10

29 Jun '10

Author: ctian Date: Tue Jun 29 08:49:36 2010 New Revision: 530 Log: SBCL: fix for calling (asdf:oos 'asdf:test-op :usocket) Modified: usocket/trunk/test/test-usocket.lisp usocket/trunk/usocket.asd Modified: usocket/trunk/test/test-usocket.lisp ============================================================================== --- usocket/trunk/test/test-usocket.lisp (original) +++ usocket/trunk/test/test-usocket.lisp Tue Jun 29 08:49:36 2010 @@ -14,8 +14,9 @@ (usocket::make-stream-socket :socket :my-socket :stream :my-stream)) -(defconstant +common-lisp-net+ - #.(first (usocket::get-hosts-by-name "common-lisp.net"))) +(eval-when (:compile-toplevel :load-toplevel :execute) + (defvar *common-lisp-net* + #.(first (usocket::get-hosts-by-name "common-lisp.net")))) (defvar *local-ip*) @@ -107,7 +108,7 @@ (deftest socket-connect.2 (with-caught-conditions (nil nil) - (let ((sock (usocket:socket-connect +common-lisp-net+ 80))) + (let ((sock (usocket:socket-connect *common-lisp-net* 80))) (unwind-protect (when (typep sock 'usocket:usocket) t) (usocket:socket-close sock)))) @@ -115,7 +116,7 @@ (deftest socket-connect.3 (with-caught-conditions (nil nil) - (let ((sock (usocket:socket-connect (usocket::host-byte-order +common-lisp-net+) 80))) + (let ((sock (usocket:socket-connect (usocket::host-byte-order *common-lisp-net*) 80))) (unwind-protect (when (typep sock 'usocket:usocket) t) (usocket:socket-close sock)))) @@ -138,15 +139,15 @@ (deftest socket-name.1 (with-caught-conditions (nil nil) - (let ((sock (usocket:socket-connect +common-lisp-net+ 80))) + (let ((sock (usocket:socket-connect *common-lisp-net* 80))) (unwind-protect (usocket::get-peer-address sock) (usocket:socket-close sock)))) - #.+common-lisp-net+) + #.*common-lisp-net*) (deftest socket-name.2 (with-caught-conditions (nil nil) - (let ((sock (usocket:socket-connect +common-lisp-net+ 80))) + (let ((sock (usocket:socket-connect *common-lisp-net* 80))) (unwind-protect (usocket::get-peer-port sock) (usocket:socket-close sock)))) @@ -154,16 +155,16 @@ (deftest socket-name.3 (with-caught-conditions (nil nil) - (let ((sock (usocket:socket-connect +common-lisp-net+ 80))) + (let ((sock (usocket:socket-connect *common-lisp-net* 80))) (unwind-protect (usocket::get-peer-name sock) (usocket:socket-close sock)))) - #.+common-lisp-net+ 80) + #.*common-lisp-net* 80) #+ignore (deftest socket-name.4 (with-caught-conditions (nil nil) - (let ((sock (usocket:socket-connect +common-lisp-net+ 80))) + (let ((sock (usocket:socket-connect *common-lisp-net* 80))) (unwind-protect (equal (usocket::get-local-address sock) *local-ip*) (usocket:socket-close sock)))) @@ -174,7 +175,7 @@ (deftest wait-for-input.1 (with-caught-conditions (nil nil) - (let ((sock (usocket:socket-connect +common-lisp-net+ 80)) + (let ((sock (usocket:socket-connect *common-lisp-net* 80)) (time (get-universal-time))) (unwind-protect (progn (usocket:wait-for-input sock :timeout *wait-for-input-timeout*) @@ -184,7 +185,7 @@ (deftest wait-for-input.2 (with-caught-conditions (nil nil) - (let ((sock (usocket:socket-connect +common-lisp-net+ 80)) + (let ((sock (usocket:socket-connect *common-lisp-net* 80)) (time (get-universal-time))) (unwind-protect (progn (usocket:wait-for-input sock :timeout *wait-for-input-timeout* :ready-only t) Modified: usocket/trunk/usocket.asd ============================================================================== --- usocket/trunk/usocket.asd (original) +++ usocket/trunk/usocket.asd Tue Jun 29 08:49:36 2010 @@ -37,4 +37,5 @@ (:file "server" :depends-on ("backend")))) (defmethod perform ((op test-op) (c (eql (find-system :usocket)))) + (oos 'load-op :usocket-test) (oos 'test-op :usocket-test))

1 0

[usocket-cvs] r529 - in usocket/trunk: . test
by Chun Tian 29 Jun '10

29 Jun '10

Author: ctian Date: Tue Jun 29 08:27:32 2010 New Revision: 529 Log: Tests: add support for calling tests by (asdf:test-system :usocket) Modified: usocket/trunk/test/test-usocket.lisp usocket/trunk/usocket-test.asd usocket/trunk/usocket.asd Modified: usocket/trunk/test/test-usocket.lisp ============================================================================== --- usocket/trunk/test/test-usocket.lisp (original) +++ usocket/trunk/test/test-usocket.lisp Tue Jun 29 08:27:32 2010 @@ -142,7 +142,7 @@ (unwind-protect (usocket::get-peer-address sock) (usocket:socket-close sock)))) - +common-lisp-net+) + #.+common-lisp-net+) (deftest socket-name.2 (with-caught-conditions (nil nil) @@ -158,18 +158,19 @@ (unwind-protect (usocket::get-peer-name sock) (usocket:socket-close sock)))) - +common-lisp-net+) + #.+common-lisp-net+ 80) #+ignore (deftest socket-name.4 (with-caught-conditions (nil nil) (let ((sock (usocket:socket-connect +common-lisp-net+ 80))) (unwind-protect - (usocket::get-local-address sock) + (equal (usocket::get-local-address sock) *local-ip*) (usocket:socket-close sock)))) - *local-ip*) + t) -(defparameter *wait-for-input-timeout* 2) +(eval-when (:compile-toplevel :load-toplevel :execute) + (defparameter *wait-for-input-timeout* 2)) (deftest wait-for-input.1 (with-caught-conditions (nil nil) @@ -179,7 +180,7 @@ (progn (usocket:wait-for-input sock :timeout *wait-for-input-timeout*) (- (get-universal-time) time)) (usocket:socket-close sock)))) - *wait-for-input-timeout*) + #.*wait-for-input-timeout*) (deftest wait-for-input.2 (with-caught-conditions (nil nil) @@ -189,7 +190,7 @@ (progn (usocket:wait-for-input sock :timeout *wait-for-input-timeout* :ready-only t) (- (get-universal-time) time)) (usocket:socket-close sock)))) - *wait-for-input-timeout*) + #.*wait-for-input-timeout*) (defun run-usocket-tests () (do-tests)) Modified: usocket/trunk/usocket-test.asd ============================================================================== --- usocket/trunk/usocket-test.asd (original) +++ usocket/trunk/usocket-test.asd Tue Jun 29 08:27:32 2010 @@ -24,3 +24,6 @@ :components ((:file "package") (:file "test-usocket" :depends-on ("package")))))) + +(defmethod perform ((op test-op) (c (eql (find-system :usocket-test)))) + (funcall (intern "DO-TESTS" "USOCKET-TEST"))) Modified: usocket/trunk/usocket.asd ============================================================================== --- usocket/trunk/usocket.asd (original) +++ usocket/trunk/usocket.asd Tue Jun 29 08:27:32 2010 @@ -35,3 +35,6 @@ #+allegro (:file "allegro") #+armedbear (:file "armedbear"))) (:file "server" :depends-on ("backend")))) + +(defmethod perform ((op test-op) (c (eql (find-system :usocket)))) + (oos 'test-op :usocket-test))

1 0

[usocket-cvs] r528 - usocket/trunk/test
by Chun Tian 29 Jun '10

29 Jun '10

Author: ctian Date: Tue Jun 29 08:16:48 2010 New Revision: 528 Log: Tests: add simple unit tests for WAIT-FOR-INPUT (with other small changes). Modified: usocket/trunk/test/package.lisp usocket/trunk/test/test-usocket.lisp Modified: usocket/trunk/test/package.lisp ============================================================================== --- usocket/trunk/test/package.lisp (original) +++ usocket/trunk/test/package.lisp Tue Jun 29 08:16:48 2010 @@ -5,9 +5,7 @@ (in-package :cl-user) -(eval-when (:execute :load-toplevel :compile-toplevel) - (defpackage :usocket-test - (:use :cl :regression-test) - (:nicknames :usoct) - (:export :do-tests :run-usocket-tests))) - +(defpackage :usocket-test + (:use :cl :regression-test) + (:nicknames :usoct) + (:export :do-tests :run-usocket-tests)) Modified: usocket/trunk/test/test-usocket.lisp ============================================================================== --- usocket/trunk/test/test-usocket.lisp (original) +++ usocket/trunk/test/test-usocket.lisp Tue Jun 29 08:16:48 2010 @@ -3,19 +3,21 @@ ;;;; See LICENSE for licensing information. +;;;; Usage: (usoct:run-usocket-tests) or (usoct:do-tests) + (in-package :usocket-test) -;; The parameters below may need adjustments to match the system -;; the tests are run on. -(defparameter +non-existing-host+ "192.168.1.199") +(defparameter +non-existing-host+ "1.2.3.4") (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 +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")))) + +(defparameter *fake-usocket* + (usocket::make-stream-socket :socket :my-socket + :stream :my-stream)) + +(defconstant +common-lisp-net+ + #.(first (usocket::get-hosts-by-name "common-lisp.net"))) + +(defvar *local-ip*) (defmacro with-caught-conditions ((expect throw) &body body) `(catch 'caught-error @@ -46,19 +48,21 @@ (describe c) c)))))) -(deftest make-socket.1 (usocket:socket *soc1*) :my-socket) -(deftest make-socket.2 (usocket:socket-stream *soc1*) :my-stream) +(deftest make-socket.1 (usocket:socket *fake-usocket*) :my-socket) +(deftest make-socket.2 (usocket:socket-stream *fake-usocket*) :my-stream) (deftest socket-no-connect.1 (with-caught-conditions ('usocket:socket-error nil) (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+ :timeout 0) t) nil) + (deftest socket-no-connect.3 (with-caught-conditions ('usocket:socket-error nil) (usocket:socket-connect 2130706432 +unused-local-port+ :timeout 0) ;; == #(127 0 0 0) @@ -76,6 +80,7 @@ (usocket:socket-connect 2130706432 +unused-local-port+ :timeout 0) ;; == #(127 0 0 0) :unreach) nil) + (deftest socket-failure.2 (with-caught-conditions (#+(or lispworks armedbear) 'usocket:unknown-error @@ -86,11 +91,10 @@ #-(or lispworks armedbear cmu openmcl mcl) 'usocket:host-unreachable-error nil) - (usocket:socket-connect +non-existing-host+ 80 :timeout 0) ;; 80 = just a port - :unreach) + (usocket:socket-connect +non-existing-host+ 80 :timeout 0) ;; 80 = just a port + :unreach) nil) - ;; let's hope c-l.net doesn't move soon, or that people start to ;; test usocket like crazy.. (deftest socket-connect.1 @@ -100,6 +104,7 @@ (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))) @@ -107,6 +112,7 @@ (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))) @@ -128,7 +134,7 @@ (read-line (usocket:socket-stream sock))) (usocket:socket-close sock)))) #+(or mcl clisp) "HTTP/1.1 200 OK" - #-(or clisp mcl) #.(format nil "HTTP/1.1 200 OK~A" #\Return) nil) + #-(or mcl clisp) #.(format nil "HTTP/1.1 200 OK~A" #\Return) nil) (deftest socket-name.1 (with-caught-conditions (nil nil) @@ -136,7 +142,8 @@ (unwind-protect (usocket::get-peer-address sock) (usocket:socket-close sock)))) - #.+common-lisp-net+) + +common-lisp-net+) + (deftest socket-name.2 (with-caught-conditions (nil nil) (let ((sock (usocket:socket-connect +common-lisp-net+ 80))) @@ -144,23 +151,45 @@ (usocket::get-peer-port sock) (usocket:socket-close sock)))) 80) + (deftest socket-name.3 (with-caught-conditions (nil nil) (let ((sock (usocket:socket-connect +common-lisp-net+ 80))) (unwind-protect (usocket::get-peer-name sock) (usocket:socket-close sock)))) - #.+common-lisp-net+ 80) + +common-lisp-net+) + +#+ignore (deftest socket-name.4 (with-caught-conditions (nil nil) (let ((sock (usocket:socket-connect +common-lisp-net+ 80))) (unwind-protect (usocket::get-local-address sock) (usocket:socket-close sock)))) - #.+local-ip+) + *local-ip*) + +(defparameter *wait-for-input-timeout* 2) +(deftest wait-for-input.1 + (with-caught-conditions (nil nil) + (let ((sock (usocket:socket-connect +common-lisp-net+ 80)) + (time (get-universal-time))) + (unwind-protect + (progn (usocket:wait-for-input sock :timeout *wait-for-input-timeout*) + (- (get-universal-time) time)) + (usocket:socket-close sock)))) + *wait-for-input-timeout*) + +(deftest wait-for-input.2 + (with-caught-conditions (nil nil) + (let ((sock (usocket:socket-connect +common-lisp-net+ 80)) + (time (get-universal-time))) + (unwind-protect + (progn (usocket:wait-for-input sock :timeout *wait-for-input-timeout* :ready-only t) + (- (get-universal-time) time)) + (usocket:socket-close sock)))) + *wait-for-input-timeout*) (defun run-usocket-tests () (do-tests)) - -;;; (usoct::run-usocket-tests ) \ No newline at end of file

1 0

[usocket-cvs] r527 - usocket/trunk/backend
by Chun Tian 29 Jun '10

29 Jun '10

Author: ctian Date: Tue Jun 29 08:15:32 2010 New Revision: 527 Log: LispWorks: fix typo in condition related code. Modified: usocket/trunk/backend/lispworks.lisp Modified: usocket/trunk/backend/lispworks.lisp ============================================================================== --- usocket/trunk/backend/lispworks.lisp (original) +++ usocket/trunk/backend/lispworks.lisp Tue Jun 29 08:15:32 2010 @@ -68,10 +68,10 @@ (if usock-err (if (subtypep usock-err 'error) (error usock-err :socket socket) - (signal usock-err :socket)) + (signal usock-err :socket socket)) (error 'unknown-error :socket socket - :real-condition nil)))) + :real-error nil)))) (defun raise-usock-err (errno socket &optional condition) (let* ((usock-err

1 0

[usocket-cvs] r526 - usocket/trunk
by Chun Tian 29 Jun '10

29 Jun '10

Author: ctian Date: Tue Jun 29 08:15:02 2010 New Revision: 526 Log: Condition: add default value for slot REAL-ERROR, this prevent recursive conditions when usocket conditions are reported. Modified: usocket/trunk/condition.lisp Modified: usocket/trunk/condition.lisp ============================================================================== --- usocket/trunk/condition.lisp (original) +++ usocket/trunk/condition.lisp Tue Jun 29 08:15:02 2010 @@ -118,7 +118,8 @@ (define-condition unknown-error (socket-error) ((real-error :initarg :real-error - :accessor usocket-real-error)) + :accessor usocket-real-error + :initform nil)) (:report (lambda (c stream) (typecase c (simple-condition @@ -135,8 +136,9 @@ (ns-condition)) (define-condition ns-unknown-condition (ns-condition) - ((real-error :initarg :real-condition - :accessor ns-real-condition)) + ((real-condition :initarg :real-condition + :accessor ns-real-condition + :initform nil)) (:documentation "Condition raised when there's no other - more applicable - condition available.")) @@ -151,7 +153,8 @@ (define-condition ns-unknown-error (ns-error) ((real-error :initarg :real-error - :accessor ns-real-error)) + :accessor ns-real-error + :initform nil)) (:report (lambda (c stream) (typecase c (simple-condition

1 0

[usocket-cvs] r525 - usocket/trunk/backend
by Chun Tian 28 Jun '10

28 Jun '10

Author: ctian Date: Mon Jun 28 12:09:41 2010 New Revision: 525 Log: CLISP: Clisp can't find gethostname on Linux, patch supplied by Stas Boukarev. Modified: usocket/trunk/backend/clisp.lisp Modified: usocket/trunk/backend/clisp.lisp ============================================================================== --- usocket/trunk/backend/clisp.lisp (original) +++ usocket/trunk/backend/clisp.lisp Mon Jun 28 12:09:41 2010 @@ -13,11 +13,11 @@ :OUT :ALLOCA) (len ffi:int)) #+win32 (:library "WS2_32") + #-win32 (:library :default) (:language #-win32 :stdc #+win32 :stdc-stdcall) (:return-type ffi:int)) - (defun get-host-name () (multiple-value-bind (retcode name) (get-host-name-internal 256)

1 0

[usocket-cvs] r524 - usocket/trunk
by Chun Tian 28 Jun '10

28 Jun '10

Author: ctian Date: Mon Jun 28 12:00:19 2010 New Revision: 524 Log: Additional documentation for READY-ONLY keyword argument of WAIT-FOR-INPUT. Modified: usocket/trunk/usocket.lisp Modified: usocket/trunk/usocket.lisp ============================================================================== --- usocket/trunk/usocket.lisp (original) +++ usocket/trunk/usocket.lisp Mon Jun 28 12:00:19 2010 @@ -288,7 +288,16 @@ be returned for this value either when waiting timed out or when it was interrupted (EINTR). The second value is a real number indicating the time remaining within the timeout period or NIL if -none." +none. + +Without the READY-ONLY arg, WAIT-FOR-INPUT will return all sockets in +the original list you passed it. This prevents a new list from being +consed up. Some users of USOCKET were reluctant to use it if it +wouldn't behave that way, expecting it to cost significant performance +to do the associated garbage collection. + +Without the READY-ONLY arg, you need to check the socket STATE slot for +the values documented in usocket.lisp in the usocket class." (unless (wait-list-p socket-or-sockets) (let ((wl (make-wait-list (if (listp socket-or-sockets) socket-or-sockets (list socket-or-sockets)))))

1 0

[usocket-cvs] r523 - usocket/trunk/backend
by Chun Tian 28 Jun '10

28 Jun '10

Author: ctian Date: Mon Jun 28 11:58:13 2010 New Revision: 523 Log: SBCL: Add TIMEOUT support for sb-bsd-sockets:socket-make-stream, thanks to Pavel G. Koukoushkin Modified: usocket/trunk/backend/sbcl.lisp Modified: usocket/trunk/backend/sbcl.lisp ============================================================================== --- usocket/trunk/backend/sbcl.lisp (original) +++ usocket/trunk/backend/sbcl.lisp Mon Jun 28 11:58:13 2010 @@ -210,6 +210,7 @@ (sockopt-tcp-nodelay-p (fboundp 'sb-bsd-sockets::sockopt-tcp-nodelay))) (when deadline (unsupported 'deadline 'socket-connect)) + #+ecl (when timeout (unsupported 'timeout 'socket-connect)) (when (and nodelay-specified ;; 20080802: ECL added this function to its sockets @@ -232,6 +233,8 @@ :input t :output t :buffering :full + #+sbcl #+sbcl + :timeout timeout :element-type element-type)) ;;###FIXME: The above line probably needs an :external-format (usocket (make-stream-socket :stream stream :socket socket))

1 0

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

usocket-cvs June 2010