blob: 9c7607caab87815ac4cc7b798fe9cd1389c377ca (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
|
(import srfi-64)
(include "entity.scm")
(import downstroke-entity)
(test-begin "entity")
;; Test: entity-ref retrieves values from entity plists
(test-group "entity-ref"
(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))
(test-equal "retrieves width" 16 (entity-ref entity #:width))
(test-equal "retrieves height" 16 (entity-ref entity #:height)))
;; Test with default value
(let ((entity '(#:type player)))
(test-equal "returns default for missing key"
99
(entity-ref entity #:x 99))
(test-equal "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"
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))
(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)))
(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)))
(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: 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))
;; 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))))
(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" 4 (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" (entity-ref e #:x) 15)
(test-equal "value y updated" (entity-ref e #:y) 25)))
(test-group "Set multiple entities with cons"
(let ((e (entity-set-many '(#:x 10 #:y 20) (list (cons #:x 15) (cons #:y 25)))))
(test-equal "value x updated" (entity-ref e #:x) 15)
(test-equal "value y updated" (entity-ref e #:y) 25))))
;; 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-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-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-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)))))
(test-group "entity-skips-pipeline?"
(test-assert "absent skip list"
(not (entity-skips-pipeline? '(#:type a) 'gravity)))
(test-assert "empty skip list"
(not (entity-skips-pipeline? '(#:skip-pipelines ()) 'gravity)))
(test-assert "member"
(entity-skips-pipeline? '(#:skip-pipelines (gravity velocity-x)) 'gravity))
(test-assert "not member"
(not (entity-skips-pipeline? '(#:skip-pipelines (gravity)) 'velocity-x))))
(define-pipeline (fixture-pipeline fixture-skip) (ent)
(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))))
(define-pipeline (guarded-pipeline guarded-skip) (ent)
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)))
(test-equal "runs body when guard passes" 99
(entity-ref (guarded-pipeline e) #: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))))
(test-equal "skip-pipelines takes precedence over guard" 0
(entity-ref (guarded-pipeline e) #:x))))
(test-end "entity")
|
