Migrate tests to the test egg

1 files changed, 36 insertions, 35 deletions

diff --git a/tests/prefabs-test.scm b/tests/prefabs-test.scm
index ab7b5f1..8eaf348 100644
--- a/tests/prefabs-test.scm
+++ b/tests/prefabs-test.scm
@@ -5,7 +5,7 @@
         (chicken port)
 	(chicken pretty-print)
         defstruct
-        srfi-64)
+        test)
 
 ;; Mock downstroke-entity
 (module downstroke-entity *
@@ -42,14 +42,14 @@
     (test-assert "animated entry exists"     (assq 'animated m))
 
     (let ((pb (cdr (assq 'physics-body m))))
-      (test-equal "physics-body has #:vx 0"       0   (cadr (memq #:vx pb)))
-      (test-equal "physics-body has #:gravity? #t" #t  (cadr (memq #:gravity? pb)))
-      (test-equal "physics-body has #:on-ground? #f" #f (cadr (memq #:on-ground? pb))))
+      (test "physics-body has #:vx 0"       0   (cadr (memq #:vx pb)))
+      (test "physics-body has #:gravity? #t" #t  (cadr (memq #:gravity? pb)))
+      (test "physics-body has #:on-ground? #f" #f (cadr (memq #:on-ground? pb))))
 
     (let ((an (cdr (assq 'animated m))))
-      (test-equal "animated has #:anim-tick 0" 0 (cadr (memq #:anim-tick an)))
-      (test-equal "animated has #:tile-id 0"   0 (cadr (memq #:tile-id an)))
-      (test-equal "animated has #:anim-name idle" 'idle (cadr (memq #:anim-name an))))))
+      (test "animated has #:anim-tick 0" 0 (cadr (memq #:anim-tick an)))
+      (test "animated has #:tile-id 0"   0 (cadr (memq #:tile-id an)))
+      (test "animated has #:anim-name idle" 'idle (cadr (memq #:anim-name an))))))
 
 (test-group "compose-prefab (via load-prefabs with temp file)"
 
@@ -67,11 +67,11 @@
         ;; Inline #:vx 99 beats mixin #:vx 5
         (let ((e (instantiate-prefab reg 'runner 0 0 16 16)))
 	  (pp e)
-	  (test-equal "entity should have squashed properties" 7 (length e))
-          (test-equal "inline field beats mixin field for same key"
+	  (test "entity should have squashed properties" 7 (length e))
+          (test "inline field beats mixin field for same key"
             99
             (entity-ref e #:vx))
-          (test-equal "mixin field present when not overridden"
+          (test "mixin field present when not overridden"
             0
             (entity-ref e #:vy))))))
 
@@ -82,7 +82,7 @@
       (lambda (reg)
         ;; m1 listed before m2 → m1's #:key wins
         (let ((e (instantiate-prefab reg 'thing 0 0 8 8)))
-          (test-equal "earlier mixin wins over later mixin for same key"
+          (test "earlier mixin wins over later mixin for same key"
             'first
             (entity-ref e #:key))))))
 
@@ -93,7 +93,7 @@
       (lambda (reg)
         ;; User redefined physics-body → user's version wins
         (let ((e (instantiate-prefab reg 'custom-obj 0 0 16 16)))
-          (test-equal "user-redefined mixin key overrides engine default"
+          (test "user-redefined mixin key overrides engine default"
             77
             (entity-ref e #:vx))))))
 
@@ -120,13 +120,13 @@
         (not (instantiate-prefab reg 'unknown 0 0 8 8)))
 
       (let ((e (instantiate-prefab reg 'box 10 20 32 48)))
-        (test-equal "instance #:x is set"    10  (entity-ref e #:x))
-        (test-equal "instance #:y is set"    20  (entity-ref e #:y))
-        (test-equal "instance #:width is set"  32  (entity-ref e #:width))
-        (test-equal "instance #:height is set" 48  (entity-ref e #:height))
-        (test-equal "prefab field #:type present" 'box (entity-ref e #:type))
-        (test-equal "mixin field #:vx present"  0  (entity-ref e #:vx))
-        (test-equal "mixin field #:gravity? present" #t (entity-ref e #:gravity?))))))
+        (test "instance #:x is set"    10  (entity-ref e #:x))
+        (test "instance #:y is set"    20  (entity-ref e #:y))
+        (test "instance #:width is set"  32  (entity-ref e #:width))
+        (test "instance #:height is set" 48  (entity-ref e #:height))
+        (test "prefab field #:type present" 'box (entity-ref e #:type))
+        (test "mixin field #:vx present"  0  (entity-ref e #:vx))
+        (test "mixin field #:gravity? present" #t (entity-ref e #:gravity?))))))
 
 (test-group "hooks"
   (define (with-hook-registry extra-prefabs user-hooks thunk)
@@ -151,7 +151,7 @@
                   user-hooks:         '()
                   hook-table:         '())))
       (let ((e (instantiate-prefab reg 'proc-hooked 0 0 8 8)))
-        (test-equal "procedure hook fires and sets #:proc-fired"
+        (test "procedure hook fires and sets #:proc-fired"
           #t
           (entity-ref e #:proc-fired)))))
 
@@ -162,7 +162,7 @@
       `((my-hook . ,(lambda (e) (entity-set e #:initialized #t))))
       (lambda (reg)
         (let ((e (instantiate-prefab reg 'hooked 0 0 8 8)))
-          (test-equal "user hook sets #:initialized"
+          (test "user hook sets #:initialized"
             #t
             (entity-ref e #:initialized))))))
 
@@ -176,7 +176,7 @@
       (let ((reg (load-prefabs tmp (engine-mixins)
                    `((init-npc . ,(lambda (e) (entity-set e #:ai-machine 'from-user-hook)))))))
         (let ((e (instantiate-prefab reg 'npc 0 0 16 16)))
-          (test-equal "user hook sets #:ai-machine"
+          (test "user hook sets #:ai-machine"
             'from-user-hook
             (entity-ref e #:ai-machine))))))
 
@@ -186,7 +186,7 @@
       '()
       (lambda (reg)
         (let ((e (instantiate-prefab reg 'plain 0 0 8 8)))
-          (test-equal "no hook: type is plain" 'plain (entity-ref e #:type))))))
+          (test "no hook: type is plain" 'plain (entity-ref e #:type))))))
 
   (test-group "unknown hook symbol raises error"
     (test-error
@@ -209,9 +209,9 @@
                 (display "((mixins) (prefabs (box #:type box #:value 42)))"))))
          (reg2 (reload-prefabs! reg1))
          (e2   (instantiate-prefab reg2 'box 0 0 8 8)))
-    (test-equal "original registry has #:value 1"  1  (entity-ref e1 #:value))
-    (test-equal "reloaded registry has #:value 42" 42 (entity-ref e2 #:value))
-    (test-equal "original registry unchanged after reload" 1 (entity-ref e1 #:value))))
+    (test "original registry has #:value 1"  1  (entity-ref e1 #:value))
+    (test "reloaded registry has #:value 42" 42 (entity-ref e2 #:value))
+    (test "original registry unchanged after reload" 1 (entity-ref e1 #:value))))
 
 (test-group "group-prefabs"
   (define (with-group-prefab-data str thunk)
@@ -229,17 +229,17 @@
       (test-assert "instantiate-group-prefab unknown → #f"
         (not (instantiate-group-prefab reg 'nope 0 0)))
       (let ((lst (instantiate-group-prefab reg 'two-block 100 50)))
-        (test-equal "returns list of origin + 2 members" 3 (length lst))
+        (test "returns list of origin + 2 members" 3 (length lst))
         (let ((origin (car lst))
               (a (cadr lst))
               (b (caddr lst)))
-          (test-equal "pose-only origin skip-render" #t (entity-ref origin #:skip-render))
-          (test-equal "origin group-origin?" #t (entity-ref origin #:group-origin?))
-          (test-equal "member a world x" 100 (entity-ref a #:x))
-          (test-equal "member b world x" 110 (entity-ref b #:x))
-          (test-equal "member a local x" 0 (entity-ref a #:group-local-x))
-          (test-equal "member b local x" 10 (entity-ref b #:group-local-x))
-          (test-equal "shared group-id" (entity-ref origin #:group-id) (entity-ref a #:group-id))))))
+          (test "pose-only origin skip-render" #t (entity-ref origin #:skip-render))
+          (test "origin group-origin?" #t (entity-ref origin #:group-origin?))
+          (test "member a world x" 100 (entity-ref a #:x))
+          (test "member b world x" 110 (entity-ref b #:x))
+          (test "member a local x" 0 (entity-ref a #:group-local-x))
+          (test "member b local x" 10 (entity-ref b #:group-local-x))
+          (test "shared group-id" (entity-ref origin #:group-id) (entity-ref a #:group-id))))))
 
   (with-group-prefab-data
     "((mixins) (prefabs)
@@ -248,8 +248,9 @@
           #:parts ((#:local-x 0 #:local-y 0 #:width 4 #:height 4 #:tile-id 1)))))"
     (lambda (reg)
       (let ((origin (car (instantiate-group-prefab reg 'falling-asm 0 0))))
-        (test-equal "physics origin has gravity" #t (entity-ref origin #:gravity?))
+        (test "physics origin has gravity" #t (entity-ref origin #:gravity?))
         (test-assert "physics origin has no #:skip-pipelines (pipelines run)"
           (eq? 'absent (entity-ref origin #:skip-pipelines 'absent)))))))
 
 (test-end "prefabs")
+(test-exit)