tests/threads.pure.lisp

   1 ;;;; miscellaneous tests of thread stuff
   2
   3 ;;;; This software is part of the SBCL system. See the README file for
   4 ;;;; more information.
   5 ;;;;
   6 ;;;; While most of SBCL is derived from the CMU CL system, the test
   7 ;;;; files (like this one) were written from scratch after the fork
   8 ;;;; from CMU CL.
   9 ;;;
  10 ;;;; This software is in the public domain and is provided with
  11 ;;;; absoluely no warranty. See the COPYING and CREDITS files for
  12 ;;;; more information.
  13
  14 (in-package :cl-user)
  15
  16 (defpackage :thread-test
  17   (:use :cl :sb-thread :sb-ext))
  18
  19 (in-package :thread-test)
  20
  21 (use-package :test-util)
  22
  23 (with-test (:name atomic-update
  24             :skipped-on '(not :sb-thread))
  25   (let ((x (cons :count 0))
  26         (nthreads (ecase sb-vm:n-word-bits (32 100) (64 1000))))
  27     (mapc #'sb-thread:join-thread
  28           (loop repeat 1000
  29                 collect (sb-thread:make-thread
  30                          (lambda ()
  31                            (loop repeat nthreads
  32                                  do (atomic-update (cdr x) #'1+)
  33                                     (sleep 0.00001))))))
  34     (assert (equal x `(:count ,@(* 1000 nthreads))))))
  35
  36 (with-test (:name mutex-owner)
  37   ;; Make sure basics are sane on unithreaded ports as well
  38   (let ((mutex (make-mutex)))
  39     (grab-mutex mutex)
  40     (assert (eq *current-thread* (mutex-value mutex)))
  41     (handler-bind ((warning #'error))
  42       (release-mutex mutex))
  43     (assert (not (mutex-value mutex)))))
  44
  45 ;;; Terminating a thread that's waiting for the terminal.
  46
  47 #+sb-thread
  48 (let ((thread (make-thread (lambda ()
  49                              (sb-thread::get-foreground)))))
  50   (sleep 1)
  51   (assert (thread-alive-p thread))
  52   (terminate-thread thread)
  53   (sleep 1)
  54   (assert (not (thread-alive-p thread))))
  55
  56 ;;; Condition-wait should not be interruptible under WITHOUT-INTERRUPTS
  57
  58 (with-test (:name without-interrupts+condition-wait
  59             :skipped-on '(not :sb-thread))
  60   (let* ((lock (make-mutex))
  61          (queue (make-waitqueue))
  62          (thread (make-thread (lambda ()
  63                                 (sb-sys:without-interrupts
  64                                   (with-mutex (lock)
  65                                     (condition-wait queue lock)))))))
  66     (sleep 1)
  67     (assert (thread-alive-p thread))
  68     (terminate-thread thread)
  69     (sleep 1)
  70     (assert (thread-alive-p thread))
  71     (condition-notify queue)
  72     (sleep 1)
  73     (assert (not (thread-alive-p thread)))))
  74
  75 ;;; GRAB-MUTEX should not be interruptible under WITHOUT-INTERRUPTS
  76
  77 (with-test (:name without-interrupts+grab-mutex :skipped-on '(not :sb-thread))
  78   (let* ((lock (make-mutex))
  79          (bar (progn (grab-mutex lock) nil))
  80          (thread (make-thread (lambda ()
  81                                 (sb-sys:without-interrupts
  82                                     (with-mutex (lock)
  83                                       (setf bar t)))))))
  84     (sleep 1)
  85     (assert (thread-alive-p thread))
  86     (terminate-thread thread)
  87     (sleep 1)
  88     (assert (thread-alive-p thread))
  89     (release-mutex lock)
  90     (sleep 1)
  91     (assert (not (thread-alive-p thread)))
  92     (assert (eq :aborted (join-thread thread :default :aborted)))
  93     (assert bar)))
  94
  95 (with-test (:name parallel-find-class :skipped-on '(not :sb-thread))
  96   (let* ((oops nil)
  97          (threads (loop repeat 10
  98                         collect (make-thread (lambda ()
  99                                                (handler-case
 100                                                    (loop repeat 10000
 101                                                          do (find-class (gensym) nil))
 102                                                  (serious-condition ()
 103                                                    (setf oops t))))))))
 104     (mapcar #'sb-thread:join-thread threads)
 105     (assert (not oops))))
 106
 107 (with-test (:name :semaphore-multiple-waiters :skipped-on '(not :sb-thread))
 108   (let ((semaphore (make-semaphore :name "test sem")))
 109     (labels ((make-readers (n i)
 110                (values
 111                 (loop for r from 0 below n
 112                       collect
 113                       (sb-thread:make-thread
 114                        (lambda ()
 115                          (let ((sem semaphore))
 116                            (dotimes (s i)
 117                              (sb-thread:wait-on-semaphore sem))))
 118                        :name "reader"))
 119                 (* n i)))
 120              (make-writers (n readers i)
 121                (let ((j (* readers i)))
 122                  (multiple-value-bind (k rem) (truncate j n)
 123                    (values
 124                     (let ((writers
 125                            (loop for w from 0 below n
 126                                  collect
 127                                  (sb-thread:make-thread
 128                                   (lambda ()
 129                                     (let ((sem semaphore))
 130                                       (dotimes (s k)
 131                                         (sb-thread:signal-semaphore sem))))
 132                                   :name "writer"))))
 133                       (assert (zerop rem))
 134                       writers)
 135                     (+ rem (* n k))))))
 136              (test (r w n)
 137                (multiple-value-bind (readers x) (make-readers r n)
 138                  (assert (= (length readers) r))
 139                  (multiple-value-bind (writers y) (make-writers w r n)
 140                    (assert (= (length writers) w))
 141                    (assert (= x y))
 142                    (mapc #'sb-thread:join-thread writers)
 143                    (mapc #'sb-thread:join-thread readers)
 144                    (assert (zerop (sb-thread:semaphore-count semaphore)))
 145                    (values)))))
 146       (assert
 147        (eq :ok
 148            (handler-case
 149                (sb-ext:with-timeout 10
 150                  (test 1 1 100)
 151                  (test 2 2 10000)
 152                  (test 4 2 10000)
 153                  (test 4 2 10000)
 154                  (test 10 10 10000)
 155                  (test 10 1 10000)
 156                  :ok)
 157              (sb-ext:timeout ()
 158                :timeout)))))))
 159
 160 ;;;; Printing waitqueues
 161
 162 (with-test (:name :waitqueue-circle-print :skipped-on '(not :sb-thread))
 163   (let* ((*print-circle* nil)
 164          (lock (sb-thread:make-mutex))
 165          (wq (sb-thread:make-waitqueue)))
 166     (sb-thread:with-recursive-lock (lock)
 167       (sb-thread:condition-notify wq))
 168     ;; Used to blow stack due to recursive structure.
 169     (assert (princ-to-string wq))))
 170
 171 ;;;; SYMBOL-VALUE-IN-THREAD
 172
 173 (with-test (:name symbol-value-in-thread.1)
 174   (let ((* (cons t t)))
 175     (assert (eq * (symbol-value-in-thread '* *current-thread*)))
 176     (setf (symbol-value-in-thread '* *current-thread*) 123)
 177     (assert (= 123 (symbol-value-in-thread '* *current-thread*)))
 178     (assert (= 123 *))))
 179
 180 (with-test (:name symbol-value-in-thread.2 :skipped-on '(not :sb-thread))
 181   (let* ((parent *current-thread*)
 182          (semaphore (make-semaphore))
 183          (child (make-thread (lambda ()
 184                                (wait-on-semaphore semaphore)
 185                                (let ((old (symbol-value-in-thread 'this-is-new parent)))
 186                                  (setf (symbol-value-in-thread 'this-is-new parent) :from-child)
 187                                  old)))))
 188     (progv '(this-is-new) '(42)
 189       (signal-semaphore semaphore)
 190       (assert (= 42 (join-thread child)))
 191       (assert (eq :from-child (symbol-value 'this-is-new))))))
 192
 193 ;;; Disabled on Darwin due to deadlocks caused by apparent OS specific deadlocks,
 194 ;;; wich _appear_ to be caused by malloc() and free() not being thread safe: an
 195 ;;; interrupted malloc in one thread can apparently block a free in another.
 196 (with-test (:name symbol-value-in-thread.3
 197             :skipped-on '(not :sb-thread))
 198   (let* ((parent *current-thread*)
 199          (semaphore (make-semaphore))
 200          (running t)
 201          (noise (make-thread (lambda ()
 202                                (loop while running
 203                                      do (setf * (make-array 1024))
 204                                      ;; Busy-wait a bit so we don't TOTALLY flood the
 205                                      ;; system with GCs: a GC occurring in the middle of
 206                                      ;; S-V-I-T causes it to start over -- we want that
 207                                      ;; to occur occasionally, but not _all_ the time.
 208                                         (loop repeat (random 128)
 209                                               do (setf ** *)))))))
 210     (write-string "; ")
 211     (dotimes (i 15000)
 212       (when (zerop (mod i 200))
 213         (write-char #\.)
 214         (force-output))
 215       (let* ((mom-mark (cons t t))
 216              (kid-mark (cons t t))
 217              (child (make-thread (lambda ()
 218                                    (wait-on-semaphore semaphore)
 219                                    (let ((old (symbol-value-in-thread 'this-is-new parent)))
 220                                      (setf (symbol-value-in-thread 'this-is-new parent)
 221                                            (make-array 24 :initial-element kid-mark))
 222                                      old)))))
 223         (progv '(this-is-new) (list (make-array 24 :initial-element mom-mark))
 224           (signal-semaphore semaphore)
 225           (assert (eq mom-mark (aref (join-thread child) 0)))
 226           (assert (eq kid-mark (aref (symbol-value 'this-is-new) 0))))))
 227     (setf running nil)
 228     (join-thread noise)))
 229
 230 (with-test (:name symbol-value-in-thread.4 :skipped-on '(not :sb-thread))
 231   (let* ((parent *current-thread*)
 232          (semaphore (make-semaphore))
 233          (child (make-thread (lambda ()
 234                                (wait-on-semaphore semaphore)
 235                                (symbol-value-in-thread 'this-is-new parent nil)))))
 236     (signal-semaphore semaphore)
 237     (assert (equal '(nil nil) (multiple-value-list (join-thread child))))))
 238
 239 (with-test (:name symbol-value-in-thread.5 :skipped-on '(not :sb-thread))
 240   (let* ((parent *current-thread*)
 241          (semaphore (make-semaphore))
 242          (child (make-thread (lambda ()
 243                                (wait-on-semaphore semaphore)
 244                                (handler-case
 245                                    (symbol-value-in-thread 'this-is-new parent)
 246                                  (symbol-value-in-thread-error (e)
 247                                    (list (thread-error-thread e)
 248                                          (cell-error-name e)
 249                                          (sb-thread::symbol-value-in-thread-error-info e))))))))
 250     (signal-semaphore semaphore)
 251     (assert (equal (list *current-thread* 'this-is-new (list :read :unbound-in-thread))
 252                    (join-thread child)))))
 253
 254 (with-test (:name symbol-value-in-thread.6 :skipped-on '(not :sb-thread))
 255   (let* ((parent *current-thread*)
 256          (semaphore (make-semaphore))
 257          (name (gensym))
 258          (child (make-thread (lambda ()
 259                                (wait-on-semaphore semaphore)
 260                                (handler-case
 261                                    (setf (symbol-value-in-thread name parent) t)
 262                                  (symbol-value-in-thread-error (e)
 263                                    (list (thread-error-thread e)
 264                                          (cell-error-name e)
 265                                          (sb-thread::symbol-value-in-thread-error-info e))))))))
 266     (signal-semaphore semaphore)
 267     (let ((res (join-thread child))
 268           (want (list *current-thread* name (list :write :no-tls-value))))
 269       (unless (equal res want)
 270         (error "wanted ~S, got ~S" want res)))))
 271
 272 (with-test (:name symbol-value-in-thread.7 :skipped-on '(not :sb-thread))
 273   (let ((child (make-thread (lambda ())))
 274         (error-occurred nil))
 275     (join-thread child)
 276     (handler-case
 277         (symbol-value-in-thread 'this-is-new child)
 278       (symbol-value-in-thread-error (e)
 279         (setf error-occurred t)
 280         (assert (eq child (thread-error-thread e)))
 281         (assert (eq 'this-is-new (cell-error-name e)))
 282         (assert (equal (list :read :thread-dead)
 283                        (sb-thread::symbol-value-in-thread-error-info e)))))
 284     (assert error-occurred)))
 285
 286 (with-test (:name symbol-value-in-thread.8  :skipped-on '(not :sb-thread))
 287   (let ((child (make-thread (lambda ())))
 288         (error-occurred nil))
 289     (join-thread child)
 290     (handler-case
 291         (setf (symbol-value-in-thread 'this-is-new child) t)
 292       (symbol-value-in-thread-error (e)
 293         (setf error-occurred t)
 294         (assert (eq child (thread-error-thread e)))
 295         (assert (eq 'this-is-new (cell-error-name e)))
 296         (assert (equal (list :write :thread-dead)
 297                        (sb-thread::symbol-value-in-thread-error-info e)))))
 298     (assert error-occurred)))
 299
 300 (with-test (:name deadlock-detection.1  :skipped-on '(not :sb-thread))
 301   (loop
 302     repeat 1000
 303     do (flet ((test (ma mb sa sb)
 304                 (lambda ()
 305                   (handler-case
 306                       (sb-thread:with-mutex (ma)
 307                         (sb-thread:signal-semaphore sa)
 308                         (sb-thread:wait-on-semaphore sb)
 309                         (sb-thread:with-mutex (mb)
 310                           :ok))
 311                     (sb-thread:thread-deadlock (e)
 312                       (princ e)
 313                       :deadlock)))))
 314          (let* ((m1 (sb-thread:make-mutex :name "M1"))
 315                 (m2 (sb-thread:make-mutex :name "M2"))
 316                 (s1 (sb-thread:make-semaphore :name "S1"))
 317                 (s2 (sb-thread:make-semaphore :name "S2"))
 318                 (t1 (sb-thread:make-thread (test m1 m2 s1 s2) :name "T1"))
 319                 (t2 (sb-thread:make-thread (test m2 m1 s2 s1) :name "T2")))
 320            ;; One will deadlock, and the other will then complete normally.
 321            (let ((res (list (sb-thread:join-thread t1)
 322                             (sb-thread:join-thread t2))))
 323              (assert (or (equal '(:deadlock :ok) res)
 324                          (equal '(:ok :deadlock) res))))))))
 325
 326 (with-test (:name deadlock-detection.2 :skipped-on '(not :sb-thread))
 327   (let* ((m1 (sb-thread:make-mutex :name "M1"))
 328          (m2 (sb-thread:make-mutex :name "M2"))
 329          (s1 (sb-thread:make-semaphore :name "S1"))
 330          (s2 (sb-thread:make-semaphore :name "S2"))
 331          (t1 (sb-thread:make-thread
 332               (lambda ()
 333                 (sb-thread:with-mutex (m1)
 334                   (sb-thread:signal-semaphore s1)
 335                   (sb-thread:wait-on-semaphore s2)
 336                   (sb-thread:with-mutex (m2)
 337                     :ok)))
 338               :name "T1")))
 339     (prog (err)
 340      :retry
 341        (handler-bind ((sb-thread:thread-deadlock
 342                        (lambda (e)
 343                          (unless err
 344                            ;; Make sure we can print the condition
 345                            ;; while it's active
 346                            (let ((*print-circle* nil))
 347                              (setf err (princ-to-string e)))
 348                            (go :retry)))))
 349          (when err
 350            (sleep 1))
 351          (assert (eq :ok (sb-thread:with-mutex (m2)
 352                            (unless err
 353                              (sb-thread:signal-semaphore s2)
 354                              (sb-thread:wait-on-semaphore s1)
 355                              (sleep 1))
 356                            (sb-thread:with-mutex (m1)
 357                              :ok)))))
 358        (assert (stringp err)))
 359     (assert (eq :ok (sb-thread:join-thread t1)))))
 360
 361 (with-test (:name deadlock-detection.3  :skipped-on '(not :sb-thread))
 362   (let* ((m1 (sb-thread:make-mutex :name "M1"))
 363          (m2 (sb-thread:make-mutex :name "M2"))
 364          (s1 (sb-thread:make-semaphore :name "S1"))
 365          (s2 (sb-thread:make-semaphore :name "S2"))
 366          (t1 (sb-thread:make-thread
 367               (lambda ()
 368                 (sb-thread:with-mutex (m1)
 369                   (sb-thread:signal-semaphore s1)
 370                   (sb-thread:wait-on-semaphore s2)
 371                   (sb-thread:with-mutex (m2)
 372                     :ok)))
 373               :name "T1")))
 374     ;; Currently we don't consider it a deadlock
 375     ;; if there is a timeout in the chain.
 376     (assert (eq :deadline
 377                 (handler-case
 378                     (sb-thread:with-mutex (m2)
 379                       (sb-thread:signal-semaphore s2)
 380                       (sb-thread:wait-on-semaphore s1)
 381                       (sleep 1)
 382                       (sb-sys:with-deadline (:seconds 0.1)
 383                         (sb-thread:with-mutex (m1)
 384                           :ok)))
 385                   (sb-sys:deadline-timeout ()
 386                     :deadline)
 387                   (sb-thread:thread-deadlock ()
 388                     :deadlock))))
 389     (assert (eq :ok (join-thread t1)))))
 390
 391 #+sb-thread
 392 (with-test (:name :pass-arguments-to-thread)
 393   (assert (= 3 (join-thread (make-thread #'+ :arguments '(1 2))))))
 394
 395 #+sb-thread
 396 (with-test (:name :pass-atom-to-thread)
 397   (assert (= 1/2 (join-thread (make-thread #'/ :arguments 2)))))
 398
 399 #+sb-thread
 400 (with-test (:name :pass-nil-to-thread)
 401   (assert (= 1 (join-thread (make-thread #'* :arguments '())))))
 402
 403 #+sb-thread
 404 (with-test (:name :pass-nothing-to-thread)
 405   (assert (= 1 (join-thread (make-thread #'*)))))
 406
 407 #+sb-thread
 408 (with-test (:name :pass-improper-list-to-thread)
 409   (multiple-value-bind (value error)
 410       (ignore-errors (make-thread #'+ :arguments '(1 . 1)))
 411     (when value
 412       (join-thread value))
 413     (assert (and (null value)
 414                  error))))
 415
 416 (with-test (:name (:wait-for :basics) :fails-on :win32)
 417   (assert (not (sb-ext:wait-for nil :timeout 0.1)))
 418   (assert (eql 42 (sb-ext:wait-for 42)))
 419   (let ((n 0))
 420     (assert (eql 100 (sb-ext:wait-for (when (= 100 (incf n))
 421                                         n))))))
 422
 423 (with-test (:name (:wait-for :deadline) :fails-on :win32)
 424   (assert (eq :ok
 425               (sb-sys:with-deadline (:seconds 10)
 426                 (assert (not (sb-ext:wait-for nil :timeout 0.1)))
 427                 :ok)))
 428   (assert (eq :deadline
 429               (handler-case
 430                   (sb-sys:with-deadline (:seconds 0.1)
 431                     (sb-ext:wait-for nil :timeout 10)
 432                     (error "oops"))
 433                 (sb-sys:deadline-timeout () :deadline)))))
 434
 435 (with-test (:name (:condition-wait :timeout :one-thread) :fails-on :win32)
 436   (let ((mutex (make-mutex))
 437         (waitqueue (make-waitqueue)))
 438     (assert (not (with-mutex (mutex)
 439                    (condition-wait waitqueue mutex :timeout 0.01))))))
 440
 441 (with-test (:name (:condition-wait :timeout :many-threads)
 442             :skipped-on '(not :sb-thread))
 443   (let* ((mutex (make-mutex))
 444          (waitqueue (make-waitqueue))
 445          (sem (make-semaphore))
 446          (data nil)
 447          (workers
 448            (loop repeat 100
 449                  collect (make-thread
 450                           (lambda ()
 451                             (wait-on-semaphore sem)
 452                             (block thread
 453                               (with-mutex (mutex)
 454                                 (loop until data
 455                                       do (or (condition-wait waitqueue mutex :timeout 0.01)
 456                                              (return-from thread nil)))
 457                                 (assert (eq t (pop data)))
 458                                 t)))))))
 459     (loop repeat 50
 460           do (with-mutex (mutex)
 461                (push t data)
 462                (condition-notify waitqueue)))
 463     (signal-semaphore sem 100)
 464     (let ((ok (count-if #'join-thread workers)))
 465       (unless (eql 50 ok)
 466         (error "Wanted 50, got ~S" ok)))))
 467
 468 (with-test (:name (:wait-on-semaphore :timeout :one-thread) :fails-on :win32)
 469   (let ((sem (make-semaphore))
 470         (n 0))
 471     (signal-semaphore sem 10)
 472     (loop repeat 100
 473           do (when (wait-on-semaphore sem :timeout 0.001)
 474                (incf n)))
 475     (assert (= n 10))))
 476
 477 (with-test (:name (:wait-on-semaphore :timeout :many-threads)
 478             :skipped-on '(not :sb-thread))
 479   (let* ((sem (make-semaphore))
 480          (threads
 481            (progn
 482              (signal-semaphore sem 10)
 483              (loop repeat 100
 484                    collect (make-thread
 485                             (lambda ()
 486                               (sleep (random 0.02))
 487                               (wait-on-semaphore sem :timeout 0.5)))))))
 488     (loop repeat 5
 489           do (signal-semaphore sem 2))
 490     (let ((ok (count-if #'join-thread threads)))
 491       (unless (eql 20 ok)
 492         (error "Wanted 20, got ~S" ok)))))
 493
 494 (with-test (:name (:join-thread :timeout)
 495             :skipped-on '(not :sb-thread))
 496   (assert (eq :error
 497               (handler-case
 498                   (join-thread (make-join-thread (lambda () (sleep 10))) :timeout 0.01)
 499                 (join-thread-error ()
 500                   :error))))
 501   (let ((cookie (cons t t)))
 502     (assert (eq cookie
 503                 (join-thread (make-join-thread (lambda () (sleep 10)))
 504                              :timeout 0.01
 505                              :default cookie)))))
 506
 507 (with-test (:name (:semaphore-notification :wait-on-semaphore)
 508             :skipped-on '(not :sb-thread))
 509   (let ((sem (make-semaphore))
 510         (ok nil)
 511         (n 0))
 512     (flet ((critical ()
 513              (let ((note (make-semaphore-notification)))
 514                (sb-sys:without-interrupts
 515                  (unwind-protect
 516                       (progn
 517                         (sb-sys:with-local-interrupts
 518                           (wait-on-semaphore sem :notification note)
 519                           (sleep (random 0.1)))
 520                         (incf n))
 521                    ;; Re-increment on exit if we decremented it.
 522                    (when (semaphore-notification-status note)
 523                      (signal-semaphore sem))
 524                    ;; KLUDGE: Prevent interrupts after this point from
 525                    ;; unwinding us, so that we can reason about the counts.
 526                    #+sb-thread
 527                    (sb-thread::block-deferrable-signals))))))
 528       (let* ((threads (loop for i from 1 upto 100
 529                             collect (make-join-thread #'critical :name (format nil "T~A" i))))
 530              (safe nil)
 531              (unsafe nil)
 532              (interruptor (make-thread (lambda ()
 533                                          (loop until ok)
 534                                          (let (x)
 535                                            (dolist (thread threads)
 536                                              (cond (x
 537                                                     (push thread unsafe)
 538                                                     (sleep (random 0.1))
 539                                                     (ignore-errors
 540                                                      (terminate-thread thread)))
 541                                                    (t
 542                                                     (push thread safe)))
 543                                              (setf x (not x))))))))
 544         (signal-semaphore sem)
 545         (setf ok t)
 546         (join-thread interruptor)
 547         (mapc #'join-thread safe)
 548         (let ((k (count-if (lambda (th)
 549                              (join-thread th :default nil))
 550                            unsafe)))
 551           (assert (= n (+ k (length safe))))
 552           (assert unsafe))))))
 553
 554 (with-test (:name (:semaphore-notification :try-sempahore)
 555             :skipped-on '(not :sb-thread))
 556   (let* ((sem (make-semaphore))
 557          (note (make-semaphore-notification)))
 558     (try-semaphore sem 1 note)
 559     (assert (not (semaphore-notification-status note)))
 560     (signal-semaphore sem)
 561     (try-semaphore sem 1 note)
 562     (assert (semaphore-notification-status note))))
 563
 564 (with-test (:name (:return-from-thread :normal-thread)
 565             :skipped-on '(not :sb-thread))
 566   (let* ((thread (make-thread (lambda ()
 567                                 (return-from-thread (values 1 2 3))
 568                                 :foo)))
 569          (values (multiple-value-list (join-thread thread))))
 570     (unless (equal (list 1 2 3) values)
 571       (error "got ~S, wanted (1 2 3)" values))))
 572
 573 (with-test (:name (:return-from-thread :main-thread))
 574   (assert (main-thread-p))
 575   (assert (eq :oops
 576               (handler-case
 577                   (return-from-thread t)
 578                 (thread-error ()
 579                   :oops)))))
 580
 581 (with-test (:name (:abort-thread :normal-thread)
 582             :skipped-on '(not :sb-thread))
 583   (let ((thread (make-thread (lambda ()
 584                                (abort-thread)
 585                                :foo))))
 586     (assert (eq :aborted! (join-thread thread :default :aborted!)))))
 587
 588 (with-test (:name (:abort-thread :main-thread))
 589   (assert (main-thread-p))
 590   (assert (eq :oops
 591               (handler-case
 592                   (abort-thread)
 593                 (thread-error ()
 594                   :oops)))))
 595