tests/signals.impure.lisp

   1 ;;;; Tests for async signal safety.
   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 (use-package :test-util)
  15
  16 (sb-ext:finalize (list 1) (lambda ()))
  17 (with-test (:name (:async-unwind :specials)
  18                   :skipped-on (:and :sb-safepoint :linux)) ; hangs
  19   (let ((*x0* nil) (*x1* nil) (*x2* nil) (*x3* nil) (*x4* nil))
  20     (declare (special *x0* *x1* *x2* *x3* *x4*))
  21     (loop repeat 10 do
  22           (loop repeat 10 do
  23                 (catch 'again
  24                   (sb-ext:schedule-timer (sb-ext:make-timer
  25                                           (lambda ()
  26                                             (throw 'again nil)))
  27                                          (random 0.1))
  28                   (loop
  29                    (let ((*x0* (cons nil nil)) (*x1* (cons nil nil))
  30                          (*x2* (cons nil nil)) (*x3* (cons nil nil))
  31                          (*x4* (cons nil nil)))
  32                      (declare (special *x0* *x1* *x2* *x3* *x4*)))))
  33                 (when (not (and (null *x0*) (null *x1*) (null *x2*) (null *x3*)
  34                                 (null *x4*)))
  35                   (format t "~S ~S ~S ~S ~S~%" *x0* *x1* *x2* *x3* *x4*)
  36                   (assert nil)))
  37           (princ '*)
  38           (force-output))
  39     (terpri)))
  40
  41 (require :sb-posix)
  42
  43 (with-test (:name (:signal :errno)
  44                   ;; This test asserts that nanosleep behaves correctly
  45                   ;; for invalid values and sets EINVAL.  Well, we have
  46                   ;; nanosleep on Windows, but it depends on the caller
  47                   ;; (namely SLEEP) to produce known-good arguments, and
  48                   ;; even if we wanted to check argument validity,
  49                   ;; integration with `errno' is not to be expected.
  50                   ;; And this hangs on darwin + safepoint.
  51                   :skipped-on (or :win32 (:and :darwin :sb-safepoint)))
  52   (let* (saved-errno
  53          (returning nil)
  54          (timer (make-timer (lambda ()
  55                               (sb-unix:unix-open "~!@#$%^&*[]()/\\" 0 0)
  56                               (assert (= sb-unix:enoent
  57                                          (sb-unix::get-errno)))
  58                               (setq returning t)))))
  59     (schedule-timer timer 0.2)
  60     ;; Fail and set errno.
  61     (sb-unix:nanosleep -1 -1)
  62     (setq saved-errno (sb-unix::get-errno))
  63     (assert (= saved-errno sb-posix:einval))
  64     ;; Wait, but not with sleep because that will be interrupted and
  65     ;; we get EINTR.
  66     (loop until returning)
  67     (assert (= saved-errno (sb-unix::get-errno)))))
  68
  69 ;; It is desirable to support C-c on Windows, but SIGINT
  70 ;; is not the mechanism to use on this platform.
  71 ;; This test used to call kill_safely() in the C runtime if using safepoints,
  72 ;; and perhaps at some point kill_safely() interacted with the safepoint state
  73 ;; for POSIX (i.e. not win32), but it doesn't, at least not now.
  74 ;; The special case in kill_safely() for the current thread is pthread_kill()
  75 ;; and not a thing more, unless on win32, which skips this test.
  76 ;; Note also that RAISE sends a thread-directed signal as per the man page
  77 ;; "In a multithreaded program it is equivalent to pthread_kill(pthread_self(), sig);"
  78 ;; but thread-directed SIGINT is not the right thing, as it does not accurately
  79 ;; model the effect of pressing control-C; hence we should use UNIX-KILL here,
  80 ;; which sends a process-directed signal, letting the OS pick a thread.
  81 ;; Whether it picks the finalizer thread or main thread, things should work,
  82 ;; because we forward to the signal to our foreground thread.
  83 #+unix
  84 (with-test (:name :handle-interactive-interrupt)
  85   (assert (eq :condition
  86               (handler-case
  87                   (progn
  88                     (sb-unix:unix-kill (sb-unix:unix-getpid) sb-unix:sigint)
  89                     #+sb-safepoint
  90                     ;; In this case, the signals handler gets invoked
  91                     ;; indirectly through an INTERRUPT-THREAD.  Give it
  92                     ;; enough time to hit.
  93                     (sleep 1))
  94                 (sb-sys:interactive-interrupt ()
  95                   :condition)))))
  96
  97 (with-test (:name :bug-640516
  98                   :skipped-on :gc-stress)
  99   ;; On Darwin interrupting a SLEEP so that it took longer than
 100   ;; the requested amount caused it to hang.
 101   (assert
 102    (handler-case
 103        (sb-ext:with-timeout 10
 104          (let (to)
 105            (handler-bind ((sb-ext:timeout (lambda (c)
 106                                             (unless to
 107                                               (setf to t)
 108                                               (sleep 2)
 109                                               (continue c)))))
 110              (sb-ext:with-timeout 0.1 (sleep 1) t))))
 111      (sb-ext:timeout ()
 112        nil))))
 113
 114 #+unix
 115 (with-test (:name :ignore-sigpipe)
 116   (multiple-value-bind (read-side write-side) (sb-unix:unix-pipe)
 117     (sb-unix:unix-close read-side)
 118     (sb-sys:enable-interrupt sb-unix:sigpipe :ignore)
 119     (let ((buffer "x"))
 120       (sb-sys:with-pinned-objects (buffer)
 121         (multiple-value-bind (nbytes errno)
 122             (sb-unix:unix-write write-side buffer 0 1)
 123           (assert (and (null nbytes)
 124                        (= errno sb-unix:epipe))))))
 125     (sb-unix:unix-close write-side)))