From: Michael Albinus Date: Sun, 22 Jul 2018 09:53:24 +0000 (+0200) Subject: thread-join returns the result of finished thread X-Git-Tag: emacs-27.0.90~4664^2~44 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=e23727978dbb07d68f730ffa60b22d59d065850e;p=emacs.git 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. --- diff --git a/doc/lispref/threads.texi b/doc/lispref/threads.texi index 4cef9c9c6e8..58a3a918efd 100644 --- a/doc/lispref/threads.texi +++ b/doc/lispref/threads.texi @@ -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 diff --git a/etc/NEWS b/etc/NEWS index c2b6b500eeb..fc2a5d4c039 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -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 diff --git a/src/thread.c b/src/thread.c index 754d286e9f8..1c73d938655 100644 --- a/src/thread.c +++ b/src/thread.c @@ -681,7 +681,7 @@ invoke_thread_function (void) { ptrdiff_t count = SPECPDL_INDEX (); - Ffuncall (1, ¤t_thread->function); + current_thread->result = Ffuncall (1, ¤t_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); diff --git a/src/thread.h b/src/thread.h index c10e5ecb758..922eea62178 100644 --- a/src/thread.h +++ b/src/thread.h @@ -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; diff --git a/test/src/thread-tests.el b/test/src/thread-tests.el index a447fb3914e..364f6d61f05 100644 --- a/test/src/thread-tests.el +++ b/test/src/thread-tests.el @@ -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))