tests/bug-1180102.impure.lisp

   1 (use-package "SB-THREAD")
   2
   3 ;; SB-THREAD:MAKE-THREAD used to lock SB-THREAD:*MAKE-THREAD-LOCK*
   4 ;; before entering WITHOUT-INTERRUPTS. When a thread which was
   5 ;; executing SB-THREAD:MAKE-THREAD was interrupted with code which
   6 ;; also called SB-THREAD:MAKE-THREAD, it could happen that the first
   7 ;; thread already owned SB-THREAD:*MAKE-THREAD-LOCK* and the
   8 ;; interrupting code thus made a recursive lock attempt.
   9
  10 ;; This test runs excruciatingly slowly on win32 without futexes.
  11 ;; Using n-threads = 100 with sb-futex, each trial took between .1 and .2
  12 ;; seconds, so 200 trials took ~ 30 seconds.
  13 ;; Without sb-futex and that same number of threads, each trial took
  14 ;; between 1.5 and 2.5 seconds which would be 400 seconds total.
  15 (defparameter *test-params* (or #+(and win32 (not sb-futex)) '(10 . 20)
  16                                 '(100 . 100)))
  17
  18 (with-test (:name (:timer :dispatch-thread :make-thread :bug-1180102)
  19             :skipped-on (not :sb-thread))
  20   (flet ((test (thread)
  21            (let ((timer (make-timer (lambda ()) :thread thread)))
  22              (schedule-timer timer .01 :repeat-interval 0.1)
  23              (dotimes (i (car *test-params*))
  24                (let ((threads '())
  25                      (start (get-internal-real-time)))
  26                  (declare (ignorable start))
  27                  (dotimes (i (cdr *test-params*))
  28                    (push (sb-thread:make-thread (lambda () (sleep .01)))
  29                          threads))
  30                  (mapc #'sb-thread:join-thread threads)
  31                  #+nil (format t "Trial ~d: ~f sec~%" i
  32                                (/ (- (get-internal-real-time) start)
  33                                   internal-time-units-per-second))))
  34              (unschedule-timer timer))))
  35     (test t)
  36     (test sb-thread:*current-thread*)))
  37
  38 (with-test (:name (:make-thread :interrupt-with :make-thread :bug-1180102)
  39             :skipped-on (not :sb-thread)
  40             :broken-on :sb-safepoint)
  41   (fresh-line)
  42   (write-string "; ")
  43   (force-output)
  44   (dotimes (i 100)
  45     (let (outer-threads
  46           (inner-threads (list nil))
  47           (parent *current-thread*))
  48       (dotimes (i 100)
  49         (push (make-thread
  50                (lambda ()
  51                  (interrupt-thread
  52                   parent
  53                   (lambda () (atomic-push (make-thread (lambda ()))
  54                                           (car inner-threads))))))
  55               outer-threads)
  56         (push (make-thread (lambda ())) outer-threads))
  57       (mapc #'join-thread outer-threads)
  58       (mapc #'join-thread (car inner-threads)))
  59     (write-char #\.)
  60     (force-output)))