[Emacs-diffs] master 798cbac: Add variable main-thread, fix Bug#32169

[Michael Albinus]

branch: master
commit 798cbac170f05a749a4d5130d64d83c202f09158
Author: Michael Albinus <address@hidden>
Commit: Michael Albinus <address@hidden>

    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.
---
 doc/lispref/threads.texi | 19 +++++++++++++++++--
 src/thread.c             | 23 +++++++++++++++++++----
 test/src/thread-tests.el | 11 ++++++++++-
 3 files changed, 46 insertions(+), 7 deletions(-)

diff --git a/doc/lispref/threads.texi b/doc/lispref/threads.texi
index f05af49..4cef9c9 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:
+
address@hidden
+(thread-signal main-thread 'error data)
+(signal 'error data)
address@hidden 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
 
address@hidden main-thread
+This variable keeps the main thread Emacs is running, or @code{nil} if
+Emacs is compiled without thread support.
address@hidden 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.
 
address@hidden thread-last-error
address@hidden 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
address@hidden, the stored form is reset to @code{nil}.
 @end defun
 
 @node Mutexes
diff --git a/src/thread.c b/src/thread.c
index 3eba25b..754d286 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 a00a9c8..a447fb3 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))))