mirror of
https://github.com/masscollaborationlabs/emacs.git
synced 2025-07-04 11:23:24 +00:00
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:
parent
1728de5a77
commit
d9bd1718f9
1 changed files with 31 additions and 25 deletions
|
@ -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'.
|
||||||
|
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue