diff options
| author | Michael Albinus | 2018-07-22 11:53:24 +0200 |
|---|---|---|
| committer | Michael Albinus | 2018-07-22 11:53:24 +0200 |
| commit | e23727978dbb07d68f730ffa60b22d59d065850e (patch) | |
| tree | 7ed37a1f0078ba6032a7d924f218c764330a98c8 | |
| parent | b7ca3d5d932bad6900296679ab87f7d0d64d1de9 (diff) | |
| download | emacs-e23727978dbb07d68f730ffa60b22d59d065850e.tar.gz emacs-e23727978dbb07d68f730ffa60b22d59d065850e.zip | |
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.
| -rw-r--r-- | doc/lispref/threads.texi | 4 | ||||
| -rw-r--r-- | etc/NEWS | 18 | ||||
| -rw-r--r-- | src/thread.c | 22 | ||||
| -rw-r--r-- | src/thread.h | 3 | ||||
| -rw-r--r-- | test/src/thread-tests.el | 23 |
5 files changed, 49 insertions, 21 deletions
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. | |||
| 75 | 75 | ||
| 76 | @defun thread-join thread | 76 | @defun thread-join thread |
| 77 | Block until @var{thread} exits, or until the current thread is | 77 | Block until @var{thread} exits, or until the current thread is |
| 78 | signaled. If @var{thread} has already exited, this returns | 78 | signaled. It returns the result of the @var{thread} function. If |
| 79 | immediately. | 79 | @var{thread} has already exited, this returns immediately. |
| 80 | @end defun | 80 | @end defun |
| 81 | 81 | ||
| 82 | @defun thread-signal thread error-symbol data | 82 | @defun thread-signal thread error-symbol data |
| @@ -172,11 +172,6 @@ from a remote host. | |||
| 172 | This triggers to search the program on the remote host as indicated by | 172 | This triggers to search the program on the remote host as indicated by |
| 173 | 'default-directory'. | 173 | 'default-directory'. |
| 174 | 174 | ||
| 175 | +++ | ||
| 176 | ** New variable 'main-thread' holds Emacs's main thread. | ||
| 177 | This is handy in Lisp programs that run on a non-main thread and want | ||
| 178 | to signal the main thread, e.g., when they encounter an error. | ||
| 179 | |||
| 180 | 175 | ||
| 181 | * Editing Changes in Emacs 27.1 | 176 | * Editing Changes in Emacs 27.1 |
| 182 | 177 | ||
| @@ -578,7 +573,6 @@ It was obsolete since Emacs 22.1, replaced by customize. | |||
| 578 | Use of built-in libgnutls based functionality (described in the Emacs | 573 | Use of built-in libgnutls based functionality (described in the Emacs |
| 579 | GnuTLS manual) is recommended instead. | 574 | GnuTLS manual) is recommended instead. |
| 580 | 575 | ||
| 581 | |||
| 582 | ** Message | 576 | ** Message |
| 583 | 577 | ||
| 584 | +++ | 578 | +++ |
| @@ -624,6 +618,17 @@ If this option is non-nil, messages appended to an output file by the | |||
| 624 | selects the messages to summarize with a regexp that matches the | 618 | selects the messages to summarize with a regexp that matches the |
| 625 | sender of the current message. | 619 | sender of the current message. |
| 626 | 620 | ||
| 621 | ** Threads | ||
| 622 | |||
| 623 | +++ | ||
| 624 | *** New variable 'main-thread' holds Emacs's main thread. | ||
| 625 | This is handy in Lisp programs that run on a non-main thread and want | ||
| 626 | to signal the main thread, e.g., when they encounter an error. | ||
| 627 | |||
| 628 | +++ | ||
| 629 | *** 'thread-join' returns the result of the finished thread now. | ||
| 630 | |||
| 631 | |||
| 627 | * New Modes and Packages in Emacs 27.1 | 632 | * New Modes and Packages in Emacs 27.1 |
| 628 | 633 | ||
| 629 | +++ | 634 | +++ |
| @@ -739,6 +744,7 @@ however applications should instead call 'display-buffer-in-side-window' | |||
| 739 | is backwards-compatible with versions of Emacs in which the old function | 744 | is backwards-compatible with versions of Emacs in which the old function |
| 740 | exists. See the node "Displaying Buffers in Side Windows" in the ELisp | 745 | exists. See the node "Displaying Buffers in Side Windows" in the ELisp |
| 741 | manual for more details. | 746 | manual for more details. |
| 747 | |||
| 742 | 748 | ||
| 743 | * Lisp Changes in Emacs 27.1 | 749 | * Lisp Changes in Emacs 27.1 |
| 744 | 750 | ||
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) | |||
| 681 | { | 681 | { |
| 682 | ptrdiff_t count = SPECPDL_INDEX (); | 682 | ptrdiff_t count = SPECPDL_INDEX (); |
| 683 | 683 | ||
| 684 | Ffuncall (1, ¤t_thread->function); | 684 | current_thread->result = Ffuncall (1, ¤t_thread->function); |
| 685 | return unbind_to (count, Qnil); | 685 | return unbind_to (count, Qnil); |
| 686 | } | 686 | } |
| 687 | 687 | ||
| @@ -789,6 +789,7 @@ If NAME is given, it must be a string; it names the new thread. */) | |||
| 789 | new_thread->m_last_thing_searched = Qnil; /* copy from parent? */ | 789 | new_thread->m_last_thing_searched = Qnil; /* copy from parent? */ |
| 790 | new_thread->m_saved_last_thing_searched = Qnil; | 790 | new_thread->m_saved_last_thing_searched = Qnil; |
| 791 | new_thread->m_current_buffer = current_thread->m_current_buffer; | 791 | new_thread->m_current_buffer = current_thread->m_current_buffer; |
| 792 | new_thread->result = Qnil; | ||
| 792 | new_thread->error_symbol = Qnil; | 793 | new_thread->error_symbol = Qnil; |
| 793 | new_thread->error_data = Qnil; | 794 | new_thread->error_data = Qnil; |
| 794 | new_thread->event_object = Qnil; | 795 | new_thread->event_object = Qnil; |
| @@ -933,12 +934,13 @@ thread_join_callback (void *arg) | |||
| 933 | 934 | ||
| 934 | DEFUN ("thread-join", Fthread_join, Sthread_join, 1, 1, 0, | 935 | DEFUN ("thread-join", Fthread_join, Sthread_join, 1, 1, 0, |
| 935 | doc: /* Wait for THREAD to exit. | 936 | doc: /* Wait for THREAD to exit. |
| 936 | This blocks the current thread until THREAD exits or until | 937 | This blocks the current thread until THREAD exits or until the current |
| 937 | the current thread is signaled. | 938 | thread is signaled. It returns the result of the THREAD function. It |
| 938 | It is an error for a thread to try to join itself. */) | 939 | is an error for a thread to try to join itself. */) |
| 939 | (Lisp_Object thread) | 940 | (Lisp_Object thread) |
| 940 | { | 941 | { |
| 941 | struct thread_state *tstate; | 942 | struct thread_state *tstate; |
| 943 | Lisp_Object error_symbol, error_data; | ||
| 942 | 944 | ||
| 943 | CHECK_THREAD (thread); | 945 | CHECK_THREAD (thread); |
| 944 | tstate = XTHREAD (thread); | 946 | tstate = XTHREAD (thread); |
| @@ -946,10 +948,16 @@ It is an error for a thread to try to join itself. */) | |||
| 946 | if (tstate == current_thread) | 948 | if (tstate == current_thread) |
| 947 | error ("Cannot join current thread"); | 949 | error ("Cannot join current thread"); |
| 948 | 950 | ||
| 951 | error_symbol = tstate->error_symbol; | ||
| 952 | error_data = tstate->error_data; | ||
| 953 | |||
| 949 | if (thread_alive_p (tstate)) | 954 | if (thread_alive_p (tstate)) |
| 950 | flush_stack_call_func (thread_join_callback, tstate); | 955 | flush_stack_call_func (thread_join_callback, tstate); |
| 951 | 956 | ||
| 952 | return Qnil; | 957 | if (!NILP (error_symbol)) |
| 958 | Fsignal (error_symbol, error_data); | ||
| 959 | |||
| 960 | return tstate->result; | ||
| 953 | } | 961 | } |
| 954 | 962 | ||
| 955 | DEFUN ("all-threads", Fall_threads, Sall_threads, 0, 0, 0, | 963 | DEFUN ("all-threads", Fall_threads, Sall_threads, 0, 0, 0, |
| @@ -1017,6 +1025,7 @@ init_main_thread (void) | |||
| 1017 | main_thread.m_saved_last_thing_searched = Qnil; | 1025 | main_thread.m_saved_last_thing_searched = Qnil; |
| 1018 | main_thread.name = Qnil; | 1026 | main_thread.name = Qnil; |
| 1019 | main_thread.function = Qnil; | 1027 | main_thread.function = Qnil; |
| 1028 | main_thread.result = Qnil; | ||
| 1020 | main_thread.error_symbol = Qnil; | 1029 | main_thread.error_symbol = Qnil; |
| 1021 | main_thread.error_data = Qnil; | 1030 | main_thread.error_data = Qnil; |
| 1022 | main_thread.event_object = Qnil; | 1031 | main_thread.event_object = Qnil; |
| @@ -1090,8 +1099,7 @@ syms_of_threads (void) | |||
| 1090 | DEFSYM (Qmutexp, "mutexp"); | 1099 | DEFSYM (Qmutexp, "mutexp"); |
| 1091 | DEFSYM (Qcondition_variable_p, "condition-variable-p"); | 1100 | DEFSYM (Qcondition_variable_p, "condition-variable-p"); |
| 1092 | 1101 | ||
| 1093 | DEFVAR_LISP ("main-thread", | 1102 | DEFVAR_LISP ("main-thread", Vmain_thread, |
| 1094 | Vmain_thread, | ||
| 1095 | doc: /* The main thread of Emacs. */); | 1103 | doc: /* The main thread of Emacs. */); |
| 1096 | #ifdef THREADS_ENABLED | 1104 | #ifdef THREADS_ENABLED |
| 1097 | XSETTHREAD (Vmain_thread, &main_thread); | 1105 | 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 | |||
| 52 | /* The thread's function. */ | 52 | /* The thread's function. */ |
| 53 | Lisp_Object function; | 53 | Lisp_Object function; |
| 54 | 54 | ||
| 55 | /* The thread's result, if function has finished. */ | ||
| 56 | Lisp_Object result; | ||
| 57 | |||
| 55 | /* If non-nil, this thread has been signaled. */ | 58 | /* If non-nil, this thread has been signaled. */ |
| 56 | Lisp_Object error_symbol; | 59 | Lisp_Object error_symbol; |
| 57 | Lisp_Object error_data; | 60 | 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 @@ | |||
| 100 | (progn | 100 | (progn |
| 101 | (setq threads-test-global nil) | 101 | (setq threads-test-global nil) |
| 102 | (let ((thread (make-thread #'threads-test-thread1))) | 102 | (let ((thread (make-thread #'threads-test-thread1))) |
| 103 | (thread-join thread) | 103 | (and (= (thread-join thread) 23) |
| 104 | (and threads-test-global | 104 | (= threads-test-global 23) |
| 105 | (not (thread-alive-p thread))))))) | 105 | (not (thread-alive-p thread))))))) |
| 106 | 106 | ||
| 107 | (ert-deftest threads-join-self () | 107 | (ert-deftest threads-join-self () |
| 108 | "Cannot `thread-join' the current thread." | 108 | "Cannot `thread-join' the current thread." |
| 109 | (skip-unless (featurep 'threads)) | 109 | (skip-unless (featurep 'threads)) |
| 110 | (should-error (thread-join (current-thread)))) | 110 | (should-error (thread-join (current-thread)))) |
| 111 | 111 | ||
| 112 | (ert-deftest threads-join-error () | ||
| 113 | "Test of error signalling from `thread-join'." | ||
| 114 | :tags '(:unstable) | ||
| 115 | (skip-unless (featurep 'threads)) | ||
| 116 | (let ((thread (make-thread #'threads-call-error))) | ||
| 117 | (while (thread-alive-p thread) | ||
| 118 | (thread-yield)) | ||
| 119 | (should-error (thread-join thread)))) | ||
| 120 | |||
| 112 | (defvar threads-test-binding nil) | 121 | (defvar threads-test-binding nil) |
| 113 | 122 | ||
| 114 | (defun threads-test-thread2 () | 123 | (defun threads-test-thread2 () |
| @@ -197,7 +206,7 @@ | |||
| 197 | (ert-deftest threads-mutex-signal () | 206 | (ert-deftest threads-mutex-signal () |
| 198 | "Test signaling a blocked thread." | 207 | "Test signaling a blocked thread." |
| 199 | (skip-unless (featurep 'threads)) | 208 | (skip-unless (featurep 'threads)) |
| 200 | (should | 209 | (should-error |
| 201 | (progn | 210 | (progn |
| 202 | (setq threads-mutex (make-mutex)) | 211 | (setq threads-mutex (make-mutex)) |
| 203 | (setq threads-mutex-key nil) | 212 | (setq threads-mutex-key nil) |
| @@ -206,8 +215,10 @@ | |||
| 206 | (while (not threads-mutex-key) | 215 | (while (not threads-mutex-key) |
| 207 | (thread-yield)) | 216 | (thread-yield)) |
| 208 | (thread-signal thr 'quit nil) | 217 | (thread-signal thr 'quit nil) |
| 209 | (thread-join thr)) | 218 | ;; `quit' is not catched by `should-error'. We must indicate it. |
| 210 | t))) | 219 | (condition-case nil |
| 220 | (thread-join thr) | ||
| 221 | (quit (signal 'error nil))))))) | ||
| 211 | 222 | ||
| 212 | (defun threads-test-io-switch () | 223 | (defun threads-test-io-switch () |
| 213 | (setq threads-test-global 23)) | 224 | (setq threads-test-global 23)) |