Backport: Minor changes in tramp-tests.el

* test/lisp/net/tramp-tests.el (tramp--test-shell-file-name):
Use connection-local value.
(tramp--test-shell-command-switch): New defun.
(tramp-test28-process-file)
(tramp-test34-explicit-shell-file-name): Use it.
(tramp--test-supports-processes-p): Simplify.
(tramp--test-check-files): Use `tramp-compat-seq-keep'.
(tramp-test45-asynchronous-requests): Don't let-bind `shell-file-name'.
(tramp-test45-asynchronous-requests): Adjust timer.
(tramp-test45-asynchronous-requests): Add another test message.

(cherry picked from commit c95caade15)
This commit is contained in:
Michael Albinus 2024-06-22 19:52:06 +02:00
parent 1728de5a77
commit d9bd1718f9

View file

@ -5066,10 +5066,13 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
(defun tramp--test-shell-file-name () (defun tramp--test-shell-file-name ()
"Return default remote shell." "Return default remote shell."
(if (file-exists-p (let ((default-directory ert-remote-temporary-file-directory))
(concat (tramp-compat-connection-local-value shell-file-name)))
(file-remote-p ert-remote-temporary-file-directory) "/system/bin/sh"))
"/system/bin/sh" "/bin/sh")) (defun tramp--test-shell-command-switch ()
"Return default remote shell command switch."
(let ((default-directory ert-remote-temporary-file-directory))
(tramp-compat-connection-local-value shell-command-switch)))
(ert-deftest tramp-test28-process-file () (ert-deftest tramp-test28-process-file ()
"Check `process-file'." "Check `process-file'."
@ -5086,14 +5089,14 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
(unwind-protect (unwind-protect
(progn (progn
;; We cannot use "/bin/true" and "/bin/false"; those paths ;; We cannot use "/bin/true" and "/bin/false"; those paths
;; do not exist on hydra. ;; do not exist on hydra and on MS Windows.
(should (zerop (process-file "true"))) (should (zerop (process-file "true")))
(should-not (zerop (process-file "false"))) (should-not (zerop (process-file "false")))
(should-not (zerop (process-file "binary-does-not-exist"))) (should-not (zerop (process-file "binary-does-not-exist")))
;; Return exit code. ;; Return exit code.
(should (= 42 (process-file (should (= 42 (process-file
(tramp--test-shell-file-name) (tramp--test-shell-file-name) nil nil nil
nil nil nil "-c" "exit 42"))) (tramp--test-shell-command-switch) "exit 42")))
;; Return exit code in case the process is interrupted, ;; Return exit code in case the process is interrupted,
;; and there's no indication for a signal describing string. ;; and there's no indication for a signal describing string.
(unless (tramp--test-sshfs-p) (unless (tramp--test-sshfs-p)
@ -5101,8 +5104,8 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
(should (should
(= (+ 128 2) (= (+ 128 2)
(process-file (process-file
(tramp--test-shell-file-name) (tramp--test-shell-file-name) nil nil nil
nil nil nil "-c" "kill -2 $$"))))) (tramp--test-shell-command-switch) "kill -2 $$")))))
;; Return string in case the process is interrupted and ;; Return string in case the process is interrupted and
;; there's an indication for a signal describing string. ;; there's an indication for a signal describing string.
(unless (tramp--test-sshfs-p) (unless (tramp--test-sshfs-p)
@ -5111,8 +5114,8 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
(string-match-p (string-match-p
(rx (| "Interrupt" "Signal 2")) (rx (| "Interrupt" "Signal 2"))
(process-file (process-file
(tramp--test-shell-file-name) (tramp--test-shell-file-name) nil nil nil
nil nil nil "-c" "kill -2 $$"))))) (tramp--test-shell-command-switch) "kill -2 $$")))))
;; Check DESTINATION. ;; Check DESTINATION.
(dolist (destination `(nil t ,buffer)) (dolist (destination `(nil t ,buffer))
@ -6292,7 +6295,8 @@ INPUT, if non-nil, is a string sent to the process."
(connection-local-set-profile-variables (connection-local-set-profile-variables
'remote-sh 'remote-sh
`((explicit-shell-file-name . ,(tramp--test-shell-file-name)) `((explicit-shell-file-name . ,(tramp--test-shell-file-name))
(explicit-sh-args . ("-c" "echo foo")))) (explicit-sh-args
. (,(tramp--test-shell-command-switch) "echo foo"))))
(connection-local-set-profiles (connection-local-set-profiles
`(:application tramp `(:application tramp
:protocol ,(file-remote-p default-directory 'method) :protocol ,(file-remote-p default-directory 'method)
@ -7251,14 +7255,14 @@ This requires restrictions of file name syntax."
(defun tramp--test-supports-processes-p () (defun tramp--test-supports-processes-p ()
"Return whether the method under test supports external processes." "Return whether the method under test supports external processes."
(unless (tramp--test-crypt-p)
;; We use it to enable/disable tests in a given test run, for ;; We use it to enable/disable tests in a given test run, for
;; example for remote processes on MS Windows. ;; example for remote processes on MS Windows.
(if (tramp-connection-property-p (if (tramp-connection-property-p
tramp-test-vec "tramp--test-supports-processes-p") tramp-test-vec "tramp--test-supports-processes-p")
(tramp-get-connection-property (tramp-get-connection-property
tramp-test-vec "tramp--test-supports-processes-p") tramp-test-vec "tramp--test-supports-processes-p")
(and (or (tramp--test-adb-p) (tramp--test-sh-p) (tramp--test-sshfs-p)) (or (tramp--test-adb-p) (tramp--test-sh-p) (tramp--test-sshfs-p)))))
(not (tramp--test-crypt-p)))))
(defun tramp--test-supports-set-file-modes-p () (defun tramp--test-supports-set-file-modes-p ()
"Return whether the method under test supports setting file modes." "Return whether the method under test supports setting file modes."
@ -7283,8 +7287,8 @@ This requires restrictions of file name syntax."
(tmp-name1 (tramp--test-make-temp-name nil quoted)) (tmp-name1 (tramp--test-make-temp-name nil quoted))
(tmp-name2 (tramp--test-make-temp-name 'local quoted)) (tmp-name2 (tramp--test-make-temp-name 'local quoted))
(files (files
(delq (tramp-compat-seq-keep
nil (mapcar (lambda (x) (unless (string-empty-p x) x)) files))) (lambda (x) (unless (string-empty-p x) x)) files))
(process-environment process-environment) (process-environment process-environment)
(sorted-files (sort (copy-sequence files) #'string-lessp)) (sorted-files (sort (copy-sequence files) #'string-lessp))
buffer) buffer)
@ -7724,7 +7728,6 @@ process sentinels. They shall not disturb each other."
(define-key special-event-map [sigusr1] #'tramp--test-timeout-handler) (define-key special-event-map [sigusr1] #'tramp--test-timeout-handler)
(let* (;; For the watchdog. (let* (;; For the watchdog.
(default-directory (expand-file-name temporary-file-directory)) (default-directory (expand-file-name temporary-file-directory))
(shell-file-name (tramp--test-shell-file-name))
;; It doesn't work on w32 systems. ;; It doesn't work on w32 systems.
(watchdog (watchdog
(start-process-shell-command (start-process-shell-command
@ -7794,7 +7797,7 @@ process sentinels. They shall not disturb each other."
"Stop timer %s %s" file (current-time-string)) "Stop timer %s %s" file (current-time-string))
;; Adjust timer if it takes too much time. ;; Adjust timer if it takes too much time.
(when (> (- (float-time) time) timer-repeat) (when (> (- (float-time) time) timer-repeat)
(setq timer-repeat (* 1.1 timer-repeat)) (setq timer-repeat (* 1.1 (- (float-time) time)))
(setf (timer--repeat-delay timer) timer-repeat) (setf (timer--repeat-delay timer) timer-repeat)
(tramp--test-message (tramp--test-message
"Increase timer %s" timer-repeat)))))))) "Increase timer %s" timer-repeat))))))))
@ -7840,7 +7843,8 @@ process sentinels. They shall not disturb each other."
(lambda (proc _state) (lambda (proc _state)
(tramp--test-with-proper-process-name-and-buffer proc (tramp--test-with-proper-process-name-and-buffer proc
(tramp--test-message (tramp--test-message
"Process sentinel %s %s" proc (current-time-string))))))) "Process sentinel %s %s" proc (current-time-string)))))
(tramp--test-message "Process started %s" proc)))
;; Send a string to the processes. Use a random order of ;; Send a string to the processes. Use a random order of
;; the buffers. Mix with regular operation. ;; the buffers. Mix with regular operation.
@ -8300,6 +8304,8 @@ If INTERACTIVE is non-nil, the tests are run interactively."
;; * Implement `tramp-test31-interrupt-process' and ;; * Implement `tramp-test31-interrupt-process' and
;; `tramp-test31-signal-process' for "adb", "sshfs" and for direct ;; `tramp-test31-signal-process' for "adb", "sshfs" and for direct
;; async processes. Check, why they don't run stable. ;; async processes. Check, why they don't run stable.
;; * Check, why `tramp-test45-asynchronous-requests' often fails. The
;; famous reentrant error?
;; * Check, why direct async processes do not work for ;; * Check, why direct async processes do not work for
;; `tramp-test45-asynchronous-requests'. ;; `tramp-test45-asynchronous-requests'.