From 08ab159bc087ce353228a9e77b9bfb02a80b0fbf Mon Sep 17 00:00:00 2001 From: lotodore Date: Sun, 28 Oct 2007 20:45:47 +0000 Subject: [PATCH] Fixes and part of new test. --- tests/pkth.scm | 7 +++--- tests/pkth_tests.scm | 51 +++++++++++++++++++++++++++++++++++++++++--- 2 files changed, 52 insertions(+), 6 deletions(-) diff --git a/tests/pkth.scm b/tests/pkth.scm index ab3472d9..c35af723 100644 --- a/tests/pkth.scm +++ b/tests/pkth.scm @@ -381,7 +381,8 @@ !# (define pkth-is-valid-type? - (lambda (type) + (lambda (message) + (let ((type (pkth-get-type message))) (or (= type pkth-type-init) (= type pkth-type-init-ack) @@ -426,7 +427,7 @@ (= type pkth-type-removed-from-game) (= type pkth-type-send-chat-text) (= type pkth-type-chat-text) - (= type pkth-type-error)))) + (= type pkth-type-error))))) ;;; ;;; Packet getter functions @@ -695,7 +696,7 @@ (let ((packet (string-copy (substring helper-var-recv-buf 0 packetlen)))) (set! helper-var-recv-buf (string-drop helper-var-recv-buf packetlen)) (set! ret (string->bytes packet)) - (test-assert (pkth-is-valid-type? (pkth-get-type ret)) "Invalid PKTH message type.") + (test-assert (pkth-is-valid-type? ret) "Invalid PKTH message type.") (msg-display ret helper-direction-recv) ))))))) (if (not abort) diff --git a/tests/pkth_tests.scm b/tests/pkth_tests.scm index 43a11b0a..072343c7 100644 --- a/tests/pkth_tests.scm +++ b/tests/pkth_tests.scm @@ -58,7 +58,7 @@ (make-list 1024 0))))) (sock-close sock) )) -;(set! pkth-test-list (test-register pkth-test-list "PKTH: Init with too large packets" pkth-test-init-packet-too-large)) +(set! pkth-test-list (test-register pkth-test-list "PKTH: Init with too large packets" pkth-test-init-packet-too-large)) (define (pkth-test-init) (dotimes (n 1024) @@ -117,7 +117,7 @@ (display "Waiting for Init-Ack...\n") (wait-for-message sock pkth-recv-message (list pkth-is-type-init-ack?) '() 5000) (display "Starting and leaving loads of games...\n") - (dotimes (n 200000) + (dotimes (n 256) (pkth-send-message sock (pkth-create-create-game (pkth-create-game-info @@ -142,7 +142,7 @@ (wait-for-message sock pkth-recv-message (list pkth-is-type-game-list-new? pkth-is-type-join-game-ack? pkth-is-type-game-list-player-joined?) (list pkth-is-type-statistics-changed? pkth-is-type-game-list-update? pkth-is-type-game-list-player-left?) 5000) (pkth-send-message sock (pkth-create-start-event pkth-start-flag-fill-with-cpu-players)) (display "Waiting for Start Event...\n") - (wait-for-message sock pkth-recv-message (list pkth-is-type-start-event?) (list pkth-is-type-statistics-changed? pkth-is-type-player-joined? pkth-is-type-game-list-player-joined?) 5000) + (wait-for-message sock pkth-recv-message (list pkth-is-type-start-event?) (list pkth-is-type-statistics-changed? pkth-is-type-player-joined? pkth-is-type-game-list-player-joined? pkth-is-type-game-list-update?) 5000) (pkth-send-message sock (pkth-create-start-event-ack)) (display "Waiting for Game Start...\n") (wait-for-message sock pkth-recv-message (list pkth-is-type-game-start?) (list pkth-is-type-statistics-changed? pkth-is-type-game-list-player-joined? pkth-is-type-game-list-update?) 5000) @@ -158,5 +158,50 @@ )) (set! pkth-test-list (test-register pkth-test-list "PKTH Test 3: Starting and leaving games" pkth-test-start-leave-game)) +(define (pkth-test-run-game) + (let ((sock (pkth-connect))) + (pkth-send-message sock (pkth-create-init '() "" "client1")) + (display "Waiting for Init-Ack...\n") + (wait-for-message sock pkth-recv-message (list pkth-is-type-init-ack?) '() 5000) + (display "Starting and leaving loads of games...\n") + (dotimes (n 1) + (pkth-send-message sock + (pkth-create-create-game + (pkth-create-game-info + 7 + pkth-raise-interval-mode-on-hand + 4 + pkth-raise-mode-double-blinds + pkth-end-raise-mode-double-blinds + 11 + 20 ; player action timeout + 40 ; first small blind + 0 ; end raise small blind + 2000 ; start money + '() ; manual blinds + ) + "test game" + "test password" + )) + (display "Waiting for Game List New / Join Game Ack / Game List Player Joined...\n") + (wait-for-message sock pkth-recv-message (list pkth-is-type-game-list-new? pkth-is-type-join-game-ack? pkth-is-type-game-list-player-joined?) (list pkth-is-type-statistics-changed? pkth-is-type-game-list-update? pkth-is-type-game-list-player-left?) 5000) + (wait-for-message sock pkth-recv-message (list pkth-is-type-game-list-new? pkth-is-type-join-game-ack? pkth-is-type-game-list-player-joined?) (list pkth-is-type-statistics-changed? pkth-is-type-game-list-update? pkth-is-type-game-list-player-left?) 5000) + (wait-for-message sock pkth-recv-message (list pkth-is-type-game-list-new? pkth-is-type-join-game-ack? pkth-is-type-game-list-player-joined?) (list pkth-is-type-statistics-changed? pkth-is-type-game-list-update? pkth-is-type-game-list-player-left?) 5000) + (pkth-send-message sock (pkth-create-start-event pkth-start-flag-fill-with-cpu-players)) + (display "Waiting for Start Event...\n") + (wait-for-message sock pkth-recv-message (list pkth-is-type-start-event?) (list pkth-is-type-statistics-changed? pkth-is-type-player-joined? pkth-is-type-game-list-player-joined? pkth-is-type-game-list-update?) 5000) + (pkth-send-message sock (pkth-create-start-event-ack)) + (display "Waiting for Game Start...\n") + (wait-for-message sock pkth-recv-message (list pkth-is-type-game-start?) (list pkth-is-type-statistics-changed? pkth-is-type-game-list-player-joined? pkth-is-type-game-list-update?) 5000) + (display "Waiting for End Of Game...\n") + (wait-for-message sock pkth-recv-message (list pkth-is-type-end-of-game?) (list pkth-is-valid-type?) 5000000) + (pkth-send-message sock (pkth-create-leave-current-game)) + (display "Waiting for Removed From Game...\n") + (wait-for-message sock pkth-recv-message (list pkth-is-type-removed-from-game?) (list pkth-is-type-statistics-changed? pkth-is-type-game-list-player-joined? pkth-is-type-game-list-update? pkth-is-type-game-list-player-left?) 5000) + ) + (sock-close sock) + )) +;(set! pkth-test-list (test-register pkth-test-list "PKTH Test 4: Running games" pkth-test-run-game)) + (test-run-all pkth-test-list)