Add variable main-thread, fix Bug#32169

* doc/lispref/threads.texi (Basic Thread Functions): Add example,
how to propagate signals to the main thread.  Describe variable
`main-thread'.  Document optional argument CLEANUP of
`thread-last-error'.

* src/thread.c (Fthread_last_error): Add optional argument
CLEANUP.  (Bug#32169)
(main-thread): New defvar.

* test/src/thread-tests.el (thread-last-error): Adapt declaration.
(main-thread): Declare.
(threads-main-thread): New test.
(threads-errors): Extend test.
This commit is contained in:
Michael Albinus 2018-07-17 12:03:43 +02:00
parent 94a16e7360
commit 798cbac170
3 changed files with 46 additions and 7 deletions

View file

@ -87,6 +87,15 @@ thread, then this just calls @code{signal} immediately. Otherwise,
If @var{thread} was blocked by a call to @code{mutex-lock},
@code{condition-wait}, or @code{thread-join}; @code{thread-signal}
will unblock it.
Since signal handlers in Emacs are located in the main thread, a
signal must be propagated there in order to become visible. The
second @code{signal} call let the thread die:
@example
(thread-signal main-thread 'error data)
(signal 'error data)
@end example
@end defun
@defun thread-yield
@ -127,15 +136,21 @@ Return a list of all the live thread objects. A new list is returned
by each invocation.
@end defun
@defvar main-thread
This variable keeps the main thread Emacs is running, or @code{nil} if
Emacs is compiled without thread support.
@end defvar
When code run by a thread signals an error that is unhandled, the
thread exits. Other threads can access the error form which caused
the thread to exit using the following function.
@defun thread-last-error
@defun thread-last-error &optional cleanup
This function returns the last error form recorded when a thread
exited due to an error. Each thread that exits abnormally overwrites
the form stored by the previous thread's error with a new value, so
only the last one can be accessed.
only the last one can be accessed. If @var{cleanup} is
non-@code{nil}, the stored form is reset to @code{nil}.
@end defun
@node Mutexes

View file

@ -973,11 +973,17 @@ DEFUN ("all-threads", Fall_threads, Sall_threads, 0, 0, 0,
return result;
}
DEFUN ("thread-last-error", Fthread_last_error, Sthread_last_error, 0, 0, 0,
doc: /* Return the last error form recorded by a dying thread. */)
(void)
DEFUN ("thread-last-error", Fthread_last_error, Sthread_last_error, 0, 1, 0,
doc: /* Return the last error form recorded by a dying thread.
If CLEANUP is non-nil, remove this error form from history. */)
(Lisp_Object cleanup)
{
return last_thread_error;
Lisp_Object result = last_thread_error;
if (!NILP (cleanup))
last_thread_error = Qnil;
return result;
}
@ -1083,4 +1089,13 @@ syms_of_threads (void)
DEFSYM (Qthreadp, "threadp");
DEFSYM (Qmutexp, "mutexp");
DEFSYM (Qcondition_variable_p, "condition-variable-p");
DEFVAR_LISP ("main-thread",
Vmain_thread,
doc: /* The main thread of Emacs. */);
#ifdef THREADS_ENABLED
XSETTHREAD (Vmain_thread, &main_thread);
#else
Vmain_thread = Qnil;
#endif
}

View file

@ -34,10 +34,11 @@
(declare-function thread--blocker "thread.c" (thread))
(declare-function thread-alive-p "thread.c" (thread))
(declare-function thread-join "thread.c" (thread))
(declare-function thread-last-error "thread.c" ())
(declare-function thread-last-error "thread.c" (&optional cleanup))
(declare-function thread-name "thread.c" (thread))
(declare-function thread-signal "thread.c" (thread error-symbol data))
(declare-function thread-yield "thread.c" ())
(defvar main-thread)
(ert-deftest threads-is-one ()
"Test for existence of a thread."
@ -71,6 +72,11 @@
(skip-unless (featurep 'threads))
(should (listp (all-threads))))
(ert-deftest threads-main-thread ()
"Simple test for all-threads."
(skip-unless (featurep 'threads))
(should (eq main-thread (car (all-threads)))))
(defvar threads-test-global nil)
(defun threads-test-thread1 ()
@ -275,6 +281,9 @@
(thread-yield))
(should (equal (thread-last-error)
'(error "Error is called")))
(should (equal (thread-last-error 'cleanup)
'(error "Error is called")))
(should-not (thread-last-error))
(setq th2 (make-thread #'threads-custom "threads-custom"))
(should (threadp th2))))