find some bugs with good testing

Author: garlic0x1

test/basic.lisp

@@ -3,6 +3,7 @@
 (in-package #:thespis/test/basic)
 
 (deftest test-counter ()
+  "The most basic stateful usage."
   (define-actor counter ((c 0)) (increment)
     (incf c increment))
 
@@ -19,6 +20,7 @@
     (close-actor actor)))
 
 (deftest test-lambda-rest ()
+  "Make sure lambda lists work."
   (define-actor square-summer ((c 0)) (&rest args)
     (incf c (apply #'+ (mapcar (lambda (x) (* x x)) args))))
 
@@ -28,6 +30,7 @@
     (close-actor actor)))
 
 (deftest test-lambda-key ()
+  "Make sure lambda lists work."
   (define-actor point-actor ((x 0) (y 0) (z 0))
       (&key (dx 0) (dy 0) (dz 0))
     (list
@@ -43,6 +46,7 @@
     (close-actor actor)))
 
 (deftest test-multiple-values ()
+  "Return multiple values on join."
   (define-actor multivaluer ((prev 0)) (next)
     (multiple-value-prog1 (values prev next)
       (setf prev next)))
@@ -55,6 +59,7 @@
     (is (equal '(2 1) (multiple-value-list (join-actor actor))))))
 
 (deftest test-pong ()
+  "More complicated test, could be cleaner using the registry."
   (let (pinger ponger (result 0))
     (define-actor pinger () (c)
       (incf result)
@@ -77,6 +82,7 @@
     (is (= 11 result))))
 
 (deftest test-self ()
+  "Make sure the actor can see itself."
   (let ((result 0))
     (define-actor selfish-counter () ()
       (incf result)
@@ -90,6 +96,7 @@
       (is (= result 11)))))
 
 (deftest test-error-handling ()
+  "Custom error handling."
   (define-actor failer () (x)
     (/ 1 x))
 
@@ -101,44 +108,61 @@
     (close-actor actor)))
 
 (deftest test-closed-actor ()
+  "Sending messages to a closed actor signals an error."
   (define-actor closer () (x)
     x)
 
   (let ((actor (closer)))
     (close-actor actor)
-    (handler-case (send actor 'x)
-      (error (c) (is (typep c 'simple-error))))))
+    (signals simple-error
+      (send actor 'x))))
 
 (deftest test-redefine-actor ()
+  "Actors can change behavior while they are running."
   (define-actor counter ((c 0)) (increment)
     (incf c increment))
 
   (let ((actor (counter)))
     (ask actor 1)
+
     (define-actor counter ((c 0)) (increment)
       (incf c (1- increment)))
+
     (send actor 3)
     (is (= 3 (ask actor 1)))
+
     (define-actor counter ((c 32)) (increment times)
       (incf c (* times increment)))
+
     (is (= 10 (ask actor 1 7)))
     (close-actor actor)))
 
 (deftest test-registry ()
+  "Make sure the global registry works."
   (define-actor counter ((c 0)) (increment)
     (incf c increment))
 
   (counter :name :my-counter)
   (send :my-counter 1)
   (is (= 3 (ask :my-counter 2)))
-  (close-actor :my-counter))
+  (join-actor (close-actor :my-counter)))
 
 (deftest test-close-and-join ()
+  "Make sure we can join globally registered actors after we close them."
   (define-actor counter ((c 0)) (increment)
     (incf c increment))
 
   (counter :name :my-counter)
   (send :my-counter 1)
   (is (= 3 (ask :my-counter 2)))
   (close-and-join-actors :my-counter)
-  (is (eql nil (gethash :my-counter *registry*))))
+  (is (null (gethash :my-counter *registry*))))
+
+(deftest test-destroy ()
+  "Make sure destroy works on globally registered actors."
+  (define-actor echoer () (x) x)
+
+  (echoer :name :echoer)
+  (is (= 1 (ask :echoer 1)))
+  (destroy-actor :echoer)
+  (is (null (gethash :echoer *registry*))))

test/dispatcher.lisp

@@ -25,9 +25,10 @@
 
   (let ((actor (sleeper :workers 2)))
     (dotimes (i 5)
-      (send (first (thespis::dispatcher-workers actor)) 0.2))
-    (dotimes (i 20) (sleep 0.01) (send actor 0))
-    (is (equal '((5 20)) (close-and-join-actors actor)))))
+      (send (first (thespis::dispatcher-workers actor)) 5))
+    (dotimes (i 19) (sleep 0.001) (send actor 0))
+    (is (= 20 (ask actor 0)))
+    (destroy-actor actor)))
 
 (deftest test-dispatcher-registry ()
   "Test registering a dispatcher with a global name."
@@ -53,3 +54,57 @@
   (send :my-counter 1)
   (send :my-counter 1)
   (is (= 6 (reduce #'+ (join-actor (close-actor :my-counter))))))
+
+(deftest test-dispatcher-close-and-join ()
+  (define-actor counter ((c 0)) (increment)
+    (incf c increment)
+    (counter :name :my-counter)
+    (send :my-counter 1)
+    (close-and-join-actors :my-counter)
+    (is (eql nil (gethash :my-counter *registry*)))))
+
+(deftest test-closed-actor ()
+  "Sending messages to a closed dispatcher signals an error."
+  (define-actor closer () (x)
+    x)
+
+  (let ((actor (closer :workers 2)))
+    (close-actor actor)
+    (signals simple-error
+      (send actor 'x))))
+
+(deftest test-dispatcher-multiple-values ()
+  "Return multiple values on join."
+  (define-actor multivaluer ((prev 0)) (next)
+    (multiple-value-prog1 (values prev next)
+      (setf prev next))
+
+    (let ((actor (multivaluer :workers 2)))
+      (send actor 1)
+      (is (= 2 (length (multiple-value-list (ask actor 2)))))
+      (is (= 2 (length (multiple-value-list (ask actor 2)))))
+      (is (= 2 (length (multiple-value-list (ask actor 2)))))
+      (close-actor actor))))
+
+(deftest test-dispatcher-lambda-key ()
+  "Make sure lambda lists work."
+  (define-actor point-actor ((x 0) (y 0) (z 0))
+      (&key (dx 0) (dy 0) (dz 0))
+    (list
+     :x (incf x dx)
+     :y (incf y dy)
+     :z (incf z dz)))
+
+  (let ((actor (point-actor :workers 2)))
+    (is (equal '(:x -1 :y 0 :z 3) (ask actor :dx -1 :dz 3)))
+    (ask actor)
+    (close-and-join-actors actor)))
+
+(deftest test-dispatcher-destroy ()
+  "Make sure destroy works on globally registered dispatchers."
+  (define-actor echoer () (x) x)
+
+  (echoer :name :echoer)
+  (is (= 1 (ask :echoer 1)))
+  (destroy-actor :echoer)
+  (is (null (gethash :echoer *registry*))))

test/fuzz.lisp

@@ -8,7 +8,7 @@
          :thespis/test/basic
          :stream (make-broadcast-stream)))))
 
-(deftest fuzz-dispatcher-tests (&optional (times 8))
+(deftest fuzz-dispatcher-tests (&optional (times 4))
   "Don't try as many reps here because it is too slow."
   (dotimes (i times)
     (is (fiasco:run-tests

thespis.lisp

@@ -97,9 +97,10 @@
 (defgeneric destroy-actor (actor)
   (:documentation "Immediately destroy an actor's thread.")
   (:method ((actor actor))
-    (bt2:interrupt-thread (actor-thread actor)
-                          (lambda ()
-                            (signal (make-instance 'unregister)))))
+    (bt2:interrupt-thread
+     (actor-thread actor)
+     (lambda () (signal (make-instance 'unregister))))
+    (bt2:join-thread (actor-thread actor)))
   (:method ((actor dispatcher))
     (prog1 (mapcar #'destroy-actor (dispatcher-workers actor))
       (remhash (dispatcher-name actor) *registry*)))