aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorMichael Albinus2018-07-22 11:53:24 +0200
committerMichael Albinus2018-07-22 11:53:24 +0200
commite23727978dbb07d68f730ffa60b22d59d065850e (patch)
tree7ed37a1f0078ba6032a7d924f218c764330a98c8
parentb7ca3d5d932bad6900296679ab87f7d0d64d1de9 (diff)
downloademacs-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.texi4
-rw-r--r--etc/NEWS18
-rw-r--r--src/thread.c22
-rw-r--r--src/thread.h3
-rw-r--r--test/src/thread-tests.el23
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
77Block until @var{thread} exits, or until the current thread is 77Block until @var{thread} exits, or until the current thread is
78signaled. If @var{thread} has already exited, this returns 78signaled. It returns the result of the @var{thread} function. If
79immediately. 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
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.
172This triggers to search the program on the remote host as indicated by 172This 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.
177This is handy in Lisp programs that run on a non-main thread and want
178to 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.
578Use of built-in libgnutls based functionality (described in the Emacs 573Use of built-in libgnutls based functionality (described in the Emacs
579GnuTLS manual) is recommended instead. 574GnuTLS 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
624selects the messages to summarize with a regexp that matches the 618selects the messages to summarize with a regexp that matches the
625sender of the current message. 619sender of the current message.
626 620
621** Threads
622
623+++
624*** New variable 'main-thread' holds Emacs's main thread.
625This is handy in Lisp programs that run on a non-main thread and want
626to 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'
739is backwards-compatible with versions of Emacs in which the old function 744is backwards-compatible with versions of Emacs in which the old function
740exists. See the node "Displaying Buffers in Side Windows" in the ELisp 745exists. See the node "Displaying Buffers in Side Windows" in the ELisp
741manual for more details. 746manual 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, &current_thread->function); 684 current_thread->result = Ffuncall (1, &current_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
934DEFUN ("thread-join", Fthread_join, Sthread_join, 1, 1, 0, 935DEFUN ("thread-join", Fthread_join, Sthread_join, 1, 1, 0,
935 doc: /* Wait for THREAD to exit. 936 doc: /* Wait for THREAD to exit.
936This blocks the current thread until THREAD exits or until 937This blocks the current thread until THREAD exits or until the current
937the current thread is signaled. 938thread is signaled. It returns the result of the THREAD function. It
938It is an error for a thread to try to join itself. */) 939is 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
955DEFUN ("all-threads", Fall_threads, Sall_threads, 0, 0, 0, 963DEFUN ("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))