From b8b18feff29f1af93f857fce2bb34b2479769807 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Sun, 2 Mar 2025 16:02:46 +0800 Subject: [PATCH] Run Android tests in the initial frame * test/infra/android/early-init.el: New file. * test/infra/android/test-controller.el (ats-connect): Upload `early-init.el' to the staging directory and configure that directory as the Emacs instance's initialization directory. (ats-run-test): Always append to the test buffer. Execute tests within terminal-frame. (ats-run-all-tests): Gracefully respond to errors. (ats-cmd-error): New function. (ats-execute-tests-batch): Accept a number of command line arguments. (cherry picked from commit a8988ce80004af57f3741dc059c5a97cb83dca64) --- test/infra/android/early-init.el | 33 ++++ test/infra/android/test-controller.el | 223 ++++++++++++++++++++------ 2 files changed, 204 insertions(+), 52 deletions(-) create mode 100644 test/infra/android/early-init.el diff --git a/test/infra/android/early-init.el b/test/infra/android/early-init.el new file mode 100644 index 00000000000..abf8eed2692 --- /dev/null +++ b/test/infra/android/early-init.el @@ -0,0 +1,33 @@ +;;; Suppress deletion of the initial frame by `frame-initialize'. + +;; Copyright (C) 2025 Free Software Foundation, Inc. + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see . + + + +(message "Loading early-init.el...") + +(advice-add 'frame-initialize :around + (lambda (oldfun &rest args) + (let ((subr (symbol-function 'delete-frame)) + (terminal-frame terminal-frame)) + (unwind-protect + (progn + (message "Suppressed deletion of the initial frame.") + (fset 'delete-frame #'ignore) + (apply oldfun args)) + (fset 'delete-frame subr))))) diff --git a/test/infra/android/test-controller.el b/test/infra/android/test-controller.el index 38d486c3c02..4a8b592648b 100644 --- a/test/infra/android/test-controller.el +++ b/test/infra/android/test-controller.el @@ -1764,13 +1764,25 @@ this machine and an SSH daemon be executing on the host)." device emacs-username "org.gnu.emacs" "org.gnu.emacs" user)))))) ;; Upload the test driver. (let* ((ats-adb-host host) + (staging-directory (ats-get-staging-directory device + "org.gnu.emacs" + user)) (ats-file (let ((file (and ats-file-directory (concat (file-name-as-directory ats-file-directory) "test-driver.el")))) (or (and file (file-exists-p file) file) (read-file-name "ATS test driver file: ")))) + (ats-early-init-file + (let ((file (and ats-file-directory + (concat (file-name-as-directory + ats-file-directory) + "early-init.el")))) + (or (and file (file-exists-p file) file) + (read-file-name "ATS early-init file: ")))) (file (ats-upload device ats-file "org.gnu.emacs" user)) + (_ (ats-upload device ats-early-init-file + "org.gnu.emacs" user)) ;; Start the server. (server-port (ats-start-server)) ;; Forward the server to the ADB host. @@ -1806,7 +1818,13 @@ this machine and an SSH daemon be executing on the host)." device user `((:component . "org.gnu.emacs/.EmacsActivity") ("org.gnu.emacs.STARTUP_ARGUMENTS" - "-q" "--load" ,file "--eval" + "--load" ,file + ;; Set the Emacs home directory to the ATS staging + ;; directory, where an early-init.el should be + ;; uploaded that inhibits the deletion of the + ;; initial frame. + "--init-directory" ,staging-directory + "--eval" ,(format "(ats-establish-connection \"localhost\" %d \"%s\")" remote-port uuid)))) (setq process @@ -1837,7 +1855,12 @@ this machine and an SSH daemon be executing on the host)." device user `((:component . "org.gnu.emacs/.EmacsActivity") ("org.gnu.emacs.STARTUP_ARGUMENTS" - "-q" "--load" ,file "--eval" + "--load" ,file + ;; Set the Emacs home directory to the ATS staging + ;; directory, where an early-init.el should be uploaded that + ;; inhibits the deletion of the initial frame. + "--init-directory" ,staging-directory + "--eval" ,(format "(ats-initiate-connection %S)" commfile)))) (let* ((portno (with-timeout (ats-await-connection-timeout @@ -2422,6 +2445,7 @@ Display the output of the tests executed in a buffer." ;; Delete all tests, load the byte-compiled test file, and execute ;; those tests just defined subject to SELECTOR. (with-current-buffer (get-buffer-create "*Test Output*") + (goto-char (point-max)) (insert (format "=== Executing %s on %s ===\n" test device)) (redisplay) (setq rc (ats-eval process @@ -2429,23 +2453,23 @@ Display the output of the tests executed in a buffer." (require 'ert) (ert-delete-all-tests) (load ,file-name) - (with-temp-buffer - (let* ((temp-buffer (current-buffer)) - (standard-output temp-buffer) - ;; Disable remote tests for the - ;; present... - (ert-remote-temporary-file-directory - null-device) - (overriding-text-conversion-style nil) - (set-message-function - (lambda (message) - (with-current-buffer temp-buffer - (insert message "\n"))))) - (let ((noninteractive t)) - ;; Prevent activation of the mark and - ;; other actions taken by the tests - ;; from affecting the test buffer. - (with-temp-buffer + (with-selected-frame terminal-frame + (with-temp-buffer + (let* ((temp-buffer (current-buffer)) + (standard-output temp-buffer) + ;; Disable remote tests for the + ;; present... + (ert-remote-temporary-file-directory + null-device) + (overriding-text-conversion-style nil) + (message-log-max t) + ;; It isn't possible for + ;; Vset_message_function to take + ;; effect when the initial frame + ;; is selected. + (messages-buffer-name + (buffer-name temp-buffer))) + (let ((noninteractive t)) (ert-run-tests-batch ',selector))) (insert "=== Test execution complete ===\n") (buffer-substring-no-properties @@ -2480,10 +2504,18 @@ subject to SELECTOR, as in `ert-run-tests'." (let ((tests (ats-list-tests process))) (dolist-with-progress-reporter (test tests) "Running tests..." - (ats-run-test process test selector)))) + (condition-case err + (ats-run-test process test selector) + (t (progn + (message "Error in executing `%s': %S" test err))))))) +(defun ats-cmd-error (format &rest args) + "Print an error message FORMAT, formatted with ARGS, and exit." + (apply #'message format args) + (kill-emacs 1)) + ;; Batch mode text execution. (defun ats-execute-tests-batch () "Execute tests in batch mode, in the manner of `test/Makefile'. @@ -2491,46 +2523,133 @@ Prompt for a device and execute tests on the same. Save log files to a directory specified by the user. Call this function from the command line, with, for example: - $ emacs --batch -l test-controller.el -f ats-execute-tests-batch" + $ emacs --batch -l test-controller.el -f ats-execute-tests-batch + +The following command-line arguments are also accepted: + + -h Print help text. + --device, -s DEVICE Serial number of a device to which to connect. + --user, -a UID ID of the user as which to execute tests. + --stub-file Name of `stub.zip' wrapper required on Android <= 4.4. + --test-dir Directory in which Emacs's tests are situated. + --output-dir, -o DIR Name of a directory into which to save test logs. + --no-upload Don't upload tests; only run those which already exist." (let* ((ats-adb-host (getenv "ATS_ADB_HOST")) (devices (ats-enumerate-devices (lambda (name state _) (and (equal state "device") (ignore-errors - (ats-get-package-aid name "org.gnu.emacs"))))))) - (message "These devices are presently available for test execution:") - (let ((nth 0)) - (dolist (device devices) - (message "%2d. %-24s(API level %d, %s)" - (setq nth (1+ nth)) (car device) - (ats-get-sdk-version (car device)) - (ats-getprop (car device) "ro.product.cpu.abi")))) - (let* ((number (string-to-number - (read-string - "Select a device by typing its number, and Return: "))) - (device (if (or (< number 1) (> number (length devices))) - (user-error "Invalid selection: %s" number) - (car (nth (1- number) devices)))) + (ats-get-package-aid name "org.gnu.emacs")))))) + (cmd-device nil) + (cmd-user nil) + (cmd-output-dir nil) + (cmd-no-upload nil)) + ;; Read command-line arguments. + (let (arg) + (while (setq arg (pop argv)) + (cond ((equal arg "-f") (pop argv)) ;; Do nothing. Emacs does + ;; not remove this from argv + ;; for unknown reasons. + ((equal arg "-h") + (message "Execute this file from the command line, with,\ + for example: + + $ emacs --batch -l test-controller.el -f ats-execute-tests-batch + +The following command-line arguments are also accepted: + + --h Print this help text. + --device, -s DEVICE Serial number of a device to which to connect. + --user, -a UID ID of the user as which to execute tests. + --stub-file Name of `stub.zip' wrapper required on Android <= 4.4. + --test-dir Directory in which Emacs's tests are situated. + --output-dir, -o DIR Name of a directory into which to save test logs. + --no-upload Don't upload tests; only run those which already exist.") + (kill-emacs 0)) + ((or (equal arg "-s") (equal arg "--device")) + (setq cmd-device + (or (pop argv) + (ats-cmd-error + "Expected argument to `--device' option")))) + ((or (equal arg "-a") (equal arg "--user")) + (setq cmd-user + (or (pop argv) + (ats-cmd-error + "Expected argument to `--user' option")))) + ((or (equal arg "-o") (equal arg "--output-dir")) + (setq cmd-output-dir + (or (pop argv) + (ats-cmd-error + "Expected argument to `--output-dir' option")))) + ((equal arg "--stub-file") + (setq ats-working-stub-file + (or (pop argv) + (ats-cmd-error + "Expected argument to `--stub-file' option.")))) + ((equal arg "--test-dir") + (setq ats-emacs-test-directory + (or (pop argv) + (ats-cmd-error + "Expected argument to `--test-dir' option.")))) + ((equal arg "--no-upload") + (setq cmd-no-upload t)) + (t (ats-cmd-error "Unknown command line argument `%s'" arg))))) + ;; Validate and apply command-line arguments or prompt the user for + ;; parameters in their absence. + (if cmd-device + (unless (member cmd-device (mapcar #'car devices)) + (ats-cmd-error + "Device `%s' does not exist or has no installation of Emacs" + cmd-device)) + (message "These devices are presently available for test execution:") + (let ((nth 0)) + (dolist (device devices) + (message "%2d. %-24s(API level %d, %s)" + (setq nth (1+ nth)) (car device) + (ats-get-sdk-version (car device)) + (ats-getprop (car device) "ro.product.cpu.abi"))))) + (let* ((number (and (not cmd-device) + (string-to-number + (read-string + "Select a device by typing its number, and Return: ")))) + (device (or cmd-device + (if (or (< number 1) (> number (length devices))) + (ats-cmd-error "Invalid selection: %s" number) + (car (nth (1- number) devices))))) (users (ats-list-users device)) - (nth 0)) - (dolist (user users) - (message "%2d. %s (id=%d)" (setq nth (1+ nth)) - (cadr user) (car user))) - (setq number (string-to-number - (read-string - "As which user should tests be executed? "))) - (when (or (< number 1) (> number (length users))) - (user-error "Invalid selection: %s" number)) - (let* ((user (car (nth (1- number) users))) + (nth 0) + (user nil)) + (if cmd-user + (progn + (let ((valid-number (string-match-p "^[[:digit:]]+$" cmd-user)) + (uid (string-to-number cmd-user))) + (unless valid-number + (ats-cmd-error "Invalid value for `--user' argument: %s" + cmd-user)) + (unless (assq uid users) + (ats-cmd-error "No such user exists: %d" uid)) + ;; Don't prompt the user afterwards. + (setq user uid))) + (dolist (user users) + (message "%2d. %s (id=%d)" (setq nth (1+ nth)) + (cadr user) (car user))) + (setq number (string-to-number + (read-string + "As which user should tests be executed? "))) + (when (or (< number 1) (> number (length users))) + (ats-cmd-error "Invalid selection: %s" number))) + (let* ((user (or user (car (nth (1- number) users)))) (connection (ats-connect device user))) - (ats-upload-all-tests - connection - (or ats-emacs-test-directory - (read-directory-name "Test base directory: " - nil nil t))) + (unless cmd-no-upload + (ats-upload-all-tests + connection + (or ats-emacs-test-directory + (read-directory-name "Test base directory: " + nil nil t)))) (let ((output-directory - (read-directory-name - "Where to save test log files? "))) + (or cmd-output-dir + (read-directory-name + "Where to save test log files? ")))) (mkdir output-directory t) (let ((tests (ats-list-tests connection))) (dolist (test tests) -- 2.39.5