diff options
| author | Gene Pasquet <dev@etenil.net> | 2026-04-17 16:52:41 +0100 |
|---|---|---|
| committer | Gene Pasquet <dev@etenil.net> | 2026-04-17 16:52:41 +0100 |
| commit | a02b892e2ad1e1605ff942c63afdd618daa48be4 (patch) | |
| tree | 7ccd9278a0cdc7fd2f156b0b4710f6ac00acab27 /tests/input-test.scm | |
| parent | 8251c85a4a588504d38a2fad05e4b0fe1cdccb9d (diff) | |
Migrate tests to the test egg
Diffstat (limited to 'tests/input-test.scm')
| -rw-r--r-- | tests/input-test.scm | 57 |
1 files changed, 29 insertions, 28 deletions
diff --git a/tests/input-test.scm b/tests/input-test.scm index bbc5599..50395d8 100644 --- a/tests/input-test.scm +++ b/tests/input-test.scm @@ -7,7 +7,7 @@ (only srfi-197 chain) (prefix sdl2 sdl2:) simple-logger - srfi-64 + test defstruct) ;; Load entity first (input imports it) @@ -35,20 +35,20 @@ (test-assert "has previous field" (list? (input-state-previous state))) ;; All actions should be initialized to #f - (test-equal "up action is false" #f (input-held? state 'up)) - (test-equal "down action is false" #f (input-held? state 'down)) - (test-equal "left action is false" #f (input-held? state 'left)) - (test-equal "right action is false" #f (input-held? state 'right)) - (test-equal "a action is false" #f (input-held? state 'a)) - (test-equal "b action is false" #f (input-held? state 'b)) - (test-equal "start action is false" #f (input-held? state 'start)) - (test-equal "quit action is false" #f (input-held? state 'quit)))) + (test "up action is false" #f (input-held? state 'up)) + (test "down action is false" #f (input-held? state 'down)) + (test "left action is false" #f (input-held? state 'left)) + (test "right action is false" #f (input-held? state 'right)) + (test "a action is false" #f (input-held? state 'a)) + (test "b action is false" #f (input-held? state 'b)) + (test "start action is false" #f (input-held? state 'start)) + (test "quit action is false" #f (input-held? state 'quit)))) ;; Test: input-held? query (test-group "input-held?" (let ((state (create-input-state *default-input-config*))) - (test-equal "returns false for unheld action" #f (input-held? state 'up)) - (test-equal "returns false for unknown action" #f (input-held? state 'unknown)))) + (test "returns false for unheld action" #f (input-held? state 'up)) + (test "returns false for unknown action" #f (input-held? state 'unknown)))) ;; Test: input-pressed? detection (test-group "input-pressed?" @@ -59,7 +59,7 @@ (input-state-current state1)))) ;; In state1, up is not pressed - (test-equal "not pressed in initial state" #f (input-pressed? state1 'up)) + (test "not pressed in initial state" #f (input-pressed? state1 'up)) ;; In state2, up is held but was not held before -> pressed (test-assert "pressed when current=#t and previous=#f" @@ -77,14 +77,14 @@ (cons (cons 'up #f) (input-state-current state1)) (cons (cons 'up #t) (input-state-current state1))))) - (test-equal "not released when held" #f (input-released? state-held 'up)) + (test "not released when held" #f (input-released? state-held 'up)) (test-assert "released when current=#f and previous=#t" (input-released? state-released 'up)))) ;; Test: input-any-pressed? (test-group "input-any-pressed?" (let ((state1 (create-input-state *default-input-config*))) - (test-equal "no actions pressed in initial state" + (test "no actions pressed in initial state" #f (input-any-pressed? state1 *default-input-config*)))) @@ -109,7 +109,7 @@ (input-state-current state1)))) ;; Verify transition from not-held to held = pressed - (test-equal "up not held in state1" #f (input-held? state1 'up)) + (test "up not held in state1" #f (input-held? state1 'up)) (test-assert "up held in state2" (input-held? state2 'up)) (test-assert "up pressed in state2" (input-pressed? state2 'up)) @@ -118,7 +118,7 @@ (input-state-current state2) (input-state-current state2)))) (test-assert "up still held in state3" (input-held? state3 'up)) - (test-equal "up not pressed in state3 (already was pressed)" + (test "up not pressed in state3 (already was pressed)" #f (input-pressed? state3 'up))))) @@ -132,40 +132,40 @@ (test-group "no input-map: entity unchanged" (let* ((e (entity #:type 'player #:x 5 #:y 10)) (out (apply-input-to-entity e (lambda (a) #f)))) - (test-equal "entity returned as-is" e out))) + (test "entity returned as-is" e (begin out)))) (test-group "no actions held: velocity is zero" (let* ((e (make-physics-entity)) (out (apply-input-to-entity e (lambda (a) #f)))) - (test-equal "vx is 0" 0 (entity-ref out #:vx)) - (test-equal "vy is 0" 0 (entity-ref out #:vy)))) + (test "vx is 0" 0 (entity-ref out #:vx)) + (test "vy is 0" 0 (entity-ref out #:vy)))) (test-group "right held: vx=2 vy=0" (let* ((e (make-physics-entity)) (out (apply-input-to-entity e (lambda (a) (eq? a 'right))))) - (test-equal "vx is 2" 2 (entity-ref out #:vx)) - (test-equal "vy is 0" 0 (entity-ref out #:vy)))) + (test "vx is 2" 2 (entity-ref out #:vx)) + (test "vy is 0" 0 (entity-ref out #:vy)))) (test-group "right+down held: vx=2 vy unchanged" (let* ((e (make-physics-entity)) (out (apply-input-to-entity e (lambda (a) (memv a '(right down)))))) - (test-equal "vx is 2" 2 (entity-ref out #:vx)) - (test-equal "vy is unchanged (input handler does not set vy)" 0 (entity-ref out #:vy)))) + (test "vx is 2" 2 (entity-ref out #:vx)) + (test "vy is unchanged (input handler does not set vy)" 0 (entity-ref out #:vy)))) (test-group "right held: facing set to 1" (let* ((e (make-physics-entity)) (out (apply-input-to-entity e (lambda (a) (eq? a 'right))))) - (test-equal "facing is 1" 1 (entity-ref out #:facing 0)))) + (test "facing is 1" 1 (entity-ref out #:facing 0)))) (test-group "left held: facing set to -1" (let* ((e (make-physics-entity)) (out (apply-input-to-entity e (lambda (a) (eq? a 'left))))) - (test-equal "facing is -1" -1 (entity-ref out #:facing 0)))) + (test "facing is -1" -1 (entity-ref out #:facing 0)))) (test-group "no key held: facing retains previous value" (let* ((e (entity-set (make-physics-entity) #:facing 1)) (out (apply-input-to-entity e (lambda (a) #f)))) - (test-equal "facing stays 1 when vx=0" 1 (entity-ref out #:facing 0))))) + (test "facing stays 1 when vx=0" 1 (entity-ref out #:facing 0))))) (test-group "custom-input-config" (let* ((cfg (make-input-config @@ -178,7 +178,8 @@ deadzone: 8000)) (state (create-input-state cfg))) (test-assert "custom config creates valid state" (input-state? state)) - (test-equal "jump is false" #f (input-held? state 'jump)) - (test-equal "shoot is false" #f (input-held? state 'shoot)))) + (test "jump is false" #f (input-held? state 'jump)) + (test "shoot is false" #f (input-held? state 'shoot)))) (test-end "input-module") +(test-exit) |
