Commit e2372797 authored by Michael Albinus's avatar Michael Albinus

thread-join returns the result of finished thread

* doc/lispref/threads.texi (Basic Thread Functions):
* etc/NEWS: Document return value of `thread-join'.

* src/thread.c (invoke_thread_function, Fmake_thread)
(init_main_thread): Set result.
(Fthread_join): Propagate signals, and return result.
(Vmain_thread): New defvar.

* src/thread.h (struct thread_state): Add `result' field.

* test/src/thread-tests.el (threads-join): Test also return value.
(threads-join-error): New test.
(threads-mutex-signal): Check for propagation of `quit' signal.
parent b7ca3d5d
......@@ -75,8 +75,8 @@ thread, @code{nil} otherwise.
@defun thread-join thread
Block until @var{thread} exits, or until the current thread is
signaled. If @var{thread} has already exited, this returns
immediately.
signaled. It returns the result of the @var{thread} function. If
@var{thread} has already exited, this returns immediately.
@end defun
@defun thread-signal thread error-symbol data
......
......@@ -172,11 +172,6 @@ from a remote host.
This triggers to search the program on the remote host as indicated by
'default-directory'.
+++
** New variable 'main-thread' holds Emacs's main thread.
This is handy in Lisp programs that run on a non-main thread and want
to signal the main thread, e.g., when they encounter an error.
* Editing Changes in Emacs 27.1
......@@ -578,7 +573,6 @@ It was obsolete since Emacs 22.1, replaced by customize.
Use of built-in libgnutls based functionality (described in the Emacs
GnuTLS manual) is recommended instead.
** Message
+++
......@@ -624,6 +618,17 @@ If this option is non-nil, messages appended to an output file by the
selects the messages to summarize with a regexp that matches the
sender of the current message.
** Threads
+++
*** New variable 'main-thread' holds Emacs's main thread.
This is handy in Lisp programs that run on a non-main thread and want
to signal the main thread, e.g., when they encounter an error.
+++
*** 'thread-join' returns the result of the finished thread now.
* New Modes and Packages in Emacs 27.1
+++
......@@ -739,6 +744,7 @@ however applications should instead call 'display-buffer-in-side-window'
is backwards-compatible with versions of Emacs in which the old function
exists. See the node "Displaying Buffers in Side Windows" in the ELisp
manual for more details.
* Lisp Changes in Emacs 27.1
......
......@@ -681,7 +681,7 @@ invoke_thread_function (void)
{
ptrdiff_t count = SPECPDL_INDEX ();
Ffuncall (1, &current_thread->function);
current_thread->result = Ffuncall (1, &current_thread->function);
return unbind_to (count, Qnil);
}
......@@ -789,6 +789,7 @@ If NAME is given, it must be a string; it names the new thread. */)
new_thread->m_last_thing_searched = Qnil; /* copy from parent? */
new_thread->m_saved_last_thing_searched = Qnil;
new_thread->m_current_buffer = current_thread->m_current_buffer;
new_thread->result = Qnil;
new_thread->error_symbol = Qnil;
new_thread->error_data = Qnil;
new_thread->event_object = Qnil;
......@@ -933,12 +934,13 @@ thread_join_callback (void *arg)
DEFUN ("thread-join", Fthread_join, Sthread_join, 1, 1, 0,
doc: /* Wait for THREAD to exit.
This blocks the current thread until THREAD exits or until
the current thread is signaled.
It is an error for a thread to try to join itself. */)
This blocks the current thread until THREAD exits or until the current
thread is signaled. It returns the result of the THREAD function. It
is an error for a thread to try to join itself. */)
(Lisp_Object thread)
{
struct thread_state *tstate;
Lisp_Object error_symbol, error_data;
CHECK_THREAD (thread);
tstate = XTHREAD (thread);
......@@ -946,10 +948,16 @@ It is an error for a thread to try to join itself. */)
if (tstate == current_thread)
error ("Cannot join current thread");
error_symbol = tstate->error_symbol;
error_data = tstate->error_data;
if (thread_alive_p (tstate))
flush_stack_call_func (thread_join_callback, tstate);
return Qnil;
if (!NILP (error_symbol))
Fsignal (error_symbol, error_data);
return tstate->result;
}
DEFUN ("all-threads", Fall_threads, Sall_threads, 0, 0, 0,
......@@ -1017,6 +1025,7 @@ init_main_thread (void)
main_thread.m_saved_last_thing_searched = Qnil;
main_thread.name = Qnil;
main_thread.function = Qnil;
main_thread.result = Qnil;
main_thread.error_symbol = Qnil;
main_thread.error_data = Qnil;
main_thread.event_object = Qnil;
......@@ -1090,8 +1099,7 @@ syms_of_threads (void)
DEFSYM (Qmutexp, "mutexp");
DEFSYM (Qcondition_variable_p, "condition-variable-p");
DEFVAR_LISP ("main-thread",
Vmain_thread,
DEFVAR_LISP ("main-thread", Vmain_thread,
doc: /* The main thread of Emacs. */);
#ifdef THREADS_ENABLED
XSETTHREAD (Vmain_thread, &main_thread);
......
......@@ -52,6 +52,9 @@ struct thread_state
/* The thread's function. */
Lisp_Object function;
/* The thread's result, if function has finished. */
Lisp_Object result;
/* If non-nil, this thread has been signaled. */
Lisp_Object error_symbol;
Lisp_Object error_data;
......
......@@ -100,15 +100,24 @@
(progn
(setq threads-test-global nil)
(let ((thread (make-thread #'threads-test-thread1)))
(thread-join thread)
(and threads-test-global
(not (thread-alive-p thread)))))))
(and (= (thread-join thread) 23)
(= threads-test-global 23)
(not (thread-alive-p thread)))))))
(ert-deftest threads-join-self ()
"Cannot `thread-join' the current thread."
(skip-unless (featurep 'threads))
(should-error (thread-join (current-thread))))
(ert-deftest threads-join-error ()
"Test of error signalling from `thread-join'."
:tags '(:unstable)
(skip-unless (featurep 'threads))
(let ((thread (make-thread #'threads-call-error)))
(while (thread-alive-p thread)
(thread-yield))
(should-error (thread-join thread))))
(defvar threads-test-binding nil)
(defun threads-test-thread2 ()
......@@ -197,7 +206,7 @@
(ert-deftest threads-mutex-signal ()
"Test signaling a blocked thread."
(skip-unless (featurep 'threads))
(should
(should-error
(progn
(setq threads-mutex (make-mutex))
(setq threads-mutex-key nil)
......@@ -206,8 +215,10 @@
(while (not threads-mutex-key)
(thread-yield))
(thread-signal thr 'quit nil)
(thread-join thr))
t)))
;; `quit' is not catched by `should-error'. We must indicate it.
(condition-case nil
(thread-join thr)
(quit (signal 'error nil)))))))
(defun threads-test-io-switch ()
(setq threads-test-global 23))
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment