Network test fixes.

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))

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)
+  (lambda (sock recv-function predicate-list ignore-predicate-list timeout-msec)
-    (let ((t (timer-create timeout-msec)) (ret #f))
+    (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)
+                        (set! abort #t))
-                        (test-assert (not (predicate-one-true? ignore-predicate-list msg)) "Invalid message received.")
+                      (begin
-                        (set! ret #t))))))
+                        (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)))
+              (begin
-      ret)))
+                (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

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)))

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
+      (let ((info (list-ref ret 3))) ; Return number of bytes, stream # and PPID
-        (cons (car ret) (ntohl (list-ref info 2)))))))
+        (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")

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")))
 
 #!