aboutsummaryrefslogtreecommitdiff
path: root/tests/tween-test.scm
diff options
context:
space:
mode:
authorGene Pasquet <dev@etenil.net>2026-04-17 16:52:41 +0100
committerGene Pasquet <dev@etenil.net>2026-04-17 16:52:41 +0100
commita02b892e2ad1e1605ff942c63afdd618daa48be4 (patch)
tree7ccd9278a0cdc7fd2f156b0b4710f6ac00acab27 /tests/tween-test.scm
parent8251c85a4a588504d38a2fad05e4b0fe1cdccb9d (diff)
Migrate tests to the test egg
Diffstat (limited to 'tests/tween-test.scm')
-rw-r--r--tests/tween-test.scm85
1 files changed, 43 insertions, 42 deletions
diff --git a/tests/tween-test.scm b/tests/tween-test.scm
index 962d325..51675b8 100644
--- a/tests/tween-test.scm
+++ b/tests/tween-test.scm
@@ -1,4 +1,4 @@
-(import srfi-64
+(import test
(chicken base))
(include "entity.scm")
(include "tween.scm")
@@ -12,18 +12,18 @@
(test-begin "tween")
(test-group "ease functions"
- (test-equal "linear mid" 0.5 (ease-linear 0.5))
- (test-equal "quad-in mid" 0.25 (ease-quad-in 0.5))
- (test-equal "quad-out mid" 0.75 (ease-quad-out 0.5))
- (test-equal "quad-in-out mid" 0.5 (ease-quad-in-out 0.5))
- (test-equal "cubic-in mid" 0.125 (ease-cubic-in 0.5))
+ (test "linear mid" 0.5 (ease-linear 0.5))
+ (test "quad-in mid" 0.25 (ease-quad-in 0.5))
+ (test "quad-out mid" 0.75 (ease-quad-out 0.5))
+ (test "quad-in-out mid" 0.5 (ease-quad-in-out 0.5))
+ (test "cubic-in mid" 0.125 (ease-cubic-in 0.5))
(test-assert "sine-in-out endpoints"
(and (= 0.0 (ease-sine-in-out 0)) (= 1.0 (ease-sine-in-out 1))))
- (test-equal "expo-in at 0" 0.0 (ease-expo-in 0))
- (test-equal "expo-out at 1" 1.0 (ease-expo-out 1))
- (test-equal "expo-in-out mid" 0.5 (ease-expo-in-out 0.5))
- (test-equal "cubic-in-out mid" 0.5 (ease-cubic-in-out 0.5))
- (test-equal "cubic-out mid" 0.875 (ease-cubic-out 0.5))
+ (test "expo-in at 0" 0.0 (ease-expo-in 0))
+ (test "expo-out at 1" 1.0 (ease-expo-out 1))
+ (test "expo-in-out mid" 0.5 (ease-expo-in-out 0.5))
+ (test "cubic-in-out mid" 0.5 (ease-cubic-in-out 0.5))
+ (test "cubic-out mid" 0.875 (ease-cubic-out 0.5))
(test-assert "cubic-in-out stays in [0,1]"
(let loop ((i 0) (ok #t))
(if (> i 100) ok
@@ -32,11 +32,11 @@
(loop (+ i 1) (and ok (>= v 0) (<= v 1))))))))
(test-group "ease-named"
- (test-equal "quad-in-out proc" ease-quad-in-out (ease-named 'quad-in-out)))
+ (test "quad-in-out proc" ease-quad-in-out (ease-named 'quad-in-out)))
(test-group "ease-resolve"
- (test-equal "symbol" ease-cubic-out (ease-resolve 'cubic-out))
- (test-equal "procedure passthrough" ease-linear (ease-resolve ease-linear)))
+ (test "symbol" ease-cubic-out (ease-resolve 'cubic-out))
+ (test "procedure passthrough" ease-linear (ease-resolve ease-linear)))
(test-group "make-tween / tween-step"
(test-group "linear completes to target"
@@ -44,18 +44,18 @@
(tw (make-tween ent props: '((#:x . 100)) duration: 100 delay: 0 ease: 'linear)))
(receive (tw2 e2) (tween-step tw ent 100)
(test-assert "finished" (tween-finished? tw2))
- (test-equal "x at end" 100.0 (entity-ref e2 #:x))
- (test-equal "y preserved" 10 (entity-ref e2 #:y)))))
+ (test "x at end" 100.0 (entity-ref e2 #:x))
+ (test "y preserved" 10 (entity-ref e2 #:y)))))
(test-group "delay holds props"
(let* ((ent (entity #:type 'a #:x 0))
(tw (make-tween ent props: '((#:x . 50)) duration: 100 delay: 40 ease: 'linear)))
(receive (tw2 e2) (tween-step tw ent 30)
(test-assert "not finished" (not (tween-finished? tw2)))
- (test-equal "x unchanged during delay" 0 (entity-ref e2 #:x))
+ (test "x unchanged during delay" 0 (entity-ref e2 #:x))
(receive (tw3 e3) (tween-step tw2 e2 9)
(test-assert "still in delay at 39ms" (not (tween-finished? tw3)))
- (test-equal "x still 0" 0 (entity-ref e3 #:x))
+ (test "x still 0" 0 (entity-ref e3 #:x))
(receive (_tw4 e4) (tween-step tw3 e3 50)
(test-assert "past delay, moved" (> (entity-ref e4 #:x) 0)))))))
@@ -63,7 +63,7 @@
(let* ((ent (entity #:type 'a #:x 0))
(tw (make-tween ent props: '((#:x . 100)) duration: 100 delay: 0 ease: 'linear)))
(receive (_ e2) (tween-step tw ent 50)
- (test-equal "halfway x" 50.0 (entity-ref e2 #:x)))))
+ (test "halfway x" 50.0 (entity-ref e2 #:x)))))
(test-group "on-complete runs once"
(let ((calls 0))
@@ -71,10 +71,10 @@
(tw (make-tween ent props: '((#:x . 10)) duration: 10 delay: 0 ease: 'linear
on-complete: (lambda (_) (set! calls (+ calls 1))))))
(receive (tw2 e2) (tween-step tw ent 10)
- (test-equal "one call" 1 calls)
+ (test "one call" 1 (begin calls))
(receive (tw3 e3) (tween-step tw2 e2 5)
- (test-equal "still one call" 1 calls)
- (test-equal "entity stable" e3 e2))))))
+ (test "still one call" 1 (begin calls))
+ (test "entity stable" e3 (begin e2)))))))
(test-group "idempotent after finish"
(let* ((ent (entity #:type 'a #:x 0))
@@ -82,7 +82,7 @@
(receive (tw2 e2) (tween-step tw ent 10)
(receive (tw3 e3) (tween-step tw2 e2 999)
(test-assert (tween-finished? tw3))
- (test-equal "x stays" 20.0 (entity-ref e3 #:x)))))))
+ (test "x stays" 20.0 (entity-ref e3 #:x)))))))
(test-group "repeat"
(test-group "repeat: 1 plays twice"
@@ -91,10 +91,10 @@
ease: 'linear repeat: 1)))
(receive (tw2 e2) (tween-step tw ent 100)
(test-assert "not finished after first play" (not (tween-finished? tw2)))
- (test-equal "x at target" 100.0 (entity-ref e2 #:x))
+ (test "x at target" 100.0 (entity-ref e2 #:x))
(receive (tw3 e3) (tween-step tw2 e2 100)
(test-assert "finished after second play" (tween-finished? tw3))
- (test-equal "x at target again" 100.0 (entity-ref e3 #:x))))))
+ (test "x at target again" 100.0 (entity-ref e3 #:x))))))
(test-group "repeat: -1 never finishes"
(let* ((ent (entity #:type 'a #:x 0))
@@ -119,9 +119,9 @@
ease: 'linear repeat: 1
on-complete: (lambda (_) (set! calls (+ calls 1))))))
(receive (tw2 e2) (tween-step tw ent 10)
- (test-equal "no call after first play" 0 calls)
+ (test "no call after first play" 0 (begin calls))
(receive (tw3 e3) (tween-step tw2 e2 10)
- (test-equal "one call after last repeat" 1 calls))))))
+ (test "one call after last repeat" 1 (begin calls)))))))
(test-group "on-complete does not fire with repeat: -1"
(let ((calls 0))
@@ -130,7 +130,7 @@
ease: 'linear repeat: -1
on-complete: (lambda (_) (set! calls (+ calls 1))))))
(let loop ((tw tw) (ent ent) (i 0))
- (if (>= i 5) (test-equal "never called" 0 calls)
+ (if (>= i 5) (test "never called" 0 (begin calls))
(receive (tw2 e2) (tween-step tw ent 10)
(loop tw2 e2 (+ i 1)))))))))
@@ -140,12 +140,12 @@
(tw (make-tween ent props: '((#:x . 100)) duration: 100
ease: 'linear repeat: 1 yoyo?: #t)))
(receive (tw2 e2) (tween-step tw ent 100)
- (test-equal "x at target after forward" 100.0 (entity-ref e2 #:x))
+ (test "x at target after forward" 100.0 (entity-ref e2 #:x))
(receive (tw3 e3) (tween-step tw2 e2 50)
- (test-equal "x halfway back" 50.0 (entity-ref e3 #:x))
+ (test "x halfway back" 50.0 (entity-ref e3 #:x))
(receive (tw4 e4) (tween-step tw3 e3 50)
(test-assert "finished after reverse" (tween-finished? tw4))
- (test-equal "x back to start" 0.0 (entity-ref e4 #:x)))))))
+ (test "x back to start" 0.0 (entity-ref e4 #:x)))))))
(test-group "yoyo: #t with repeat: -1 ping-pongs forever"
(let* ((ent (entity #:type 'a #:x 0))
@@ -153,13 +153,13 @@
ease: 'linear repeat: -1 yoyo?: #t)))
;; Forward
(receive (tw2 e2) (tween-step tw ent 100)
- (test-equal "at target" 100.0 (entity-ref e2 #:x))
+ (test "at target" 100.0 (entity-ref e2 #:x))
;; Reverse
(receive (tw3 e3) (tween-step tw2 e2 100)
- (test-equal "back to start" 0.0 (entity-ref e3 #:x))
+ (test "back to start" 0.0 (entity-ref e3 #:x))
;; Forward again
(receive (tw4 e4) (tween-step tw3 e3 100)
- (test-equal "at target again" 100.0 (entity-ref e4 #:x))
+ (test "at target again" 100.0 (entity-ref e4 #:x))
(test-assert "still active" (tween-active? tw4)))))))
(test-group "yoyo: #f with repeat: 1 replays same direction"
@@ -167,7 +167,7 @@
(tw (make-tween ent props: '((#:x . 100)) duration: 100
ease: 'linear repeat: 1 yoyo?: #f)))
(receive (tw2 e2) (tween-step tw ent 100)
- (test-equal "x at target" 100.0 (entity-ref e2 #:x))
+ (test "x at target" 100.0 (entity-ref e2 #:x))
;; Second play starts from same starts (0→100), but entity is at 100
;; The tween replays 0→100 using original start values
(receive (tw3 e3) (tween-step tw2 e2 50)
@@ -179,7 +179,7 @@
ease: 'linear repeat: 0 yoyo?: #t)))
(receive (tw2 e2) (tween-step tw ent 100)
(test-assert "finishes normally" (tween-finished? tw2))
- (test-equal "x at target" 100.0 (entity-ref e2 #:x))))))
+ (test "x at target" 100.0 (entity-ref e2 #:x))))))
(test-group "step-tweens pipeline"
(test-group "advances #:tween on entity"
@@ -187,7 +187,7 @@
#:tween (make-tween (entity #:x 0) props: '((#:x . 100))
duration: 100 ease: 'linear)))
(e2 (step-tweens #f ent 50)))
- (test-equal "x moved to midpoint" 50.0 (entity-ref e2 #:x))
+ (test "x moved to midpoint" 50.0 (entity-ref e2 #:x))
(test-assert "tween still attached" (entity-ref e2 #:tween #f))))
(test-group "removes #:tween when finished"
@@ -195,20 +195,20 @@
#:tween (make-tween (entity #:x 0) props: '((#:x . 100))
duration: 100 ease: 'linear)))
(e2 (step-tweens #f ent 100)))
- (test-equal "x at target" 100.0 (entity-ref e2 #:x))
- (test-equal "tween removed" #f (entity-ref e2 #:tween #f))))
+ (test "x at target" 100.0 (entity-ref e2 #:x))
+ (test "tween removed" #f (entity-ref e2 #:tween #f))))
(test-group "no-op without #:tween"
(let* ((ent (entity #:type 'a #:x 42))
(e2 (step-tweens #f ent 100)))
- (test-equal "x unchanged" 42 (entity-ref e2 #:x))))
+ (test "x unchanged" 42 (entity-ref e2 #:x))))
(test-group "keeps repeating tween attached"
(let* ((ent (entity #:type 'a #:x 0
#:tween (make-tween (entity #:x 0) props: '((#:x . 100))
duration: 100 ease: 'linear repeat: -1 yoyo?: #t)))
(e2 (step-tweens #f ent 100)))
- (test-equal "x at target" 100.0 (entity-ref e2 #:x))
+ (test "x at target" 100.0 (entity-ref e2 #:x))
(test-assert "tween still attached (repeating)" (entity-ref e2 #:tween #f))))
(test-group "respects #:skip-pipelines"
@@ -217,7 +217,8 @@
#:tween (make-tween (entity #:x 0) props: '((#:x . 100))
duration: 100 ease: 'linear)))
(e2 (step-tweens #f ent 100)))
- (test-equal "x unchanged (skipped)" 0 (entity-ref e2 #:x))
+ (test "x unchanged (skipped)" 0 (entity-ref e2 #:x))
(test-assert "tween still there" (entity-ref e2 #:tween #f)))))
(test-end "tween")
+(test-exit)