Coverage report: /home/ellis/comp/core/std/tests/thread.lisp

KindCoveredAll%
expression06 0.0
branch00nil
Key
Not instrumented
Conditionalized out
Executed
Not executed
 
Both branches taken
One branch taken
Neither branch taken
1
 ;;; thread.lisp --- Thread Tests
2
 
3
 ;; 
4
 
5
 ;;; Code:
6
 (in-package :std/tests)
7
 (in-suite :std)
8
 
9
 (deftest with-threads ()
10
   "Test with-threads macro."
11
   (with-threads (i 4 :args (&optional (a 0) (b 1) (c 2)))
12
     (is (= 3 (+ a b c)))))
13
 
14
 (deftest threads ()
15
   "Test standard thread functionality."
16
   (is (eq *current-thread*
17
           (find (thread-name *current-thread*) (list-all-threads)
18
                 :key #'thread-name :test #'equal)))
19
   (is (find-thread-by-id (car (thread-id-list))))
20
   (is (not (zerop (thread-count))))
21
   (let ((threads
22
           (make-threads 4 (lambda () (is (= 42 (1+ 41)))) :name "threads")))
23
     (loop for th in threads
24
           do (sb-thread:join-thread th))
25
     (loop for th in threads
26
           collect (is (not (sb-thread:thread-alive-p th)))))
27
   (let ((m (make-mutex :name "mutex-test")))
28
     (is
29
      (and (not
30
            (with-mutex (m)
31
              (join-thread
32
               (make-thread (lambda ()
33
                              (with-mutex (m :timeout 0.1)
34
                                t))))))
35
           (join-thread
36
            (make-thread (lambda ()
37
                           (with-mutex (m :timeout 0.1)
38
                             t)))))))
39
   (let* ((sym (gensym))
40
          (s (make-semaphore :name "semaphore-test"))
41
          (th (make-thread (lambda () (wait-on-semaphore s)))))
42
     (is (equal (multiple-value-list (join-thread th :timeout .001 :default sym))
43
                (list sym :timeout)))
44
     (signal-semaphore s)
45
     (is (join-thread th)))
46
   (signals join-thread-error (join-thread *current-thread*))
47
   (is
48
    (let ((m (make-mutex :name "rlock-test")))
49
      (is (not (with-mutex (m) (join-thread (make-thread (lambda () (with-recursive-lock (m :wait-p nil) t)))))))
50
      (join-thread (make-thread (lambda () (with-recursive-lock (m :wait-p nil) t))))))
51
   (let ((queue (make-waitqueue :name "queue-test"))
52
         (lock (make-mutex :name "lock-test"))
53
         (n 0)
54
         th)
55
     (labels ((in-new-thread ()
56
                (with-mutex (lock)
57
                  (assert (eql (mutex-owner lock) *current-thread*))
58
                  (condition-wait queue lock)
59
                  (assert (eql (mutex-owner lock) *current-thread*))
60
                  (is (= n 1))
61
                  (decf n))))
62
       (setf th (make-thread #'in-new-thread))
63
       (sleep 1)
64
       (is (null (mutex-owner lock)))
65
       (with-mutex (lock)
66
         (incf n)
67
         (condition-notify queue))
68
       (is (= 0 (join-thread th))))))
69
 
70
 (deftest timers ()
71
   "Test various timer functionality."
72
   (sb-int:with-progressive-timeout (ttl :seconds 1)
73
     (sleep 0.001)
74
     (is (/= (ttl) 1))))
75
 
76
 (deftest thread-pool ()
77
   "Test THREAD-POOLs."
78
   (let ((tp (make-thread-pool 8)))
79
     (istype '(array worker) (workers tp))
80
     (is= 8 (length (workers tp)))
81
     (istype 'thread-pool tp)))
82