Add a few more tests
authorStelian Ionescu <sionescu@cddr.org>
Fri, 15 Mar 2013 23:37:00 +0000 (00:37 +0100)
committerStelian Ionescu <sionescu@cddr.org>
Fri, 15 Mar 2013 23:42:36 +0000 (00:42 +0100)
test/bordeaux-threads-test.lisp

index 94bfb18..ec3d819 100644 (file)
@@ -19,6 +19,16 @@ Distributed under the MIT license (see LICENSE file)
 (test should-have-current-thread
   (is (current-thread)))
 
+(test current-thread-identity
+  (let* ((box (list nil))
+         (thread (make-thread (lambda ()
+                                (setf (car box) (current-thread))))))
+    (join-thread thread)
+    (is (eql (car box) thread))))
+
+(test join-thread-return-value
+  (is (eql 0 (join-thread (make-thread (lambda () 0))))))
+
 (test should-identify-threads-correctly
   (is (threadp (current-thread)))
   (is (threadp (make-thread (lambda () t) :name "foo")))
@@ -27,6 +37,19 @@ Distributed under the MIT license (see LICENSE file)
 (test should-retrieve-thread-name
   (is (equal "foo" (thread-name (make-thread (lambda () t) :name "foo")))))
 
+(test interrupt-thread
+  (let* ((box (list nil))
+         (thread (make-thread (lambda ()
+                                (setf (car box)
+                                      (catch 'new-thread
+                                        (sleep 60)
+                                        0))))))
+    (sleep 1)
+    (interrupt-thread thread (lambda ()
+                               (throw 'new-thread 1)))
+    (join-thread thread)
+    (is (eql 1 (car box)))))
+
 (test should-lock-without-contention
   (with-fixture using-lock ()
     (is (acquire-lock lock t))