diff options
Diffstat (limited to 'tests/entity-test.scm')
| -rw-r--r-- | tests/entity-test.scm | 94 |
1 files changed, 47 insertions, 47 deletions
diff --git a/tests/entity-test.scm b/tests/entity-test.scm index 3b83dff..d686acf 100644 --- a/tests/entity-test.scm +++ b/tests/entity-test.scm @@ -4,9 +4,13 @@ (test-begin "entity") -;; Test: entity-ref retrieves values from entity plists +;; Test: entity-ref retrieves values from entity alists (test-group "entity-ref" - (let ((entity '(#:type player #:x 100 #:y 200 #:width 16 #:height 16))) + (let ((entity '((#:type . player) + (#:x . 100) + (#: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)) @@ -14,7 +18,7 @@ (test-equal "retrieves height" 16 (entity-ref entity #:height))) ;; Test with default value - (let ((entity '(#:type player))) + (let ((entity '((#:type . player)))) (test-equal "returns default for missing key" 99 (entity-ref entity #:x 99)) @@ -24,7 +28,7 @@ ;; Test: entity-ref with procedure as default (test-group "entity-ref-with-procedure-default" - (let ((entity '(#:type player))) + (let ((entity '((#:type . player)))) (test-equal "calls procedure default when key missing" 42 (entity-ref entity #:x (lambda () 42))))) @@ -40,26 +44,26 @@ ;; Test: entity-type extracts type from entity (test-group "entity-type" - (let ((player '(#:type player #:x 100)) - (enemy '(#:type enemy #:x 200))) + (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))) - (let ((no-type '(#:x 100 #:y 200))) + (let ((no-type '((#:x . 100) (#:y . 200)))) (test-equal "returns #f for entity without type" #f (entity-type no-type)))) ;; Test: complex entity with multiple properties (test-group "complex-entity" - (let ((entity '(#:type enemy - #:x 100 - #:y 200 - #:width 16 - #:height 16 - #:health 50 - #:speed 2.5 - #:ai-state patrol))) + (let ((entity '((#:type . enemy) + (#:x . 100) + (#:y . 200) + (#:width . 16) + (#:height . 16) + (#: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)))) @@ -67,79 +71,75 @@ ;; 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))) + (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)) - ;; plist length should shrink from 4 to 4 (same — one pair removed, one added) - ;; stronger: verify the list length stays at 4, not 6 - (test-equal "no duplicate key: list length unchanged" 4 (length e)))) + ;; alist length stays at 2 (one pair removed, one added) — not 3. + (test-equal "no duplicate key: list length unchanged" 2 (length e)))) (test-group "new key is added" - (let ((e (entity-set '(#:x 10) #:vx 3))) + (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" 4 (length e))))) + (test-equal "list grows by one pair" 2 (length e))))) (test-group "entity-set-many" - (test-group "Set multiple entities with lists" - (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-group "Set multiple entities with cons" - (let ((e (entity-set-many '(#:x 10 #:y 20) (list (cons #:x 15) (cons #:y 25))))) + (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: 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))))) + (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-group "missing key uses default" - (let ((e (entity-update '(#:x 10) #:health (lambda (v) (+ v 1)) 0))) + (let ((e (entity-update '((#:x . 10)) #:health (lambda (v) (+ v 1)) 0))) (test-equal "#:health is 1" 1 (entity-ref e #:health)))) (test-group "missing key without default" - (let ((e (entity-update '(#:x 10) #:z (lambda (v) v)))) + (let ((e (entity-update '((#:x . 10)) #:z (lambda (v) v)))) (test-equal "#: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 4" 4 (length e))))) + (let ((e (entity-update '((#:x . 10) (#:y . 20)) #:x (lambda (v) (* v 2))))) + (test-equal "length is 2" 2 (length e))))) (test-group "entity-skips-pipeline?" (test-assert "absent skip list" - (not (entity-skips-pipeline? '(#:type a) 'gravity))) + (not (entity-skips-pipeline? '((#:type . a)) 'gravity))) (test-assert "empty skip list" - (not (entity-skips-pipeline? '(#:skip-pipelines ()) 'gravity))) + (not (entity-skips-pipeline? '((#:skip-pipelines . ())) 'gravity))) (test-assert "member" - (entity-skips-pipeline? '(#:skip-pipelines (gravity velocity-x)) 'gravity)) + (entity-skips-pipeline? '((#:skip-pipelines . (gravity velocity-x))) 'gravity)) (test-assert "not member" - (not (entity-skips-pipeline? '(#:skip-pipelines (gravity)) 'velocity-x)))) + (not (entity-skips-pipeline? '((#:skip-pipelines . (gravity))) 'velocity-x)))) -(define-pipeline (fixture-pipeline fixture-skip) (scene_ ent) +(define-pipeline (fixture-pipeline fixture-skip) (scene_ ent _dt) (entity-set ent #:x 42)) (test-group "define-pipeline" - (let ((e '(#:type t #:x 0))) - (test-equal "runs body" 42 (entity-ref (fixture-pipeline e) #:x))) - (let ((e '(#:type t #:x 0 #:skip-pipelines (fixture-skip)))) - (test-equal "skipped" 0 (entity-ref (fixture-pipeline e) #:x)))) + (let ((e '((#:type . t) (#:x . 0)))) + (test-equal "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)))) -(define-pipeline (guarded-pipeline guarded-skip) (scene_ ent) +(define-pipeline (guarded-pipeline guarded-skip) (scene_ ent _dt) guard: (entity-ref ent #:active? #f) (entity-set ent #:x 99)) (test-group "define-pipeline with guard:" - (let ((e '(#:type t #:x 0 #:active? #t))) + (let ((e '((#:type . t) (#:x . 0) (#:active? . #t)))) (test-equal "runs body when guard passes" 99 - (entity-ref (guarded-pipeline e) #:x))) - (let ((e '(#:type t #:x 0))) + (entity-ref (guarded-pipeline #f e 0) #:x))) + (let ((e '((#:type . t) (#:x . 0)))) (test-equal "returns entity unchanged when guard fails" 0 - (entity-ref (guarded-pipeline e) #:x))) - (let ((e '(#:type t #:x 0 #:active? #t #:skip-pipelines (guarded-skip)))) + (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 - (entity-ref (guarded-pipeline e) #:x)))) + (entity-ref (guarded-pipeline #f e 0) #:x)))) (test-end "entity") |