]> git.eshelyaron.com Git - emacs.git/commitdiff
Minor changes in tramp-tests.el
authorMichael Albinus <michael.albinus@gmx.de>
Sat, 22 Jun 2024 17:52:06 +0000 (19:52 +0200)
committerEshel Yaron <me@eshelyaron.com>
Mon, 24 Jun 2024 07:02:38 +0000 (09:02 +0200)
* 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 c95caade15d295fa6cc31d337028faa15142b388)

test/lisp/net/tramp-tests.el

index ebf2a583795ed1537942a0d34540f063b394f9ed..7396efa05c1fccd6327a6ccdff9cf53d0fd98ed0 100644 (file)
@@ -4757,10 +4757,13 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
 
 (defun tramp--test-shell-file-name ()
   "Return default remote shell."
-  (if (file-exists-p
-       (concat
-       (file-remote-p ert-remote-temporary-file-directory) "/system/bin/sh"))
-      "/system/bin/sh" "/bin/sh"))
+  (let ((default-directory ert-remote-temporary-file-directory))
+    (tramp-compat-connection-local-value shell-file-name)))
+
+(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 ()
   "Check `process-file'."
@@ -4777,14 +4780,14 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
       (unwind-protect
          (progn
            ;; 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-not (zerop (process-file "false")))
            (should-not (zerop (process-file "binary-does-not-exist")))
            ;; Return exit code.
            (should (= 42 (process-file
-                          (tramp--test-shell-file-name)
-                          nil nil nil "-c" "exit 42")))
+                          (tramp--test-shell-file-name) nil nil nil
+                          (tramp--test-shell-command-switch) "exit 42")))
            ;; Return exit code in case the process is interrupted,
            ;; and there's no indication for a signal describing string.
            (unless (tramp--test-sshfs-p)
@@ -4792,8 +4795,8 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
                (should
                 (= (+ 128 2)
                    (process-file
-                    (tramp--test-shell-file-name)
-                    nil nil nil "-c" "kill -2 $$")))))
+                    (tramp--test-shell-file-name) nil nil nil
+                    (tramp--test-shell-command-switch) "kill -2 $$")))))
            ;; Return string in case the process is interrupted and
            ;; there's an indication for a signal describing string.
            (unless (tramp--test-sshfs-p)
@@ -4802,8 +4805,8 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
                 (string-match-p
                  (rx (| "Interrupt" "Signal 2"))
                  (process-file
-                  (tramp--test-shell-file-name)
-                  nil nil nil "-c" "kill -2 $$")))))
+                  (tramp--test-shell-file-name) nil nil nil
+                  (tramp--test-shell-command-switch) "kill -2 $$")))))
 
            ;; Check DESTINATION.
            (dolist (destination `(nil t ,buffer))
@@ -5983,7 +5986,8 @@ INPUT, if non-nil, is a string sent to the process."
          (connection-local-set-profile-variables
           'remote-sh
           `((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
           `(:application tramp
             :protocol ,(file-remote-p default-directory 'method)
@@ -6945,14 +6949,14 @@ This requires restrictions of file name syntax."
 
 (defun tramp--test-supports-processes-p ()
   "Return whether the method under test supports external processes."
-  ;; We use it to enable/disable tests in a given test run, for
-  ;; example for remote processes on MS Windows.
-  (if (tramp-connection-property-p
-       tramp-test-vec "tramp--test-supports-processes-p")
-      (tramp-get-connection-property
-       tramp-test-vec "tramp--test-supports-processes-p")
-    (and (or (tramp--test-adb-p) (tramp--test-sh-p) (tramp--test-sshfs-p))
-        (not (tramp--test-crypt-p)))))
+  (unless (tramp--test-crypt-p)
+    ;; We use it to enable/disable tests in a given test run, for
+    ;; example for remote processes on MS Windows.
+    (if (tramp-connection-property-p
+         tramp-test-vec "tramp--test-supports-processes-p")
+       (tramp-get-connection-property
+        tramp-test-vec "tramp--test-supports-processes-p")
+      (or (tramp--test-adb-p) (tramp--test-sh-p) (tramp--test-sshfs-p)))))
 
 (defun tramp--test-supports-set-file-modes-p ()
   "Return whether the method under test supports setting file modes."
@@ -6977,8 +6981,8 @@ This requires restrictions of file name syntax."
           (tmp-name1 (tramp--test-make-temp-name nil quoted))
           (tmp-name2 (tramp--test-make-temp-name 'local quoted))
           (files
-            (delq
-             nil (mapcar (lambda (x) (unless (string-empty-p x) x)) files)))
+            (tramp-compat-seq-keep
+            (lambda (x) (unless (string-empty-p x) x)) files))
           (process-environment process-environment)
           (sorted-files (sort (copy-sequence files) #'string-lessp))
           buffer)
@@ -7418,7 +7422,6 @@ process sentinels.  They shall not disturb each other."
     (define-key special-event-map [sigusr1] #'tramp--test-timeout-handler)
     (let* (;; For the watchdog.
           (default-directory (expand-file-name temporary-file-directory))
-          (shell-file-name (tramp--test-shell-file-name))
           ;; It doesn't work on w32 systems.
           (watchdog
             (start-process-shell-command
@@ -7488,7 +7491,7 @@ process sentinels.  They shall not disturb each other."
                        "Stop timer %s %s" file (current-time-string))
                       ;; Adjust timer if it takes too much time.
                       (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)
                         (tramp--test-message
                          "Increase timer %s" timer-repeat))))))))
@@ -7534,7 +7537,8 @@ process sentinels.  They shall not disturb each other."
                  (lambda (proc _state)
                   (tramp--test-with-proper-process-name-and-buffer proc
                      (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
             ;; the buffers.  Mix with regular operation.
@@ -7994,6 +7998,8 @@ If INTERACTIVE is non-nil, the tests are run interactively."
 ;; * Implement `tramp-test31-interrupt-process' and
 ;;   `tramp-test31-signal-process' for "adb", "sshfs" and for direct
 ;;   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
 ;;   `tramp-test45-asynchronous-requests'.