sco/pokerth
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Fixes and part of new test.

Browse Source
This commit is contained in:
lotodore
2007-10-28 20:45:47 +00:00
parent 3ea61381ef
commit 08ab159bc0
2 changed files with 52 additions and 6 deletions
Download Patch File Download Diff File Expand all files Collapse all files
tests/pkth.scm
+4 -3
View File
@@ -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)
tests/pkth_tests.scm
+48 -3
View File
@@ -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)