[Emacs-diffs] master 8147d3c: Work on asynchronous processes for tramp-adb.el

[Michael Albinus]

branch: master
commit 8147d3c27cbf29e18dbdd6bad21cd17bc880a8d3
Author: Michael Albinus <address@hidden>
Commit: Michael Albinus <address@hidden>

    Work on asynchronous processes for tramp-adb.el
    
    * lisp/net/tramp-adb.el (tramp-adb-handle-make-process):
    Simplify.  Remove echoed first line.
    (tramp-adb-send-command): Add NEVEROPEN and NOOUTPUT.
    
    * lisp/net/tramp-sh.el (tramp-process-sentinel): Remove.
    (tramp-sh-handle-make-process): Simplify.
    
    * lisp/net/tramp.el (tramp-process-sentinel): New defun, taken from
    tramp-sh.el.  Delete trailing shell prompt.
    
    * test/lisp/net/tramp-tests.el (tramp-test29-start-file-process)
    (tramp-test30-make-process): Run also for tramp-adb.
    (tramp-test32-shell-command): Remove tramp-adb restrictions.
    (tramp-test34-explicit-shell-file-name): Rework.  Remove :unstable tag.
---
 lisp/net/tramp-adb.el        |  64 +++++++++++++------------
 lisp/net/tramp-sh.el         |  16 +------
 lisp/net/tramp.el            |  13 +++++
 test/lisp/net/tramp-tests.el | 110 ++++++++++++++++++++++++-------------------
 4 files changed, 110 insertions(+), 93 deletions(-)

diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el
index 6896042..db9acbf 100644
--- a/lisp/net/tramp-adb.el
+++ b/lisp/net/tramp-adb.el
@@ -968,7 +968,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are 
completely ignored."
               (program (car command))
               (args (cdr command))
               (command
-               (format "cd %s; %s"
+               (format "cd %s && exec %s"
                        (tramp-shell-quote-argument localname)
                        (mapconcat #'tramp-shell-quote-argument
                                   (cons program args) " ")))
@@ -1000,24 +1000,16 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are 
completely ignored."
                    ;; otherwise we might be interrupted by
                    ;; `verify-visited-file-modtime'.
                    (let ((buffer-undo-list t)
-                         (inhibit-read-only t)
-                         (mark (point)))
+                         (inhibit-read-only t))
                      (clear-visited-file-modtime)
                      (narrow-to-region (point-max) (point-max))
                      ;; We call `tramp-adb-maybe-open-connection', in
                      ;; order to cleanup the prompt afterwards.
                      (tramp-adb-maybe-open-connection v)
-                     (widen)
-                     (delete-region mark (point-max))
-                     (narrow-to-region (point-max) (point-max))
+                     (delete-region (point-min) (point-max))
                      ;; Send the command.
-                     (let* ((p (tramp-get-connection-process v))
-                            (prompt
-                             (tramp-get-connection-property p "prompt" nil)))
-                       (tramp-set-connection-property
-                        p "prompt" (regexp-quote command))
-                       (tramp-adb-send-command v command)
-                       (tramp-set-connection-property p "prompt" prompt)
+                     (let* ((p (tramp-get-connection-process v)))
+                        (tramp-adb-send-command v command nil t) ; nooutput
                        ;; Stop process if indicated.
                        (when stop
                          (stop-process p))
@@ -1032,6 +1024,14 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are 
completely ignored."
                        (ignore-errors
                          (set-process-query-on-exit-flag p (null noquery))
                          (set-marker (process-mark p) (point)))
+                       ;; Read initial output.  Remove the first line,
+                       ;; which is the command echo.
+                       (while
+                           (progn
+                             (goto-char (point-min))
+                             (not (re-search-forward "[\n]" nil t)))
+                         (tramp-accept-process-output p 0))
+                       (delete-region (point-min) (point))
                        ;; Return process.
                        p))))
 
@@ -1119,26 +1119,27 @@ This happens for Android >= 4.0."
 
 ;; Connection functions
 
-(defun tramp-adb-send-command (vec command)
+(defun tramp-adb-send-command (vec command &optional neveropen nooutput)
   "Send the COMMAND to connection VEC."
-  (tramp-adb-maybe-open-connection vec)
+  (unless neveropen (tramp-adb-maybe-open-connection vec))
   (tramp-message vec 6 "%s" command)
   (tramp-send-string vec command)
-  ;; FIXME: Race condition.
-  (tramp-adb-wait-for-output (tramp-get-connection-process vec))
-  (with-current-buffer (tramp-get-connection-buffer vec)
-    (save-excursion
-      (goto-char (point-min))
-      ;; We can't use stty to disable echo of command.  stty is said
-      ;; to be added to toybox 0.7.6.  busybox shall have it, but this
-      ;; isn't used any longer for Android.
-      (delete-matching-lines (regexp-quote command))
-      ;; When the local machine is W32, there are still trailing ^M.
-      ;; There must be a better solution by setting the correct coding
-      ;; system, but this requires changes in core Tramp.
-      (goto-char (point-min))
-      (while (re-search-forward "\r+$" nil t)
-       (replace-match "" nil nil)))))
+  (unless nooutput
+    ;; FIXME: Race condition.
+    (tramp-adb-wait-for-output (tramp-get-connection-process vec))
+    (with-current-buffer (tramp-get-connection-buffer vec)
+      (save-excursion
+       (goto-char (point-min))
+       ;; We can't use stty to disable echo of command.  stty is said
+       ;; to be added to toybox 0.7.6.  busybox shall have it, but this
+       ;; isn't used any longer for Android.
+       (delete-matching-lines (regexp-quote command))
+       ;; When the local machine is W32, there are still trailing ^M.
+       ;; There must be a better solution by setting the correct coding
+       ;; system, but this requires changes in core Tramp.
+       (goto-char (point-min))
+       (while (re-search-forward "\r+$" nil t)
+         (replace-match "" nil nil))))))
 
 (defun tramp-adb-send-command-and-check (vec command)
   "Run COMMAND and check its exit status.
@@ -1245,6 +1246,9 @@ connection if a previous connection has died for some 
reason."
            (tramp-adb-wait-for-output p 30)
            (unless (process-live-p p)
              (tramp-error vec 'file-error "Terminated!"))
+
+           ;; Set sentinel and query flag.  Initialize variables.
+           (set-process-sentinel p #'tramp-process-sentinel)
            (process-put p 'vector vec)
            (process-put p 'adjust-window-size-function #'ignore)
            (set-process-query-on-exit-flag p nil)
diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el
index edd9af4..7d903c5 100644
--- a/lisp/net/tramp-sh.el
+++ b/lisp/net/tramp-sh.el
@@ -2769,15 +2769,6 @@ the result will be a local, non-Tramp, file name."
 
 ;;; Remote commands:
 
-(defun tramp-process-sentinel (proc event)
-  "Flush file caches."
-  (unless (process-live-p proc)
-    (let ((vec (process-get proc 'vector)))
-      (when vec
-       (tramp-message vec 5 "Sentinel called: `%S' `%s'" proc event)
-        (tramp-flush-connection-properties proc)
-        (tramp-flush-directory-properties vec "")))))
-
 ;; We use BUFFER also as connection buffer during setup. Because of
 ;; this, its original contents must be saved, and restored once
 ;; connection has been setup.
@@ -2912,8 +2903,7 @@ the result will be a local, non-Tramp, file name."
                    ;; otherwise we might be interrupted by
                    ;; `verify-visited-file-modtime'.
                    (let ((buffer-undo-list t)
-                         (inhibit-read-only t)
-                         (mark (point-max)))
+                         (inhibit-read-only t))
                      (clear-visited-file-modtime)
                      (narrow-to-region (point-max) (point-max))
                      ;; We call `tramp-maybe-open-connection', in
@@ -2926,9 +2916,7 @@ the result will be a local, non-Tramp, file name."
                        (let ((pid (tramp-send-command-and-read v "echo $$")))
                          (process-put p 'remote-pid pid)
                          (tramp-set-connection-property p "remote-pid" pid))
-                       (widen)
-                       (delete-region mark (point-max))
-                       (narrow-to-region (point-max) (point-max))
+                       (delete-region (point-min) (point-max))
                        ;; Now do it.
                        (if command
                            ;; Send the command.
diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el
index 7206d8e..0fc2d33 100644
--- a/lisp/net/tramp.el
+++ b/lisp/net/tramp.el
@@ -4212,6 +4212,19 @@ the remote host use line-endings as defined in the 
variable
       ;; Reenable the timers.
       (with-timeout-unsuspend stimers))))
 
+(defun tramp-process-sentinel (proc event)
+  "Flush file caches and remove shell prompt."
+  (unless (process-live-p proc)
+    (let ((vec (process-get proc 'vector))
+         (prompt (tramp-get-connection-property proc "prompt" nil)))
+      (when vec
+       (tramp-message vec 5 "Sentinel called: `%S' `%s'" proc event)
+        (tramp-flush-connection-properties proc)
+        (tramp-flush-directory-properties vec ""))
+      (goto-char (point-max))
+      (when (and prompt (re-search-backward (regexp-quote prompt) nil t))
+       (delete-region (point) (point-max))))))
+
 (defun tramp-get-inode (vec)
   "Returns the virtual inode number.
 If it doesn't exist, generate a new one."
diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el
index 1c7198c..1ee11f0 100644
--- a/test/lisp/net/tramp-tests.el
+++ b/test/lisp/net/tramp-tests.el
@@ -3849,12 +3849,14 @@ This tests also `make-symbolic-link', `file-truename' 
and `add-name-to-file'."
   "Check `start-file-process'."
   :tags '(:expensive-test)
   (skip-unless (tramp--test-enabled))
-  (skip-unless (tramp--test-sh-p))
+  (skip-unless (or (tramp--test-adb-p) (tramp--test-sh-p)))
 
   (dolist (quoted (if (tramp--test-expensive-test) '(nil t) '(nil)))
     (let ((default-directory tramp-test-temporary-file-directory)
          (tmp-name (tramp--test-make-temp-name nil quoted))
          kill-buffer-query-functions proc)
+
+      ;; Simple process.
       (unwind-protect
          (with-temp-buffer
            (setq proc (start-file-process "test1" (current-buffer) "cat"))
@@ -3866,11 +3868,14 @@ This tests also `make-symbolic-link', `file-truename' 
and `add-name-to-file'."
            (with-timeout (10 (tramp--test-timeout-handler))
              (while (< (- (point-max) (point-min)) (length "foo"))
                (while (accept-process-output proc 0 nil t))))
-           (should (string-equal (buffer-string) "foo")))
+           ;; We cannot use `string-equal', because tramp-adb.el
+           ;; echoes also the sent string.
+           (should (string-match "\\`foo" (buffer-string))))
 
        ;; Cleanup.
        (ignore-errors (delete-process proc)))
 
+      ;; Simple process using a file.
       (unwind-protect
          (with-temp-buffer
            (write-region "foo" nil tmp-name)
@@ -3891,6 +3896,7 @@ This tests also `make-symbolic-link', `file-truename' and 
`add-name-to-file'."
          (delete-process proc)
          (delete-file tmp-name)))
 
+      ;; Process filter.
       (unwind-protect
          (with-temp-buffer
            (setq proc (start-file-process "test3" (current-buffer) "cat"))
@@ -3905,7 +3911,9 @@ This tests also `make-symbolic-link', `file-truename' and 
`add-name-to-file'."
            (with-timeout (10 (tramp--test-timeout-handler))
              (while (< (- (point-max) (point-min)) (length "foo"))
                (while (accept-process-output proc 0 nil t))))
-           (should (string-equal (buffer-string) "foo")))
+           ;; We cannot use `string-equal', because tramp-adb.el
+           ;; echoes also the sent string.
+           (should (string-match "\\`foo" (buffer-string))))
 
        ;; Cleanup.
        (ignore-errors (delete-process proc))))))
@@ -3914,7 +3922,7 @@ This tests also `make-symbolic-link', `file-truename' and 
`add-name-to-file'."
   "Check `make-process'."
   :tags '(:expensive-test)
   (skip-unless (tramp--test-enabled))
-  (skip-unless (tramp--test-sh-p))
+  (skip-unless (or (tramp--test-adb-p) (tramp--test-sh-p)))
   (skip-unless (tramp--test-emacs27-p))
 
   (dolist (quoted (if (tramp--test-expensive-test) '(nil t) '(nil)))
@@ -3938,7 +3946,9 @@ This tests also `make-symbolic-link', `file-truename' and 
`add-name-to-file'."
            (with-timeout (10 (tramp--test-timeout-handler))
              (while (< (- (point-max) (point-min)) (length "foo"))
                (while (accept-process-output proc 0 nil t))))
-           (should (string-equal (buffer-string) "foo")))
+           ;; We cannot use `string-equal', because tramp-adb.el
+           ;; echoes also the sent string.
+           (should (string-match "\\`foo" (buffer-string))))
 
        ;; Cleanup.
        (ignore-errors (delete-process proc)))
@@ -3981,9 +3991,11 @@ This tests also `make-symbolic-link', `file-truename' 
and `add-name-to-file'."
            (process-send-eof proc)
            ;; Read output.
            (with-timeout (10 (tramp--test-timeout-handler))
-             (while (< (- (point-max) (point-min)) (length "foo"))
+             (while (not (string-match "foo" (buffer-string)))
                (while (accept-process-output proc 0 nil t))))
-           (should (string-equal (buffer-string) "foo")))
+           ;; We cannot use `string-equal', because tramp-adb.el
+           ;; echoes also the sent string.
+           (should (string-match "\\`foo" (buffer-string))))
 
        ;; Cleanup.
        (ignore-errors (delete-process proc)))
@@ -4006,33 +4018,37 @@ This tests also `make-symbolic-link', `file-truename' 
and `add-name-to-file'."
            ;; Read output.
            (with-timeout (10 (tramp--test-timeout-handler))
              (while (accept-process-output proc 0 nil t)))
-           (should (string-equal (buffer-string) "killed\n")))
+           ;; We cannot use `string-equal', because tramp-adb.el
+           ;; echoes also the sent string.
+           (should (string-match "killed\n\\'" (buffer-string))))
 
        ;; Cleanup.
        (ignore-errors (delete-process proc)))
 
-      ;; Process with stderr.
-      (let ((stderr (generate-new-buffer (generate-new-buffer-name "stderr"))))
-       (unwind-protect
-           (with-temp-buffer
-             (setq proc
-                   (make-process
-                    :name "test5" :buffer (current-buffer)
-                    :command '("cat" "/")
-                    :stderr stderr
-                    :file-handler t))
-             (should (processp proc))
-             ;; Read stderr.
-             (with-current-buffer stderr
-               (with-timeout (10 (tramp--test-timeout-handler))
-                 (while (= (point-min) (point-max))
-                   (while (accept-process-output proc 0 nil t))))
-               (should
-                (string-equal (buffer-string) "cat: /: Is a directory\n"))))
+      ;; Process with stderr.  tramp-adb.el doesn't support it (yet).
+      (unless (tramp--test-adb-p)
+       (let ((stderr
+              (generate-new-buffer (generate-new-buffer-name "stderr"))))
+         (unwind-protect
+             (with-temp-buffer
+               (setq proc
+                     (make-process
+                      :name "test5" :buffer (current-buffer)
+                      :command '("cat" "/")
+                      :stderr stderr
+                      :file-handler t))
+               (should (processp proc))
+               ;; Read stderr.
+               (with-current-buffer stderr
+                 (with-timeout (10 (tramp--test-timeout-handler))
+                   (while (= (point-min) (point-max))
+                     (while (accept-process-output proc 0 nil t))))
+                 (should
+                  (string-equal (buffer-string) "cat: /: Is a directory\n"))))
 
-         ;; Cleanup.
-         (ignore-errors (delete-process proc))
-         (ignore-errors (kill-buffer stderr)))))))
+           ;; Cleanup.
+           (ignore-errors (delete-process proc))
+           (ignore-errors (kill-buffer stderr))))))))
 
 (ert-deftest tramp-test31-interrupt-process ()
   "Check `interrupt-process'."
@@ -4096,8 +4112,6 @@ This tests also `make-symbolic-link', `file-truename' and 
`add-name-to-file'."
        ;; Cleanup.
        (ignore-errors (delete-file tmp-name)))
 
-      ;; tramp-adb.el is not fit yet for asynchronous processes.
-      (unless (tramp--test-adb-p)
       (unwind-protect
          (with-temp-buffer
            (write-region "foo" nil tmp-name)
@@ -4124,10 +4138,8 @@ This tests also `make-symbolic-link', `file-truename' 
and `add-name-to-file'."
              (buffer-string))))
 
        ;; Cleanup.
-       (ignore-errors (delete-file tmp-name))))
+       (ignore-errors (delete-file tmp-name)))
 
-      ;; tramp-adb.el is not fit yet for asynchronous processes.
-      (unless (tramp--test-adb-p)
       (unwind-protect
          (with-temp-buffer
            (write-region "foo" nil tmp-name)
@@ -4155,7 +4167,7 @@ This tests also `make-symbolic-link', `file-truename' and 
`add-name-to-file'."
              (buffer-string))))
 
        ;; Cleanup.
-       (ignore-errors (delete-file tmp-name)))))))
+       (ignore-errors (delete-file tmp-name))))))
 
 (defun tramp--test-shell-command-to-string-asynchronously (command)
   "Like `shell-command-to-string', but for asynchronous processes."
@@ -4350,9 +4362,7 @@ This tests also `make-symbolic-link', `file-truename' and 
`add-name-to-file'."
 ;; The functions were introduced in Emacs 26.1.
 (ert-deftest tramp-test34-explicit-shell-file-name ()
   "Check that connection-local `explicit-shell-file-name' is set."
-  ;; The handling of connection-local variables has changed.  Test
-  ;; must be reworked.
-  :tags '(:expensive-test :unstable)
+  :tags '(:expensive-test)
   (skip-unless (tramp--test-enabled))
   (skip-unless (or (tramp--test-adb-p) (tramp--test-sh-p)))
   ;; Since Emacs 26.1.
@@ -4368,15 +4378,16 @@ This tests also `make-symbolic-link', `file-truename' 
and `add-name-to-file'."
     (unwind-protect
        (progn
          ;; `shell-mode' would ruin our test, because it deletes all
-         ;; buffer local variables.
+         ;; buffer local variables.  Not needed in Emacs 27.1.
          (put 'explicit-shell-file-name 'permanent-local t)
-         ;; Declare connection-local variable `explicit-shell-file-name'.
+         ;; Declare connection-local variables `explicit-shell-file-name'
+         ;; and `explicit-sh-args'.
          (with-no-warnings
            (connection-local-set-profile-variables
             'remote-sh
             `((explicit-shell-file-name
                . ,(if (tramp--test-adb-p) "/system/bin/sh" "/bin/sh"))
-              (explicit-sh-args . ("-i"))))
+              (explicit-sh-args . ("-c" "echo foo"))))
            (connection-local-set-profiles
             `(:application tramp
               :protocol ,(file-remote-p default-directory 'method)
@@ -4386,14 +4397,18 @@ This tests also `make-symbolic-link', `file-truename' 
and `add-name-to-file'."
          (put 'explicit-shell-file-name 'safe-local-variable #'identity)
          (put 'explicit-sh-args 'safe-local-variable #'identity)
 
-         ;; Run interactive shell.  Since the default directory is
-         ;; remote, `explicit-shell-file-name' shall be set in order
-         ;; to avoid a question.
+         ;; Run `shell' interactively.  Since the default directory
+         ;; is remote, `explicit-shell-file-name' shall be set in
+         ;; order to avoid a question.  `explicit-sh-args' echoes the
+         ;; test data.
          (with-current-buffer (get-buffer-create "*shell*")
            (ignore-errors (kill-process (current-buffer)))
            (should-not explicit-shell-file-name)
            (call-interactively #'shell)
-           (should explicit-shell-file-name)))
+           (with-timeout (10)
+             (while (accept-process-output
+                     (get-buffer-process (current-buffer)) nil nil t)))
+           (should (string-match "^foo$" (buffer-string)))))
 
       ;; Cleanup.
       (put 'explicit-shell-file-name 'permanent-local nil)
@@ -5714,11 +5729,8 @@ Since it unloads Tramp, it shall be the last test to 
run."
 ;;   do not work properly for `nextcloud'.
 ;; * Fix `tramp-test29-start-file-process' and
 ;;   `tramp-test30-make-process' on MS Windows (`process-send-eof'?).
-;; * Fix `tramp-test29-start-file-process',
-;;   `tramp-test30-make-process' and `tramp-test32-shell-command' for
-;;   `adb' (see comment in `tramp-adb-send-command').
-;; * Rework `tramp-test34-explicit-shell-file-name'.
 ;; * Fix Bug#16928 in `tramp-test43-asynchronous-requests'.
+;; * Fix `tramp-test44-threads'.
 
 (provide 'tramp-tests)
 ;;; tramp-tests.el ends here