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/tilemap-test.scm | 91 +++++++++++++++++++++++++------------------------- 1 file changed, 46 insertions(+), 45 deletions(-) (limited to 'tests/tilemap-test.scm') diff --git a/tests/tilemap-test.scm b/tests/tilemap-test.scm index 16629bd..282400f 100644 --- a/tests/tilemap-test.scm +++ b/tests/tilemap-test.scm @@ -15,7 +15,7 @@ (prefix sdl2 sdl2:) (prefix sdl2-image img:) srfi-69 - srfi-64) + test) ;; Load the module source directly (include "tilemap.scm") @@ -35,12 +35,12 @@ image-source: "test.png" image: #f))) (test-assert "tileset is a record" (tileset? ts)) - (test-equal "tilewidth is set correctly" 16 (tileset-tilewidth ts)) - (test-equal "tileheight is set correctly" 16 (tileset-tileheight ts)) - (test-equal "spacing is set correctly" 1 (tileset-spacing ts)) - (test-equal "tilecount is set correctly" 100 (tileset-tilecount ts)) - (test-equal "columns is set correctly" 10 (tileset-columns ts)) - (test-equal "image-source is set correctly" "test.png" (tileset-image-source ts)))) + (test "tilewidth is set correctly" 16 (tileset-tilewidth ts)) + (test "tileheight is set correctly" 16 (tileset-tileheight ts)) + (test "spacing is set correctly" 1 (tileset-spacing ts)) + (test "tilecount is set correctly" 100 (tileset-tilecount ts)) + (test "columns is set correctly" 10 (tileset-columns ts)) + (test "image-source is set correctly" "test.png" (tileset-image-source ts)))) ;; Test: tileset-rows calculation (test-group "tileset-rows" @@ -51,7 +51,7 @@ columns: 10 image-source: "test.png" image: #f))) - (test-equal "100 tiles / 10 columns = 10 rows" + (test "100 tiles / 10 columns = 10 rows" 10 (tileset-rows ts))) @@ -62,7 +62,7 @@ columns: 10 image-source: "test.png" image: #f))) - (test-equal "105 tiles / 10 columns = 11 rows (ceiling)" + (test "105 tiles / 10 columns = 11 rows (ceiling)" 11 (tileset-rows ts)))) @@ -79,16 +79,16 @@ (tile11 (tileset-tile ts 11))) (test-assert "tile1 is a tile record" (tile? tile1)) - (test-equal "tile1 has correct id" 1 (tile-id tile1)) + (test "tile1 has correct id" 1 (tile-id tile1)) (test-assert "tile1 has a rect" (sdl2:rect? (tile-rect tile1))) ;; First tile should be at (0, 0) - (test-equal "tile1 x position" 0 (sdl2:rect-x (tile-rect tile1))) - (test-equal "tile1 y position" 0 (sdl2:rect-y (tile-rect tile1))) + (test "tile1 x position" 0 (sdl2:rect-x (tile-rect tile1))) + (test "tile1 y position" 0 (sdl2:rect-y (tile-rect tile1))) ;; Tile 11 should be at start of second row (x=0, y=17 with spacing) - (test-equal "tile11 x position" 0 (sdl2:rect-x (tile-rect tile11))) - (test-equal "tile11 y position" 17 (sdl2:rect-y (tile-rect tile11))))) + (test "tile11 x position" 0 (sdl2:rect-x (tile-rect tile11))) + (test "tile11 y position" 17 (sdl2:rect-y (tile-rect tile11))))) ;; Test: layer record creation (test-group "layer-structure" @@ -97,10 +97,10 @@ height: 30 map: '()))) (test-assert "layer is a record" (layer? layer)) - (test-equal "name is set correctly" "ground" (layer-name layer)) - (test-equal "width is set correctly" 40 (layer-width layer)) - (test-equal "height is set correctly" 30 (layer-height layer)) - (test-equal "map is empty list" '() (layer-map layer)))) + (test "name is set correctly" "ground" (layer-name layer)) + (test "width is set correctly" 40 (layer-width layer)) + (test "height is set correctly" 30 (layer-height layer)) + (test "map is empty list" '() (layer-map layer)))) ;; Test: object record creation (test-group "object-structure" @@ -112,11 +112,11 @@ height: 16 properties: '((text . "hello"))))) (test-assert "object is a record" (object? obj)) - (test-equal "name is set correctly" "player" (object-name obj)) - (test-equal "type is set correctly" "Player" (object-type obj)) - (test-equal "x is set correctly" 100 (object-x obj)) - (test-equal "y is set correctly" 200 (object-y obj)) - (test-equal "properties contain text" "hello" (alist-ref 'text (object-properties obj))))) + (test "name is set correctly" "player" (object-name obj)) + (test "type is set correctly" "Player" (object-type obj)) + (test "x is set correctly" 100 (object-x obj)) + (test "y is set correctly" 200 (object-y obj)) + (test "properties contain text" "hello" (alist-ref 'text (object-properties obj))))) ;; Test: tilemap record creation (test-group "tilemap-structure" @@ -129,17 +129,17 @@ layers: '() objects: '()))) (test-assert "tilemap is a record" (tilemap? tm)) - (test-equal "width is set correctly" 40 (tilemap-width tm)) - (test-equal "height is set correctly" 30 (tilemap-height tm)) - (test-equal "tilewidth is set correctly" 16 (tilemap-tilewidth tm)) - (test-equal "tileheight is set correctly" 16 (tilemap-tileheight tm)))) + (test "width is set correctly" 40 (tilemap-width tm)) + (test "height is set correctly" 30 (tilemap-height tm)) + (test "tilewidth is set correctly" 16 (tilemap-tilewidth tm)) + (test "tileheight is set correctly" 16 (tilemap-tileheight tm)))) ;; Test: tile record creation (test-group "tile-structure" (let* ((rect (sdl2:make-rect 0 0 16 16)) (tile (make-tile id: 1 rect: rect))) (test-assert "tile is a record" (tile? tile)) - (test-equal "id is set correctly" 1 (tile-id tile)) + (test "id is set correctly" 1 (tile-id tile)) (test-assert "rect is an SDL rect" (sdl2:rect? (tile-rect tile))))) ;; Test: parse-tileset XML parsing @@ -150,12 +150,12 @@ ") (ts (parse-tileset xml))) (test-assert "returns a tileset" (tileset? ts)) - (test-equal "parses tilewidth" 16 (tileset-tilewidth ts)) - (test-equal "parses tileheight" 16 (tileset-tileheight ts)) - (test-equal "parses spacing" 1 (tileset-spacing ts)) - (test-equal "parses tilecount" 100 (tileset-tilecount ts)) - (test-equal "parses columns" 10 (tileset-columns ts)) - (test-equal "parses image source" "test.png" (tileset-image-source ts)))) + (test "parses tilewidth" 16 (tileset-tilewidth ts)) + (test "parses tileheight" 16 (tileset-tileheight ts)) + (test "parses spacing" 1 (tileset-spacing ts)) + (test "parses tilecount" 100 (tileset-tilecount ts)) + (test "parses columns" 10 (tileset-columns ts)) + (test "parses image source" "test.png" (tileset-image-source ts)))) ;; Test: parse-tilemap XML parsing (test-group "parse-tilemap" @@ -171,13 +171,13 @@ ") (tm (parse-tilemap xml))) (test-assert "returns a tilemap" (tilemap? tm)) - (test-equal "parses width" 10 (tilemap-width tm)) - (test-equal "parses height" 10 (tilemap-height tm)) - (test-equal "parses tilewidth" 16 (tilemap-tilewidth tm)) - (test-equal "parses tileheight" 16 (tilemap-tileheight tm)) - (test-equal "parses tileset source" "test.tsx" (tilemap-tileset-source tm)) + (test "parses width" 10 (tilemap-width tm)) + (test "parses height" 10 (tilemap-height tm)) + (test "parses tilewidth" 16 (tilemap-tilewidth tm)) + (test "parses tileheight" 16 (tilemap-tileheight tm)) + (test "parses tileset source" "test.tsx" (tilemap-tileset-source tm)) (test-assert "has layers" (not (null? (tilemap-layers tm)))) - (test-equal "first layer name" "ground" (layer-name (car (tilemap-layers tm)))))) + (test "first layer name" "ground" (layer-name (car (tilemap-layers tm)))))) ;; Test: parse-tilemap with objects (test-group "parse-tilemap-with-objects" @@ -195,10 +195,11 @@ (tm (parse-tilemap xml))) (test-assert "has objects" (not (null? (tilemap-objects tm)))) (let ((obj (car (tilemap-objects tm)))) - (test-equal "object name" "player" (object-name obj)) - (test-equal "object type" "Player" (object-type obj)) - (test-equal "object x" 50 (object-x obj)) - (test-equal "object y" 50 (object-y obj)) - (test-equal "object has properties" "5" (alist-ref 'speed (object-properties obj)))))) + (test "object name" "player" (object-name obj)) + (test "object type" "Player" (object-type obj)) + (test "object x" 50 (object-x obj)) + (test "object y" 50 (object-y obj)) + (test "object has properties" "5" (alist-ref 'speed (object-properties obj)))))) (test-end "tilemap-module") +(test-exit) -- cgit v1.2.3