Specifically report attempts to exit Emacs during test execution

* test/infra/android/test-driver.el (ats-in-eval): Fix typo in
doc string.
(ats-eval-as-printed, ats-eval-serial, ats-eval-do-decode):
Render buffer-local.
(ats-executing-form): New variable.
(ats-process-filter): Bind the same around `eval'.
(ats-kill-emacs-function): New function; register it to execute
when Emacs exits.

(cherry picked from commit 749e33bb481eedbefe0fd24124b446f9c47728d5)

diff --git a/test/infra/android/test-driver.el b/test/infra/android/test-driver.el
index 5afbb78cdcdad1113ae0034b1e9a046760d590bd..ff9590d8d9f973108c8e18dd97fb8ea1781e21a8 100644 (file)
--- a/test/infra/android/test-driver.el
+++ b/test/infra/android/test-driver.el
@@ -1,5 +1,5 @@
 ;;; Receive and execute Lisp code submitted by a test controller.  -*- lexical-binding: t; -*-
-;;; $Id: ats-driver.el,v 1.8 2025/03/02 11:11:56 jw Exp $
+;;; $Id: ats-driver.el,v 1.9 2025/03/02 12:52:57 jw Exp $
 
 ;; Copyright (C) 2025 Free Software Foundation, Inc.
 
@@ -43,18 +43,21 @@
                         :inherit variable-pitch))
   "Face of ATS header elements.")
 
-(defvar-local ats-in-eval nil
-  "Whether an `-eval' command is being processed and form's size.")
+(defvar ats-in-eval nil
+  "Whether an `-eval' command is being processed and the form's size.")
 
-(defvar-local ats-eval-as-printed nil
+(defvar ats-eval-as-printed nil
   "Whether to return the values of the submitted form as a string.")
 
-(defvar-local ats-eval-serial nil
+(defvar ats-eval-serial nil
   "Serial number identifying this result.")
 
-(defvar-local ats-eval-do-decode nil
+(defvar ats-eval-do-decode nil
   "Whether to decode the form provided as utf-8-emacs.")
 
+(defvar ats-executing-form nil
+  "Bound to `true' when executing a submitted form.")
+
 (defun ats-process-filter (process string)
   "Filter input from `ats-process'.
 Insert STRING into the connection buffer, till a full command is
@@ -126,7 +129,8 @@ read."
                                                  str 'utf-8-emacs t)
                                               str))
                                        (expr (car (read-from-string str)))
-                                       (value (eval expr)))
+                                       (value (let ((ats-executing-form t))
+                                                (eval expr))))
                                   (cons 'ok value)))
                             (t (cons 'error err))))))
                    (let* ((print-escape-control-characters t)
@@ -212,6 +216,43 @@ the controller."
     (message "; Listening for connection from controller at localhost:%d"
             service)))
 
+\f
+
+;; `kill-emacs' interception.
+
+(defun ats-kill-emacs-function ()
+  "Print a message announcing that Emacs is exiting.
+Also, if executing a Lisp form, reply to the controller with the
+backtrace of the exit before really exiting."
+  (when-let* ((standard-output #'external-debugging-output)
+             (process ats-process))
+    (princ (if ats-executing-form
+              "Emacs is attempting to exit while evaluating a form...\n"
+            "Emacs is exiting...\n"))
+    (backtrace)
+    (when ats-in-eval
+      (with-temp-buffer
+       (let ((standard-output (current-buffer)))
+         (backtrace)
+         (let ((err (cons 'exit (buffer-string))))
+           (let* ((print-escape-control-characters t)
+                  (print-escape-newlines t)
+                  (str (encode-coding-string
+                        (prin1-to-string err) 'utf-8-emacs t)))
+             (if ats-eval-as-printed
+                 (let* ((quoted (prin1-to-string str)))
+                   (process-send-string
+                    process (format "\fats-request:%d %d\n"
+                                    ats-eval-serial
+                                    (length quoted)))
+                   (process-send-string process quoted))
+               (process-send-string
+                process (format "\fats-request:%d %d\n"
+                                ats-eval-serial
+                                (length str)))
+               (process-send-string process str)))))))))
+(add-hook 'kill-emacs-hook #'ats-kill-emacs-function)
+
 (provide 'test-driver)
 
 ;;; test-driver.el ends here