diff --git a/tests/common.scm b/tests/common.scm index c4594495..88945ac5 100644 --- a/tests/common.scm +++ b/tests/common.scm @@ -33,7 +33,7 @@ ;;; USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY ;;; OF SUCH DAMAGE. -;;; $Id: common.scm,v 1.4 2006/01/18 01:00:30 tuexen Exp $ +;;; $Id: common.scm,v 1.6 2007/10/15 17:11:29 lmay Exp $ ;;; Load the SCTP API needed. (use-modules (net sctp)) diff --git a/tests/helper.scm b/tests/helper.scm index de40377d..1da8b818 100644 --- a/tests/helper.scm +++ b/tests/helper.scm @@ -48,22 +48,32 @@ (primitive-eval (append '(or) (map predicate? predicate-list data-list)))))) (define wait-for-message - (lambda (socket recv-function predicate-list ignore-predicate-list timeout-msec) - (let ((t (timer-create timeout-msec)) (ret #f)) + (lambda (sock recv-function predicate-list ignore-predicate-list timeout-msec) + (let ((t (timer-create timeout-msec))) (set! t (timer-start t)) (do ((abort #f)) (abort) - (if (sock-select-read socket 10) + (if (sock-select-read sock 10) (begin - (let ((msg (recv-function socket))) + (let ((msg (recv-function sock))) (if (predicate-one-true? predicate-list msg) (begin - (set! abort #t) - (test-assert (not (predicate-one-true? ignore-predicate-list msg)) "Invalid message received.") - (set! ret #t)))))) + (set! abort #t)) + (begin + (if (not (predicate-one-true? ignore-predicate-list msg)) + (begin + (test-assert #f "The upper message was received but not expected.")))) + )))) (if (timer-expired? t) - (set! abort #t))) - ret))) + (begin + (set! abort #t) + (test-assert (null? predicate-list) "Expected message not received within time interval!")))) + ))) + +(define wait-for-message-in-interval + (lambda (sock recv-function predicate-list ignore-predicate-list delay-before-msec until-msec) + (wait-for-message sock recv-function '() ignore-predicate-list delay-before-msec) + (wait-for-message sock recv-function predicate-list ignore-predicate-list (- until-msec delay-before-msec)))) #! (define recv-message diff --git a/tests/pkth.scm b/tests/pkth.scm index 73882bba..4e875f70 100644 --- a/tests/pkth.scm +++ b/tests/pkth.scm @@ -93,6 +93,7 @@ (define pkth-type-end-of-hand-show-cards #x0064) (define pkth-type-end-of-hand-hide-cards #x0065) (define pkth-type-end-of-game #x0070) +(define pkth-type-statistics-changed #x0080) (define pkth-type-removed-from-game #x0100) @@ -333,6 +334,7 @@ (= type pkth-type-end-of-hand-show-cards) (= type pkth-type-end-of-hand-hide-cards) (= type pkth-type-end-of-game) + (= type pkth-type-statistics-changed) (= type pkth-type-removed-from-game) (= type pkth-type-send-chat-text) (= type pkth-type-chat-text) @@ -523,6 +525,10 @@ (lambda (message) (= (pkth-get-type message) pkth-type-end-of-game))) +(define pkth-is-type-statistics-changed? + (lambda (message) + (= (pkth-get-type message) pkth-type-statistics-changed))) + (define pkth-is-type-removed-from-game? (lambda (message) (= (pkth-get-type message) pkth-type-removed-from-game))) diff --git a/tests/sock.scm b/tests/sock.scm index 44df4386..1856aaa6 100644 --- a/tests/sock.scm +++ b/tests/sock.scm @@ -80,6 +80,7 @@ (lambda (sock local-addr local-port) (let ((af (cdr sock))) (setsockopt (car sock) SOL_SOCKET SO_REUSEADDR 1) + (setsockopt (car sock) SOL_SOCKET SO_LINGER (cons 1 60)) (bind (car sock) af (inet-pton af local-addr) local-port) sock))) @@ -138,8 +139,8 @@ (define sock-recv-sctp! (lambda (sock buf) (let ((ret (sctp-recvmsg! (car sock) buf))) - (let ((info (list-ref ret 3))) ; Return number of bytes and PPID - (cons (car ret) (ntohl (list-ref info 2))))))) + (let ((info (list-ref ret 3))) ; Return number of bytes, stream # and PPID + (list (car ret) (ntohs (car info)) (ntohl (list-ref info 2))))))) #! (sock-send (car (sock-accept (sock-bind-listen (sock-create-tcp AF_INET) "127.0.0.1" 5555 5))) "Hallo") diff --git a/tests/test.scm b/tests/test.scm index 2f35e314..828f4348 100644 --- a/tests/test.scm +++ b/tests/test.scm @@ -68,14 +68,14 @@ (catch 'badex (lambda () ((cdr data)) ; call test - (display "PASSED\n")) + (display "PASSED\n\n")) (lambda (key) - (display "FAILED\n"))))) + (display "FAILED\n\n"))))) (define test-run-all (lambda (test-list) (display "\nTest Run: All Tests\n") - (map test-run-single test-list) + (map-in-order test-run-single test-list) (display "\nDone.\n"))) #!