From: Po Lu <luangruo@yahoo.com>
Date: Sun, 2 Mar 2025 12:54:36 +0000 (+0800)
Subject: Specifically report attempts to exit Emacs during test execution
X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=9a3fde1fbeacd85f210aa3978ed15affba74097b;p=emacs.git

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 5afbb78cdcd..ff9590d8d9f 100644
--- 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)))
 
+
+
+;; `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