7 files changed, 82 insertions(+), 75 deletions(-)

M hardwood.meta
M hardwood.wiki
M tests/monitors.scm
M tests/ping.scm
M tests/rpc.scm
M tests/run.scm
M tests/spam.scm

@@ 3,4 3,5 @@
  (files "hardwood.setup" "hardwood.meta" "hardwood-impl.scm" "hardwood.scm")
  (license "BSD")
  (category hell)
- (needs matchable uuid))
+ (needs matchable uuid)
+ (test-depends test))

@@ 262,6 262,7 @@ in the following examples.
 
 == Version History
 
+; 0.4 : Bug fixes, tests now use the [[test]] egg
 ; 0.3 : Bug fix; `!!` function; spawn accepts procedure arguments; monitor references
 ; 0.2 : Implement process monitoring
 ; 0.1 : Initial release

@@ 1,44 1,39 @@
-(define (monitors-test)
-  (recv
-    ('crash  (abort 'some-condition))
-    ('exit  (void))))
+(test-group "Monitors"
 
-(define pid1 (spawn monitors-test))
-(define pid2 (spawn monitors-test))
-(define pid3 (spawn monitors-test))
+  (define (monitors-test)
+    (recv
+      ('crash  (abort 'some-condition))
+      ('exit  (void))))
 
-(define ref1 (monitor pid1))
-(define ref2 (monitor pid2))
-(define ref3 (monitor pid3))
+  (define pid1 (spawn monitors-test))
+  (define pid2 (spawn monitors-test))
+  (define pid3 (spawn monitors-test))
 
-; Normal exit
-(! pid1 'exit)
-(assert
-  (recv
-    (('DOWN ref pid 'exited)  (and (equal? ref ref1)
-                                   (equal? pid pid1)))
-    (else  #f)
-    (after 1 #f)))
+  (define ref1 (monitor pid1))
+  (define ref2 (monitor pid2))
+  (define ref3 (monitor pid3))
 
-; Excptional exit
-(! pid2 'crash)
-(assert
-  (recv
-    (('DOWN ref pid ('condition 'some-condition))  (and (equal? ref ref2)
-                                                        (equal? pid pid2)))
-    (else  #f)
-    (after 1 #f)))
+  ; Normal exit
+  (! pid1 'exit)
+  (test "normal exit"
+    (list 'DOWN ref1 pid1 'exited)
+    (? 1 #f))
 
-; Demonitoring
-(demonitor ref3)
-(! pid3 'exit)
-(assert (? 0.2 #t))
+  ; Excptional exit
+  (! pid2 'crash)
+  (test "exit with condition"
+    (list 'DOWN ref2 pid2 (list 'condition 'some-condition))
+    (? 1 #f))
 
-; Dead process
-(define ref4 (monitor pid1))
-(assert
-  (recv
-    (('DOWN ref pid 'no-process)  (and (equal? ref ref4)
-                                       (equal? pid pid1)))
-    (else  #f)
-    (after 1 #f)))
+  ; Demonitoring
+  (demonitor ref3)
+  (! pid3 'exit)
+  (test "demonitoring"
+    #t
+    (? 0.2 #t))
+
+  ; Dead process
+  (define ref4 (monitor pid1))
+  (test "dead process"
+    (list 'DOWN ref4 pid1 'no-process)
+    (? 1 #f)))

@@ 1,12 1,15 @@
 ; Ping-pong test
-(define (pong-server)
-  (recv
-    (((? pid? pid) 'ping)  (! pid 'pong)
+
+(test-group "Ping"
+
+  (define (pong-server)
+    (recv
+      (((? pid? pid) 'ping)  (! pid 'pong)
                            (pong-server))
-    (else  (pong-server))))
+      (else  (pong-server))))
 
-(define pong (spawn pong-server))
+  (define pong (spawn pong-server))
 
-(! pong `(,(self) ping))
-(assert (eqv? (?? any? 1 'fail) 'pong))
+  (! pong `(,(self) ping))
+  (test 'pong (? 1 #f)))
 

@@ 1,13 1,17 @@
 ; Synchronous messaging test
-(define rpc-server
-  (spawn
-    (lambda ()
-      (let loop ()
-        (recv
-          ((from tag ('add a b))
-           (! from (list tag (+ a b)))))
-        (loop)))))
 
-(! (self) (list (make-tag) 0))
-(assert (= (!? rpc-server '(add 21 21)) 42))
-(?)
+(test-group "RPC"
+  (define rpc-server
+    (spawn
+      (lambda ()
+        (let loop ()
+          (recv
+            ((from tag ('add a b))
+             (! from (list tag (+ a b)))))
+          (loop)))))
+
+  (define wrong-msg (list (make-tag) 0))
+  (! (self) wrong-msg)
+
+  (test 42 (!? rpc-server '(add 21 21) 1 #f))
+  (test wrong-msg (? 1 #f)))

@@ 1,4 1,4 @@
-(use hardwood)
+(use test hardwood)
 
 (setup-thread (current-thread))
 


@@ 6,3 6,5 @@
 (load "rpc")
 (load "spam")
 (load "monitors")
+
+(test-exit)

@@ 1,23 1,24 @@
 ; Lots-of-threads-and-messages test
-(define primordial (self))
-(define message-number 100)
-(define thread-number 100)
 
-(define (spam)
-  (let loop ((i message-number))
-    (unless (zero? i)
-      (! primordial i)
-      (loop (sub1 i)))))
+(test-group "Spam"
+  (define message-number 100)
+  (define thread-number 100)
+
+  (define (spam who)
+    (let loop ((i message-number))
+      (unless (zero? i)
+        (! who i)
+        (loop (sub1 i)))))
 
-(let loop ((i thread-number))
-  (unless (zero? i)
-    (spawn spam)
-    (loop (sub1 i))))
+  (let loop ((i thread-number))
+    (unless (zero? i)
+      (spawn spam (self))
+      (loop (sub1 i))))
 
-(let loop ((i (* thread-number message-number)))
-  (unless (zero? i)
-    (?)
-    (loop (sub1 i))))
+  (let loop ((i (* thread-number message-number)))
+    (unless (zero? i)
+      (?)
+      (loop (sub1 i))))
 
-(assert (not (? 1 #f)))
+  (test 'ok (? 1 'ok)))