From 4b87de17951eab30ed8ebf76790d22df5477cdc7 Mon Sep 17 00:00:00 2001 From: lotodore Date: Fri, 12 Oct 2007 21:40:30 +0000 Subject: [PATCH] Added type check functions. --- tests/pkth.scm | 353 ++++++++++++++++++++++++++++++++++++++++--------- 1 file changed, 294 insertions(+), 59 deletions(-) diff --git a/tests/pkth.scm b/tests/pkth.scm index 2c52066b..73882bba 100644 --- a/tests/pkth.scm +++ b/tests/pkth.scm @@ -188,53 +188,57 @@ ;;; Header constructors ;;; -(define (pkth-create-packet type data) - (append - (uint16->bytes type) - (uint16->bytes (+ pkth-header-length-common (apply + (map length data)))) - (apply append data))) +(define pkth-create-packet + (lambda (type data) + (append + (uint16->bytes type) + (uint16->bytes (+ pkth-header-length-common (apply + (map length data)))) + (apply append data)))) -(define (pkth-create-md5 m0 m1 m2 m3 m4 m5 m6 m7 m8 m9 mA mB mC mD mE mF) - (append - (uint8->bytes m0) - (uint8->bytes m1) - (uint8->bytes m2) - (uint8->bytes m3) - (uint8->bytes m4) - (uint8->bytes m5) - (uint8->bytes m6) - (uint8->bytes m7) - (uint8->bytes m8) - (uint8->bytes m9) - (uint8->bytes mA) - (uint8->bytes mB) - (uint8->bytes mC) - (uint8->bytes mD) - (uint8->bytes mE) - (uint8->bytes mF))) +(define pkth-create-md5 + (lambda (m0 m1 m2 m3 m4 m5 m6 m7 m8 m9 mA mB mC mD mE mF) + (append + (uint8->bytes m0) + (uint8->bytes m1) + (uint8->bytes m2) + (uint8->bytes m3) + (uint8->bytes m4) + (uint8->bytes m5) + (uint8->bytes m6) + (uint8->bytes m7) + (uint8->bytes m8) + (uint8->bytes m9) + (uint8->bytes mA) + (uint8->bytes mB) + (uint8->bytes mC) + (uint8->bytes mD) + (uint8->bytes mE) + (uint8->bytes mF)))) -(define (pkth-create-init-ex version-major version-minor privacy-flags avatar-md5 password player-name) - (pkth-create-packet - pkth-type-init - (list - (uint16->bytes version-major) - (uint16->bytes version-minor) - (uint16->bytes (string-length password)) - (uint16->bytes (string-length player-name)) - (uint16->bytes privacy-flags) - (uint16->bytes 0) - avatar-md5 - (append-padding (string->bytes password)) - (append-padding (string->bytes player-name))))) +(define pkth-create-init-ex + (lambda (version-major version-minor privacy-flags avatar-md5 password player-name) + (pkth-create-packet + pkth-type-init + (list + (uint16->bytes version-major) + (uint16->bytes version-minor) + (uint16->bytes (string-length password)) + (uint16->bytes (string-length player-name)) + (uint16->bytes privacy-flags) + (uint16->bytes 0) + avatar-md5 + (append-padding (string->bytes password)) + (append-padding (string->bytes player-name)))))) -(define (pkth-create-init avatar-md5 password player-name) - (pkth-create-init-ex - pkth-version-major - pkth-version-minor - (if (null? avatar-md5) 0 pkth-privacy-flag-show-avatar) - avatar-md5 - password - player-name)) +(define pkth-create-init + (lambda (avatar-md5 password player-name) + (pkth-create-init-ex + pkth-version-major + pkth-version-minor + (if (null? avatar-md5) 0 pkth-privacy-flag-show-avatar) + avatar-md5 + password + player-name))) #! (pkth-create-init @@ -247,21 +251,23 @@ "hallo") !# -(define (pkth-create-init-ack-ex game-version beta-revision session-id player-id) - (pkth-create-packet - pkth-type-init-ack - (list - (uint16->bytes game-version) - (uint16->bytes beta-revision) - (uint32->bytes session-id) - (uint32->bytes player-id)))) +(define pkth-create-init-ack-ex + (lambda (game-version beta-revision session-id player-id) + (pkth-create-packet + pkth-type-init-ack + (list + (uint16->bytes game-version) + (uint16->bytes beta-revision) + (uint32->bytes session-id) + (uint32->bytes player-id))))) -(define (pkth-create-init-ack session-id player-id) - (pkth-create-init-ack-ex - pkth-game-version - pkth-beta-revision - session-id - player-id)) +(define pkth-create-init-ack + (lambda (session-id player-id) + (pkth-create-init-ack-ex + pkth-game-version + pkth-beta-revision + session-id + player-id))) #! (pkth-create-init-ack #x66666666 #x88888888) @@ -285,6 +291,53 @@ (pkth-assert-length '(1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16) 16) !# +(define pkth-is-valid-type? + (lambda (type) + (or + (= type pkth-type-init) + (= type pkth-type-init-ack) + (= type pkth-type-retrieve-avatar) + (= type pkth-type-avatar-header) + (= type pkth-type-avatar-file) + (= type pkth-type-avatar-end) + (= type pkth-type-unknown-avatar) + (= type pkth-type-game-list-new) + (= type pkth-type-game-list-update) + (= type pkth-type-game-list-player-joined) + (= type pkth-type-game-list-player-left) + (= type pkth-type-game-list-admin-changed) + (= type pkth-type-retrieve-player-info) + (= type pkth-type-player-info) + (= type pkth-type-unknown-player-id) + (= type pkth-type-create-game) + (= type pkth-type-join-game) + (= type pkth-type-join-game-ack) + (= type pkth-type-join-game-failed) + (= type pkth-type-player-joined) + (= type pkth-type-player-left) + (= type pkth-type-game-admin-changed) + (= type pkth-type-kick-player) + (= type pkth-type-leave-current-game) + (= type pkth-type-start-event) + (= type pkth-type-start-event-ack) + (= type pkth-type-game-start) + (= type pkth-type-hand-start) + (= type pkth-type-players-turn) + (= type pkth-type-players-action) + (= type pkth-type-players-action-done) + (= type pkth-type-players-action-rejected) + (= type pkth-type-deal-flop-cards) + (= type pkth-type-deal-turn-card) + (= type pkth-type-deal-river-card) + (= type pkth-type-all-in-show-cards) + (= 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-removed-from-game) + (= type pkth-type-send-chat-text) + (= type pkth-type-chat-text) + (= type pkth-type-error)))) + ;;; ;;; Packet getter functions ;;; @@ -292,7 +345,9 @@ (define pkth-get-type (lambda (message) (pkth-assert-minimal-length message) - (bytes->uint16 (list-head (list-tail message pkth-offset-type) pkth-length-type)))) + (let ((type (bytes->uint16 (list-head (list-tail message pkth-offset-type) pkth-length-type)))) + (test-assert (pkth-is-valid-type? type)) + type))) (define pkth-get-length (lambda (message) @@ -304,6 +359,186 @@ (pkth-assert-minimal-length message) (list-tail message pkth-offset-data))) +;;; +;;; Type check functions +;;; + +(define pkth-is-type-init? + (lambda (message) + (= (pkth-get-type message) pkth-type-init))) + +(define pkth-is-type-init-ack? + (lambda (message) + (= (pkth-get-type message) pkth-type-init-ack))) + +(define pkth-is-type-retrieve-avatar? + (lambda (message) + (= (pkth-get-type message) pkth-type-retrieve-avatar))) + +(define pkth-is-type-avatar-header? + (lambda (message) + (= (pkth-get-type message) pkth-type-avatar-header))) + +(define pkth-is-type-avatar-file? + (lambda (message) + (= (pkth-get-type message) pkth-type-avatar-file))) + +(define pkth-is-type-avatar-end? + (lambda (message) + (= (pkth-get-type message) pkth-type-avatar-end))) + +(define pkth-is-type-unknown-avatar? + (lambda (message) + (= (pkth-get-type message) pkth-type-unknown-avatar))) + +(define pkth-is-type-game-list-new? + (lambda (message) + (= (pkth-get-type message) pkth-type-game-list-new))) + +(define pkth-is-type-game-list-update? + (lambda (message) + (= (pkth-get-type message) pkth-type-game-list-update))) + +(define pkth-is-type-game-list-player-joined? + (lambda (message) + (= (pkth-get-type message) pkth-type-game-list-player-joined))) + +(define pkth-is-type-game-list-player-left? + (lambda (message) + (= (pkth-get-type message) pkth-type-game-list-player-left))) + +(define pkth-is-type-game-list-admin-changed? + (lambda (message) + (= (pkth-get-type message) pkth-type-game-list-admin-changed))) + +(define pkth-is-type-retrieve-player-info? + (lambda (message) + (= (pkth-get-type message) pkth-type-retrieve-player-info))) + +(define pkth-is-type-player-info? + (lambda (message) + (= (pkth-get-type message) pkth-type-player-info))) + +(define pkth-is-type-unknown-player-id? + (lambda (message) + (= (pkth-get-type message) pkth-type-unknown-player-id))) + +(define pkth-is-type-unknown-player-id? + (lambda (message) + (= (pkth-get-type message) pkth-type-unknown-player-id))) + +(define pkth-is-type-create-game? + (lambda (message) + (= (pkth-get-type message) pkth-type-create-game))) + +(define pkth-is-type-join-game? + (lambda (message) + (= (pkth-get-type message) pkth-type-join-game))) + +(define pkth-is-type-join-game-ack? + (lambda (message) + (= (pkth-get-type message) pkth-type-join-game-ack))) + +(define pkth-is-type-join-game-failed? + (lambda (message) + (= (pkth-get-type message) pkth-type-join-game-failed))) + +(define pkth-is-type-player-joined? + (lambda (message) + (= (pkth-get-type message) pkth-type-player-joined))) + +(define pkth-is-type-player-left? + (lambda (message) + (= (pkth-get-type message) pkth-type-player-left))) + +(define pkth-is-type-game-admin-changed? + (lambda (message) + (= (pkth-get-type message) pkth-type-game-admin-changed))) + +(define pkth-is-type-kick-player? + (lambda (message) + (= (pkth-get-type message) pkth-type-kick-player))) + +(define pkth-is-type-leave-current-game? + (lambda (message) + (= (pkth-get-type message) pkth-type-leave-current-game))) + +(define pkth-is-type-start-event? + (lambda (message) + (= (pkth-get-type message) pkth-type-start-event))) + +(define pkth-is-type-start-event-ack? + (lambda (message) + (= (pkth-get-type message) pkth-type-start-event-ack))) + +(define pkth-is-type-game-start? + (lambda (message) + (= (pkth-get-type message) pkth-type-game-start))) + +(define pkth-is-type-hand-start? + (lambda (message) + (= (pkth-get-type message) pkth-type-hand-start))) + +(define pkth-is-type-players-turn? + (lambda (message) + (= (pkth-get-type message) pkth-type-players-turn))) + +(define pkth-is-type-players-action? + (lambda (message) + (= (pkth-get-type message) pkth-type-players-action))) + +(define pkth-is-type-players-action-done? + (lambda (message) + (= (pkth-get-type message) pkth-type-players-action-done))) + +(define pkth-is-type-players-action-rejected? + (lambda (message) + (= (pkth-get-type message) pkth-type-players-action-rejected))) + +(define pkth-is-type-deal-flop-cards? + (lambda (message) + (= (pkth-get-type message) pkth-type-deal-flop-cards))) + +(define pkth-is-type-deal-turn-card? + (lambda (message) + (= (pkth-get-type message) pkth-type-deal-turn-card))) + +(define pkth-is-type-deal-river-card? + (lambda (message) + (= (pkth-get-type message) pkth-type-deal-river-card))) + +(define pkth-is-type-all-in-show-cards? + (lambda (message) + (= (pkth-get-type message) pkth-type-all-in-show-cards))) + +(define pkth-is-type-end-of-hand-show-cards? + (lambda (message) + (= (pkth-get-type message) pkth-type-end-of-hand-show-cards))) + +(define pkth-is-type-end-of-hand-hide-cards? + (lambda (message) + (= (pkth-get-type message) pkth-type-end-of-hand-hide-cards))) + +(define pkth-is-type-end-of-game? + (lambda (message) + (= (pkth-get-type message) pkth-type-end-of-game))) + +(define pkth-is-type-removed-from-game? + (lambda (message) + (= (pkth-get-type message) pkth-type-removed-from-game))) + +(define pkth-is-type-send-chat-text? + (lambda (message) + (= (pkth-get-type message) pkth-type-send-chat-text))) + +(define pkth-is-type-chat-text? + (lambda (message) + (= (pkth-get-type message) pkth-type-chat-text))) + +(define pkth-is-type-error? + (lambda (message) + (= (pkth-get-type message) pkth-type-error))) + ;;; pkth-type-init #!