diff options
Diffstat (limited to 'tests')
| -rw-r--r-- | tests/entity-test.scm | 37 | ||||
| -rw-r--r-- | tests/input-test.scm | 12 | ||||
| -rw-r--r-- | tests/physics-test.scm | 2 | ||||
| -rw-r--r-- | tests/prefabs-test.scm | 3 | ||||
| -rw-r--r-- | tests/world-test.scm | 6 |
5 files changed, 24 insertions, 36 deletions
diff --git a/tests/entity-test.scm b/tests/entity-test.scm index 795aa1c..270555c 100644 --- a/tests/entity-test.scm +++ b/tests/entity-test.scm @@ -29,6 +29,15 @@ 42 (entity-ref entity #:x (lambda () 42))))) +;; Test: make-player-entity creates valid player entity +(test-group "make-entity" + (let ((player (make-entity 50 75 16 16))) + (test-assert "returns a list" (list? player)) + (test-equal "has correct x" 50 (entity-ref player #:x)) + (test-equal "has correct y" 75 (entity-ref player #:y)) + (test-equal "has correct width" 16 (entity-ref player #:width)) + (test-equal "has correct height" 16 (entity-ref player #:height)))) + ;; Test: entity-type extracts type from entity (test-group "entity-type" (let ((player '(#:type player #:x 100)) @@ -38,19 +47,8 @@ (let ((no-type '(#:x 100 #:y 200))) (test-equal "returns #f for entity without type" - #f - (entity-type no-type)))) - -;; Test: make-player-entity creates valid player entity -(test-group "make-player-entity" - (let ((player (make-player-entity 50 75 16 16))) - (test-assert "returns a list" (list? player)) - (test-equal "has correct type" 'player (entity-ref player #:type)) - (test-equal "has correct x" 50 (entity-ref player #:x)) - (test-equal "has correct y" 75 (entity-ref player #:y)) - (test-equal "has correct width" 16 (entity-ref player #:width)) - (test-equal "has correct height" 16 (entity-ref player #:height)) - (test-equal "has initial tile-id" 29 (entity-ref player #:tile-id)))) + #f + (entity-type no-type)))) ;; Test: complex entity with multiple properties (test-group "complex-entity" @@ -100,19 +98,6 @@ (let ((e (entity-update '(#:x 10 #:y 20) #:x (lambda (v) (* v 2))))) (test-equal "length is 4" 4 (length e))))) -;; Test: make-player-entity velocity fields -(test-group "make-player-entity-velocity-fields" - (let* ((p (make-player-entity 5 10 16 16)) - (imap (entity-ref p #:input-map #f))) - (test-equal "vx defaults to 0" 0 (entity-ref p #:vx)) - (test-equal "vy defaults to 0" 0 (entity-ref p #:vy)) - (test-assert "input-map is present" imap) - ;; Each entry is (action . (dvx . dvy)); assq returns (action . (dvx . dvy)) - (test-equal "left dvx" -2 (car (cdr (assq 'left imap)))) - (test-equal "left dvy" 0 (cdr (cdr (assq 'left imap)))) - (test-equal "right dvx" 2 (car (cdr (assq 'right imap)))) - (test-equal "right dvy" 0 (cdr (cdr (assq 'right imap)))))) - (test-group "entity-skips-pipeline?" (test-assert "absent skip list" (not (entity-skips-pipeline? '(#:type a) 'gravity))) diff --git a/tests/input-test.scm b/tests/input-test.scm index 2173f61..44af6e8 100644 --- a/tests/input-test.scm +++ b/tests/input-test.scm @@ -125,35 +125,35 @@ (test-equal "entity returned as-is" e out))) (test-group "no actions held: velocity is zero" - (let* ((e (make-player-entity 0 0 16 16)) + (let* ((e (make-entity 0 0 16 16)) (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-group "right held: vx=2 vy=0" - (let* ((e (make-player-entity 0 0 16 16)) + (let* ((e (make-entity 0 0 16 16)) (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-group "right+down held: vx=2 vy unchanged" - (let* ((e (make-player-entity 0 0 16 16)) + (let* ((e (make-entity 0 0 16 16)) (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-group "right held: facing set to 1" - (let* ((e (make-player-entity 0 0 16 16)) + (let* ((e (make-entity 0 0 16 16)) (out (apply-input-to-entity e (lambda (a) (eq? a 'right))))) (test-equal "facing is 1" 1 (entity-ref out #:facing 0)))) (test-group "left held: facing set to -1" - (let* ((e (make-player-entity 0 0 16 16)) + (let* ((e (make-entity 0 0 16 16)) (out (apply-input-to-entity e (lambda (a) (eq? a 'left))))) (test-equal "facing is -1" -1 (entity-ref out #:facing 0)))) (test-group "no key held: facing retains previous value" - (let* ((e (entity-set (make-player-entity 0 0 16 16) #:facing 1)) + (let* ((e (entity-set (make-entity 0 0 16 16) #: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))))) diff --git a/tests/physics-test.scm b/tests/physics-test.scm index 6d1da86..88ddcce 100644 --- a/tests/physics-test.scm +++ b/tests/physics-test.scm @@ -341,7 +341,7 @@ (solid-row (make-list 15 1)) (rows (append (make-list 24 empty-row) (list solid-row))) (tm (make-test-tilemap rows)) - (e0 (make-player-entity 182 350.5 16 16))) + (e0 (make-entity 182 350.5 16 16))) ;; Should not crash (let loop ((e e0) (n 5)) (if (= n 0) diff --git a/tests/prefabs-test.scm b/tests/prefabs-test.scm index 8a1e5b0..f8cec0a 100644 --- a/tests/prefabs-test.scm +++ b/tests/prefabs-test.scm @@ -31,6 +31,9 @@ (import downstroke-ai) ;; Load module under test +(include "entity.scm") +(import downstroke-entity) + (include "prefabs.scm") (import downstroke-prefabs) diff --git a/tests/world-test.scm b/tests/world-test.scm index 48f492a..557a121 100644 --- a/tests/world-test.scm +++ b/tests/world-test.scm @@ -110,7 +110,7 @@ ;; Test: scene with entities and tilemap (test-group "scene-with-data" - (let* ((player (make-player-entity 100 100 16 16)) + (let* ((player (make-entity 100 100 16 16)) (enemy '(#:type enemy #:x 200 #:y 200)) (tilemap "mock-tilemap") (scene (make-scene entities: (list player enemy) @@ -128,7 +128,7 @@ ;; Test: scene-add-entity adds entity to scene (test-group "scene-add-entity" - (let* ((player (make-player-entity 100 100 16 16)) + (let* ((player (make-entity 100 100 16 16)) (scene (make-scene entities: (list player) tilemap: #f camera-target: #f)) (enemy '(#:type enemy #:x 200 #:y 200))) @@ -194,7 +194,7 @@ ;; Test: scene chaining (was mutation test) (test-group "scene-chaining" (let* ((scene (make-scene entities: '() tilemap: #f camera-target: #f)) - (player (make-player-entity 10 20 16 16)) + (player (make-entity 10 20 16 16)) (scene (scene-add-entity scene player))) (test-equal "entity added" 1 (length (scene-entities scene))) |