Rudimentary error handling for non-main threads

* src/thread.c (last_thread_error): New static variable.
(syms_of_threads): Staticpro it.
(record_thread_error, Fthread_last_error): New functions.
(syms_of_threads): Defsubr Fthread_last_error.

* doc/lispref/threads.texi (Basic Thread Functions): Document
thread-last-error.

* test/src/thread-tests.el (thread-errors, thread-signal-early)
(threads-condvar-wait): Test the values returned by
thread-last-error.

3 files changed, 41 insertions, 7 deletions

diff --git a/doc/lispref/threads.texi b/doc/lispref/threads.texi
index d6cf99d2332..71742f576e5 100644
--- a/doc/lispref/threads.texi
+++ b/doc/lispref/threads.texi
@@ -127,6 +127,17 @@ Return a list of all the live thread objects.  A new list is returned
 by each invocation.
 @end defun
 
+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
+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.
+@end defun
+
 @node Mutexes
 @section Mutexes
 
diff --git a/src/thread.c b/src/thread.c
index 5498fe5efcb..6048516659e 100644
--- a/src/thread.c
+++ b/src/thread.c
@@ -663,10 +663,13 @@ invoke_thread_function (void)
   return unbind_to (count, Qnil);
 }
 
+static Lisp_Object last_thread_error;
+
 static Lisp_Object
-do_nothing (Lisp_Object whatever)
+record_thread_error (Lisp_Object error_form)
 {
-  return whatever;
+  last_thread_error = error_form;
+  return error_form;
 }
 
 static void *
@@ -695,7 +698,7 @@ run_thread (void *state)
   handlerlist_sentinel->next = NULL;
 
   /* It might be nice to do something with errors here.  */
-  internal_condition_case (invoke_thread_function, Qt, do_nothing);
+  internal_condition_case (invoke_thread_function, Qt, record_thread_error);
 
   update_processes_for_thread_death (Fcurrent_thread ());
 
@@ -944,6 +947,13 @@ 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)
+{
+  return last_thread_error;
+}
+
 
 
 bool
@@ -1028,6 +1038,10 @@ syms_of_threads (void)
       defsubr (&Scondition_notify);
       defsubr (&Scondition_mutex);
       defsubr (&Scondition_name);
+      defsubr (&Sthread_last_error);
+
+      staticpro (&last_thread_error);
+      last_thread_error = Qnil;
     }
 
   DEFSYM (Qthreadp, "threadp");
diff --git a/test/src/thread-tests.el b/test/src/thread-tests.el
index df8222a21aa..849b2e3dd1b 100644
--- a/test/src/thread-tests.el
+++ b/test/src/thread-tests.el
@@ -222,8 +222,15 @@
 
 (ert-deftest thread-errors ()
   "Test what happens when a thread signals an error."
-    (should (threadp (make-thread #'call-error "call-error")))
-    (should (threadp (make-thread #'thread-custom "thread-custom"))))
+  (let (th1 th2)
+    (setq th1 (make-thread #'call-error "call-error"))
+    (should (threadp th1))
+    (while (thread-alive-p th1)
+      (thread-yield))
+    (should (equal (thread-last-error)
+                   '(error "Error is called")))
+    (setq th2 (make-thread #'thread-custom "thread-custom"))
+    (should (threadp th2))))
 
 (ert-deftest thread-sticky-point ()
   "Test bug #25165 with point movement in cloned buffer."
@@ -242,7 +249,8 @@
                           (while t (thread-yield))))))
     (thread-signal thread 'error nil)
     (sit-for 1)
-    (should-not (thread-alive-p thread))))
+    (should-not (thread-alive-p thread))
+    (should (equal (thread-last-error) '(error)))))
 
 (defvar threads-condvar nil)
 
@@ -287,6 +295,7 @@
     (thread-signal new-thread 'error '("Die, die, die!"))
     (sleep-for 0.1)
     ;; Make sure the thread died.
-    (should (= (length (all-threads)) 1))))
+    (should (= (length (all-threads)) 1))
+    (should (equal (thread-last-error) '(error "Die, die, die!")))))
 
 ;;; threads.el ends here