tests/exit-hang.impure.lisp

   1 #+(or (not sb-thread) win32) (invoke-restart 'run-tests::skip-file)
   2
   3 ;;; Not an exactly an "exit hang" test, but there was a different hang
   4 ;;; regarding concurrent JOIN-THREAD on 1 thread.
   5 ;;; Even though POSIX threads would consider this to be undefined behavior with
   6 ;;; its thread abstraction, it's not undefined behavior in SBCL (for now)
   7 ;;; though I do think it's slightly suspicious to depend on this.
   8 (with-test (:name :concurrent-join-thread)
   9   (let* ((other-guy (sb-thread:make-thread #'sleep :arguments .2 :name "sleepyhead"))
  10          (joiners
  11           (loop repeat 4
  12                 collect (sb-thread:make-thread #'sb-thread:join-thread
  13                                                :arguments other-guy))))
  14     ;; The joiners should all return
  15     (mapc 'sb-thread:join-thread joiners)))
  16
  17 ;;; This uses the same C source file as fcb-threads.
  18 ;;; This is OK in the parallel test runner because WITH-SCRATCH-FILE
  19 ;;; includes the PID in the temp file name.
  20 (if (probe-file "fcb-threads.so")
  21     ;; Assume the test automator built this for us
  22     (load-shared-object (truename "fcb-threads.so"))
  23     ;; Otherwise, write into /tmp so that we never fail to rebuild
  24     ;; the '.so' if it gets changed, and assume that it's OK to
  25     ;; delete a mapped file (which it is for *nix).
  26     (with-scratch-file (solib "so")
  27       (sb-ext:run-program "/bin/sh"
  28                           `("run-compiler.sh" "-sbcl-pic" "-sbcl-shared"
  29                             "-o" ,solib "fcb-threads.c"))
  30       (sb-alien:load-shared-object solib)))
  31 #+(and linux gc-stress) (invoke-restart 'run-tests::skip-file)
  32 ;;; Final test: EXIT does not lock up due to (simulated) C++ destructors
  33 ;;; or free() or most anything else involved in stopping the main thread.
  34 ;;; The point of the test is to mock a Lisp thread that uses foreign code
  35 ;;; that uses malloc and free or equivalent from C++.
  36 ;;; The behavior being tested is the effect of SB-THREAD:ABORT-THREAD on
  37 ;;; a thread that happened to be just at that moment in the foreign code.
  38 ;;; We can't - or don't need to - exactly replicate the behavior
  39 ;;; of doing a lot of memory allocation. All we need to demonstrate is
  40 ;;; that we won't interrupt a malloc() or free().
  41 (defglobal *should-i-keep-going* t)
  42 (defun mess-around-with-foreign-calls ()
  43   ;; In reality the thread would not permanently own the lock, but this is the
  44   ;; simplest way to simulate the random occurrence that it does own the lock
  45   ;; exactly when terminated.
  46   ;; So make it own the lock forever unless politely (i.e. not forcibly) terminated.
  47   (alien-funcall (extern-alien "acquire_a_global_lock" (function void)))
  48   (loop (sb-thread:barrier (:read))
  49         (unless *should-i-keep-going* (return))
  50         (sleep .75))
  51   (format *error-output* "~&Worker thread politely exiting~%")
  52   (alien-funcall (extern-alien "release_a_global_lock" (function void))))
  53
  54 (sb-thread:make-thread #'mess-around-with-foreign-calls)
  55
  56 (push (compile nil
  57                '(lambda ()
  58                  (format t "~&Invoked exit hook~%")
  59                  (setq *should-i-keep-going* nil)))
  60       *exit-hooks*)
  61
  62 ;;; The actual code under test involved C++ destructors that are
  63 ;;; interposed between our call to OS-EXIT and the OS call per se.
  64 ;;; Acquiring a globally shared mutex in OS-EXIT simulates that.
  65 (sb-int:encapsulate
  66  'sb-sys:os-exit
  67  'simulate-c++-destructors
  68  (lambda (realfun code &key abort)
  69    (format t "~&Enter OS-EXIT ~s ~s~%" code abort)
  70    (alien-funcall (extern-alien "acquire_a_global_lock" (function void)))
  71    (alien-funcall (extern-alien "release_a_global_lock" (function void)))
  72    (funcall realfun code :abort abort)))
  73
  74 ;;; Give ourselves 3 seconds to exit.
  75 (alien-funcall (extern-alien "prepare_exit_test" (function void int)) 3)
  76 (setq sb-ext:*forcibly-terminate-threads-on-exit* nil)