diff options
Diffstat (limited to 'tests/physics-test.scm')
| -rw-r--r-- | tests/physics-test.scm | 20 |
1 files changed, 20 insertions, 0 deletions
diff --git a/tests/physics-test.scm b/tests/physics-test.scm index 67c8377..b40f8d1 100644 --- a/tests/physics-test.scm +++ b/tests/physics-test.scm @@ -592,6 +592,26 @@ (test-equal "a pushed up" -3 (entity-ref (car result) #:y 0)) (test-equal "b pushed down" 13 (entity-ref (cdr result) #:y 0))))) +(test-group "skip-pipelines" + (test-group "apply-gravity" + (let* ((e '(#:type t #:vy 0 #:gravity? #t #:skip-pipelines (gravity))) + (r (apply-gravity e))) + (test-equal "skipped: vy unchanged" 0 (entity-ref r #:vy)))) + (test-group "apply-velocity-x" + (let* ((e '(#:type t #:x 10 #:vx 5 #:skip-pipelines (velocity-x))) + (r (apply-velocity-x e))) + (test-equal "skipped: x unchanged" 10 (entity-ref r #:x)))) + (test-group "apply-jump" + (let* ((e '(#:type t #:on-ground? #t #:skip-pipelines (jump))) + (r (apply-jump e #t))) + (test-assert "skipped: no ay" (not (memq #:ay r))))) + (test-group "resolve-pair with entity-collisions skip" + (define (make-solid x y) (list #:type 'block #:x x #:y y #:width 16 #:height 16 #:solid? #t)) + (let* ((a (list #:type 'ghost #:x 0 #:y 0 #:width 16 #:height 16 #:solid? #t + #:skip-pipelines '(entity-collisions))) + (b (make-solid 10 0))) + (test-assert "no resolution" (not (resolve-pair a b)))))) + (test-group "resolve-pair" (define (make-solid x y) (list #:type 'block #:x x #:y y #:width 16 #:height 16 #:solid? #t)) |