aboutsummaryrefslogtreecommitdiff
path: root/tests/entity-test.scm
diff options
context:
space:
mode:
Diffstat (limited to 'tests/entity-test.scm')
-rw-r--r--tests/entity-test.scm75
1 files changed, 38 insertions, 37 deletions
diff --git a/tests/entity-test.scm b/tests/entity-test.scm
index d686acf..d56e115 100644
--- a/tests/entity-test.scm
+++ b/tests/entity-test.scm
@@ -1,4 +1,4 @@
-(import srfi-64)
+(import test)
(include "entity.scm")
(import downstroke-entity)
@@ -11,25 +11,25 @@
(#:y . 200)
(#:width . 16)
(#:height . 16))))
- (test-equal "retrieves type" 'player (entity-ref entity #:type))
- (test-equal "retrieves x" 100 (entity-ref entity #:x))
- (test-equal "retrieves y" 200 (entity-ref entity #:y))
- (test-equal "retrieves width" 16 (entity-ref entity #:width))
- (test-equal "retrieves height" 16 (entity-ref entity #:height)))
+ (test "retrieves type" 'player (entity-ref entity #:type))
+ (test "retrieves x" 100 (entity-ref entity #:x))
+ (test "retrieves y" 200 (entity-ref entity #:y))
+ (test "retrieves width" 16 (entity-ref entity #:width))
+ (test "retrieves height" 16 (entity-ref entity #:height)))
;; Test with default value
(let ((entity '((#:type . player))))
- (test-equal "returns default for missing key"
+ (test "returns default for missing key"
99
(entity-ref entity #:x 99))
- (test-equal "returns #f as default if not specified"
+ (test "returns #f as default if not specified"
#f
(entity-ref entity #:missing-key))))
;; Test: entity-ref with procedure as default
(test-group "entity-ref-with-procedure-default"
(let ((entity '((#:type . player))))
- (test-equal "calls procedure default when key missing"
+ (test "calls procedure default when key missing"
42
(entity-ref entity #:x (lambda () 42)))))
@@ -37,20 +37,20 @@
(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 "has correct x" 50 (entity-ref player #:x))
+ (test "has correct y" 75 (entity-ref player #:y))
+ (test "has correct width" 16 (entity-ref player #:width))
+ (test "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)))
(enemy '((#:type . enemy) (#:x . 200))))
- (test-equal "extracts player type" 'player (entity-type player))
- (test-equal "extracts enemy type" 'enemy (entity-type enemy)))
+ (test "extracts player type" 'player (entity-type player))
+ (test "extracts enemy type" 'enemy (entity-type enemy)))
(let ((no-type '((#:x . 100) (#:y . 200))))
- (test-equal "returns #f for entity without type"
+ (test "returns #f for entity without type"
#f
(entity-type no-type))))
@@ -64,49 +64,49 @@
(#:health . 50)
(#:speed . 2.5)
(#:ai-state . patrol))))
- (test-equal "retrieves numeric property" 50 (entity-ref entity #:health))
- (test-equal "retrieves float property" 2.5 (entity-ref entity #:speed))
- (test-equal "retrieves symbol property" 'patrol (entity-ref entity #:ai-state))))
+ (test "retrieves numeric property" 50 (entity-ref entity #:health))
+ (test "retrieves float property" 2.5 (entity-ref entity #:speed))
+ (test "retrieves symbol property" 'patrol (entity-ref entity #:ai-state))))
;; Test: entity-set updates entity properties
(test-group "entity-set"
(test-group "existing key is replaced"
(let ((e (entity-set '((#:x . 10) (#:y . 20)) #:x 15)))
- (test-equal "value updated" 15 (entity-ref e #:x))
- (test-equal "other key untouched" 20 (entity-ref e #:y))
+ (test "value updated" 15 (entity-ref e #:x))
+ (test "other key untouched" 20 (entity-ref e #:y))
;; alist length stays at 2 (one pair removed, one added) — not 3.
- (test-equal "no duplicate key: list length unchanged" 2 (length e))))
+ (test "no duplicate key: list length unchanged" 2 (length e))))
(test-group "new key is added"
(let ((e (entity-set '((#:x . 10)) #:vx 3)))
- (test-equal "new key present" 3 (entity-ref e #:vx))
- (test-equal "existing key untouched" 10 (entity-ref e #:x))
- (test-equal "list grows by one pair" 2 (length e)))))
+ (test "new key present" 3 (entity-ref e #:vx))
+ (test "existing key untouched" 10 (entity-ref e #:x))
+ (test "list grows by one pair" 2 (length e)))))
(test-group "entity-set-many"
(test-group "Set multiple entities with cons"
(let ((e (entity-set-many '((#:x . 10) (#:y . 20))
'((#:x . 15) (#:y . 25)))))
- (test-equal "value x updated" 15 (entity-ref e #:x))
- (test-equal "value y updated" 25 (entity-ref e #:y)))))
+ (test "value x updated" 15 (entity-ref e #:x))
+ (test "value y updated" 25 (entity-ref e #:y)))))
;; Test: entity-update applies transformations
(test-group "entity-update"
(test-group "transform existing value"
(let ((e (entity-update '((#:x . 10) (#:y . 20)) #:x (lambda (v) (+ v 5)))))
- (test-equal "#:x is 15" 15 (entity-ref e #:x))
- (test-equal "#:y is 20" 20 (entity-ref e #:y))))
+ (test "#:x is 15" 15 (entity-ref e #:x))
+ (test "#:y is 20" 20 (entity-ref e #:y))))
(test-group "missing key uses default"
(let ((e (entity-update '((#:x . 10)) #:health (lambda (v) (+ v 1)) 0)))
- (test-equal "#:health is 1" 1 (entity-ref e #:health))))
+ (test "#:health is 1" 1 (entity-ref e #:health))))
(test-group "missing key without default"
(let ((e (entity-update '((#:x . 10)) #:z (lambda (v) v))))
- (test-equal "#:z is #f" #f (entity-ref e #:z))))
+ (test "#:z is #f" #f (entity-ref e #:z))))
(test-group "no duplicate keys"
(let ((e (entity-update '((#:x . 10) (#:y . 20)) #:x (lambda (v) (* v 2)))))
- (test-equal "length is 2" 2 (length e)))))
+ (test "length is 2" 2 (length e)))))
(test-group "entity-skips-pipeline?"
(test-assert "absent skip list"
@@ -123,9 +123,9 @@
(test-group "define-pipeline"
(let ((e '((#:type . t) (#:x . 0))))
- (test-equal "runs body" 42 (entity-ref (fixture-pipeline #f e 0) #:x)))
+ (test "runs body" 42 (entity-ref (fixture-pipeline #f e 0) #:x)))
(let ((e '((#:type . t) (#:x . 0) (#:skip-pipelines . (fixture-skip)))))
- (test-equal "skipped" 0 (entity-ref (fixture-pipeline #f e 0) #:x))))
+ (test "skipped" 0 (entity-ref (fixture-pipeline #f e 0) #:x))))
(define-pipeline (guarded-pipeline guarded-skip) (scene_ ent _dt)
guard: (entity-ref ent #:active? #f)
@@ -133,13 +133,14 @@
(test-group "define-pipeline with guard:"
(let ((e '((#:type . t) (#:x . 0) (#:active? . #t))))
- (test-equal "runs body when guard passes" 99
+ (test "runs body when guard passes" 99
(entity-ref (guarded-pipeline #f e 0) #:x)))
(let ((e '((#:type . t) (#:x . 0))))
- (test-equal "returns entity unchanged when guard fails" 0
+ (test "returns entity unchanged when guard fails" 0
(entity-ref (guarded-pipeline #f e 0) #:x)))
(let ((e '((#:type . t) (#:x . 0) (#:active? . #t) (#:skip-pipelines . (guarded-skip)))))
- (test-equal "skip-pipelines takes precedence over guard" 0
+ (test "skip-pipelines takes precedence over guard" 0
(entity-ref (guarded-pipeline #f e 0) #:x))))
(test-end "entity")
+(test-exit)