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