From: Michael Albinus <michael.albinus@gmx.de>
Date: Tue, 17 Jul 2018 10:03:43 +0000 (+0200)
Subject: Add variable main-thread, fix Bug#32169
X-Git-Tag: emacs-27.0.90~4664^2~71
X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=798cbac170f05a749a4d5130d64d83c202f09158;p=emacs.git

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.
---

diff --git a/doc/lispref/threads.texi b/doc/lispref/threads.texi
index f05af496188..4cef9c9c6e8 100644
--- a/doc/lispref/threads.texi
+++ b/doc/lispref/threads.texi
@@ -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
diff --git a/src/thread.c b/src/thread.c
index 3eba25b7b43..754d286e9f8 100644
--- a/src/thread.c
+++ b/src/thread.c
@@ -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
 }
diff --git a/test/src/thread-tests.el b/test/src/thread-tests.el
index a00a9c84bd6..a447fb3914e 100644
--- a/test/src/thread-tests.el
+++ b/test/src/thread-tests.el
@@ -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))))