From a02b892e2ad1e1605ff942c63afdd618daa48be4 Mon Sep 17 00:00:00 2001 From: Gene Pasquet Date: Fri, 17 Apr 2026 16:52:41 +0100 Subject: Migrate tests to the test egg --- tests/world-test.scm | 113 ++++++++++++++++++++++++++------------------------- 1 file changed, 57 insertions(+), 56 deletions(-) (limited to 'tests/world-test.scm') diff --git a/tests/world-test.scm b/tests/world-test.scm index a66103e..8cbe4f2 100644 --- a/tests/world-test.scm +++ b/tests/world-test.scm @@ -3,7 +3,7 @@ (chicken base) (chicken keyword) defstruct - srfi-64 + test (only srfi-1 every member make-list)) ;; Create a mock tilemap module to avoid SDL dependency @@ -65,10 +65,10 @@ tileset: #f layers: (list layer1) objects: '()))) - (test-equal "top-left corner" 1 (tilemap-tile-at tm 0 0)) - (test-equal "top-right corner" 3 (tilemap-tile-at tm 2 0)) - (test-equal "bottom-left corner" 7 (tilemap-tile-at tm 0 2)) - (test-equal "center" 5 (tilemap-tile-at tm 1 1)))) + (test "top-left corner" 1 (tilemap-tile-at tm 0 0)) + (test "top-right corner" 3 (tilemap-tile-at tm 2 0)) + (test "bottom-left corner" 7 (tilemap-tile-at tm 0 2)) + (test "center" 5 (tilemap-tile-at tm 1 1)))) (test-group "out-of-bounds returns 0" (let* ((layer1 (make-layer name: "test" width: 3 height: 3 @@ -79,10 +79,10 @@ tileset: #f layers: (list layer1) objects: '()))) - (test-equal "negative col" 0 (tilemap-tile-at tm -1 0)) - (test-equal "col beyond width" 0 (tilemap-tile-at tm 3 0)) - (test-equal "negative row" 0 (tilemap-tile-at tm 0 -1)) - (test-equal "row beyond height" 0 (tilemap-tile-at tm 0 3)))) + (test "negative col" 0 (tilemap-tile-at tm -1 0)) + (test "col beyond width" 0 (tilemap-tile-at tm 3 0)) + (test "negative row" 0 (tilemap-tile-at tm 0 -1)) + (test "row beyond height" 0 (tilemap-tile-at tm 0 3)))) (test-group "zero tiles are skipped to next layer" (let* ((layer1 (make-layer name: "test1" width: 3 height: 3 @@ -95,23 +95,23 @@ tileset: #f layers: (list layer1 layer2) objects: '()))) - (test-equal "skips zero in layer1, finds in layer2" + (test "skips zero in layer1, finds in layer2" 5 (tilemap-tile-at tm 1 1))))) ;; Test: scene record creation (test-group "scene-structure" (let ((scene (make-scene entities: '() tilemap: #f camera-target: #f))) (test-assert "scene is a record" (scene? scene)) - (test-equal "entities list is empty" '() (scene-entities scene)) - (test-equal "tilemap is #f" #f (scene-tilemap scene)) - (test-equal "background defaults to #f" #f (scene-background scene)) - (test-equal "tileset defaults to #f" #f (scene-tileset scene))) + (test "entities list is empty" '() (scene-entities scene)) + (test "tilemap is #f" #f (scene-tilemap scene)) + (test "background defaults to #f" #f (scene-background scene)) + (test "tileset defaults to #f" #f (scene-tileset scene))) (let ((s (make-scene entities: '() tilemap: #f camera-target: #f background: '(40 44 52)))) - (test-equal "background RGB stored" '(40 44 52) (scene-background s))) + (test "background RGB stored" '(40 44 52) (scene-background s))) (let ((s (make-scene entities: '() tilemap: #f camera-target: #f background: '(1 2 3 200)))) - (test-equal "background RGBA stored" '(1 2 3 200) (scene-background s)))) + (test "background RGBA stored" '(1 2 3 200) (scene-background s)))) ;; Test: scene with entities and tilemap (test-group "scene-with-data" @@ -121,13 +121,13 @@ (scene (make-scene entities: (list player enemy) tilemap: tilemap camera-target: #f))) - (test-equal "scene has 2 entities" + (test "scene has 2 entities" 2 (length (scene-entities scene))) - (test-equal "first entity is player" + (test "first entity is player" 'player (entity-type (car (scene-entities scene)))) - (test-equal "tilemap is set correctly" + (test "tilemap is set correctly" "mock-tilemap" (scene-tilemap scene)))) @@ -137,12 +137,12 @@ (scene (make-scene entities: (list player) tilemap: #f camera-target: #f)) (enemy (entity #:type 'enemy #:x 200 #:y 200))) - (test-equal "initial entity count" 1 (length (scene-entities scene))) + (test "initial entity count" 1 (length (scene-entities scene))) (let ((scene2 (scene-add-entity scene enemy))) - (test-equal "original scene unchanged" 1 (length (scene-entities scene))) - (test-equal "entity count after add" 2 (length (scene-entities scene2))) - (test-equal "second entity is enemy" + (test "original scene unchanged" 1 (length (scene-entities scene))) + (test "entity count after add" 2 (length (scene-entities scene2))) + (test "second entity is enemy" 'enemy (entity-type (cadr (scene-entities scene2))))))) @@ -155,7 +155,7 @@ (scene (scene-add-entity scene e2)) (scene (scene-add-entity scene e3))) - (test-equal "entities are in order" + (test "entities are in order" '(a b c) (map entity-type (scene-entities scene))))) @@ -171,16 +171,16 @@ (entity #:type type #:x (+ x 10) #:y y)))) (scene2 (scene-map-entities scene move-right))) - (test-equal "original scene unchanged" + (test "original scene unchanged" 100 (entity-ref (car (scene-entities scene)) #:x)) - (test-equal "first entity moved right" + (test "first entity moved right" 110 (entity-ref (car (scene-entities scene2)) #:x)) - (test-equal "second entity moved right" + (test "second entity moved right" 210 (entity-ref (cadr (scene-entities scene2)) #:x)) - (test-equal "y values unchanged" + (test "y values unchanged" 100 (entity-ref (car (scene-entities scene2)) #:y)))) @@ -191,8 +191,8 @@ (scene (make-scene entities: (list e1 e2) tilemap: #f camera-target: #f)) (scene2 (scene-map-entities scene (lambda (scene e) e)))) - (test-equal "entity count unchanged" 2 (length (scene-entities scene2))) - (test-equal "first entity unchanged" + (test "entity count unchanged" 2 (length (scene-entities scene2))) + (test "first entity unchanged" 100 (entity-ref (car (scene-entities scene2)) #:x)))) @@ -202,7 +202,7 @@ (player (make-entity 10 20 16 16)) (scene (scene-add-entity scene player))) - (test-equal "entity added" 1 (length (scene-entities scene))) + (test "entity added" 1 (length (scene-entities scene))) (let ((scene (scene-map-entities scene (lambda (scene e) @@ -211,15 +211,15 @@ (type (entity-type e))) (entity #:type type #:x (* x 2) #:y (* y 2) #:width 16 #:height 16)))))) - (test-equal "entity x doubled" 20 (entity-ref (car (scene-entities scene)) #:x)) - (test-equal "entity y doubled" 40 (entity-ref (car (scene-entities scene)) #:y))))) + (test "entity x doubled" 20 (entity-ref (car (scene-entities scene)) #:x)) + (test "entity y doubled" 40 (entity-ref (car (scene-entities scene)) #:y))))) ;; Test: update-scene for tilemap (test-group "scene-tilemap-update" (let* ((scene (make-scene entities: '() tilemap: #f camera-target: #f)) (scene2 (update-scene scene tilemap: "new-tilemap"))) - (test-equal "tilemap initially #f" #f (scene-tilemap scene)) - (test-equal "tilemap updated in new scene" "new-tilemap" (scene-tilemap scene2)))) + (test "tilemap initially #f" #f (scene-tilemap scene)) + (test "tilemap updated in new scene" "new-tilemap" (scene-tilemap scene2)))) ;; Create a test tilemap for the filter test (define test-tilemap @@ -241,9 +241,9 @@ camera-target: #f)) (scene2 (scene-filter-entities scene (lambda (e) (eq? (entity-ref e #:type #f) 'player))))) - (test-equal "original scene unchanged" 2 (length (scene-entities scene))) - (test-equal "keeps matching entities" 1 (length (scene-entities scene2))) - (test-equal "kept entity is player" + (test "original scene unchanged" 2 (length (scene-entities scene))) + (test "keeps matching entities" 1 (length (scene-entities scene2))) + (test "kept entity is player" 'player (entity-ref (car (scene-entities scene2)) #:type #f)))) @@ -251,24 +251,24 @@ (let* ((cam (make-camera x: 0 y: 0)) (ent (entity #:type 'player #:x 400 #:y 300 #:width 16 #:height 16)) (cam2 (camera-follow cam ent 600 400))) - (test-equal "original camera unchanged" 0 (camera-x cam)) - (test-equal "centers camera x on entity" 100 (camera-x cam2)) - (test-equal "centers camera y on entity" 100 (camera-y cam2))) + (test "original camera unchanged" 0 (camera-x cam)) + (test "centers camera x on entity" 100 (camera-x cam2)) + (test "centers camera y on entity" 100 (camera-y cam2))) (let* ((cam (make-camera x: 0 y: 0)) (ent (entity #:type 'player #:x 50 #:y 30 #:width 16 #:height 16)) (cam2 (camera-follow cam ent 600 400))) - (test-equal "clamps camera x to 0 when entity near origin" 0 (camera-x cam2)) - (test-equal "clamps camera y to 0 when entity near origin" 0 (camera-y cam2)))) + (test "clamps camera x to 0 when entity near origin" 0 (camera-x cam2)) + (test "clamps camera y to 0 when entity near origin" 0 (camera-y cam2)))) (test-group "scene-find-tagged" (let* ((p (entity #:type 'player #:x 0 #:y 0 #:width 16 #:height 16 #:tags '(player))) (e (entity #:type 'enemy #:x 0 #:y 0 #:width 16 #:height 16 #:tags '(enemy npc))) (s (make-scene entities: (list p e) tilemap: #f camera: (make-camera x: 0 y: 0) tileset-texture: #f camera-target: #f))) - (test-equal "finds entity with matching tag" p (scene-find-tagged s 'player)) - (test-equal "finds enemy by 'enemy tag" e (scene-find-tagged s 'enemy)) - (test-equal "finds entity with second tag in list" e (scene-find-tagged s 'npc)) - (test-equal "returns #f when tag not found" #f (scene-find-tagged s 'boss)))) + (test "finds entity with matching tag" p (scene-find-tagged s 'player)) + (test "finds enemy by 'enemy tag" e (scene-find-tagged s 'enemy)) + (test "finds entity with second tag in list" e (scene-find-tagged s 'npc)) + (test "returns #f when tag not found" #f (scene-find-tagged s 'boss)))) (test-group "scene-find-all-tagged" (let* ((p1 (entity #:type 'player #:x 0 #:y 0 #:width 16 #:height 16 #:tags '(player friendly))) @@ -276,8 +276,8 @@ (e (entity #:type 'enemy #:x 0 #:y 0 #:width 16 #:height 16 #:tags '(enemy))) (s (make-scene entities: (list p1 p2 e) tilemap: #f camera: (make-camera x: 0 y: 0) tileset-texture: #f camera-target: #f))) - (test-equal "returns all friendly entities" 2 (length (scene-find-all-tagged s 'friendly))) - (test-equal "returns empty list when none match" '() (scene-find-all-tagged s 'boss)))) + (test "returns all friendly entities" 2 (length (scene-find-all-tagged s 'friendly))) + (test "returns empty list when none match" '() (scene-find-all-tagged s 'boss)))) (test-group "sync-groups" (let* ((gid 'g1) @@ -289,20 +289,21 @@ #:x 0 #:y 0 #:width 8 #:height 8)) (entities (list origin m1 m2)) (result (sync-groups entities))) - (test-equal "original list unchanged" 0 (entity-ref (list-ref entities 1) #:x)) - (test-equal "member 1 follows origin" 105 (entity-ref (list-ref result 1) #:x)) - (test-equal "member 1 y" 200 (entity-ref (list-ref result 1) #:y)) - (test-equal "member 2 x" 100 (entity-ref (list-ref result 2) #:x)) - (test-equal "member 2 y" 207 (entity-ref (list-ref result 2) #:y)))) + (test "original list unchanged" 0 (entity-ref (list-ref entities 1) #:x)) + (test "member 1 follows origin" 105 (entity-ref (list-ref result 1) #:x)) + (test "member 1 y" 200 (entity-ref (list-ref result 1) #:y)) + (test "member 2 x" 100 (entity-ref (list-ref result 2) #:x)) + (test "member 2 y" 207 (entity-ref (list-ref result 2) #:y)))) (test-group "scene-transform-entities" (let* ((e1 (entity #:type 'a #:x 1)) (e2 (entity #:type 'b #:x 2)) (scene (make-scene entities: (list e1 e2) tilemap: #f camera-target: #f)) (scene2 (scene-transform-entities scene reverse))) - (test-equal "transforms entity list" 'b + (test "transforms entity list" 'b (entity-type (car (scene-entities scene2)))) - (test-equal "original scene unchanged" 'a + (test "original scene unchanged" 'a (entity-type (car (scene-entities scene)))))) (test-end "world-module") +(test-exit) -- cgit v1.2.3