master 558286315c: Improve Tramp tests

[Michael Albinus]

branch: master
commit 558286315c908a8be134bec0187c97ceac815b3e
Author: Michael Albinus <michael.albinus@gmx.de>
Commit: Michael Albinus <michael.albinus@gmx.de>

    Improve Tramp tests
    
    * lisp/net/tramp-smb.el (tramp-smb-handle-copy-file):
    Handle compressed files.
    
    * lisp/net/tramp.el (tramp-skeleton-write-region):
    Handle encrypted VISIT file.
    (tramp-get-process-attributes): Add backward compatibility.
    
    * test/lisp/net/tramp-tests.el (with-connection-local-variables):
    Declare.
    (auto-save-file-name-transforms): Don't declare.
    (ert-resource-directory-format)
    (ert-resource-directory-trim-left-regexp)
    (ert-resource-directory-trim-right-regexp, ert-resource-directory)
    (ert-resource-file): Define if they don't exist.
    (tramp-test10-write-region-file-precious-flag)
    (tramp-test10-write-region-other-file-name-handler)
    (tramp-test31-interrupt-process, tramp-test31-signal-process)
    (tramp--test-async-shell-command)
    (tramp-test34-connection-local-variables)
    (tramp-test39-make-lock-file-name)
    (tramp-test39-detect-external-change): Extend tests.
---
 lisp/net/tramp-smb.el        |   6 ++-
 lisp/net/tramp.el            |  11 +++--
 test/lisp/net/tramp-tests.el | 106 +++++++++++++++++++++++++++++++++++--------
 3 files changed, 100 insertions(+), 23 deletions(-)

diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el
index 968c1daccb..8037c89829 100644
--- a/lisp/net/tramp-smb.el
+++ b/lisp/net/tramp-smb.el
@@ -609,7 +609,11 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are 
completely ignored."
          (if (tramp-tramp-file-p filename) filename newname))
         'file-missing filename))
 
-      (if-let ((tmpfile (file-local-copy filename)))
+      ;; `file-local-copy' returns a file name also for a local file
+      ;; with `jka-compr-handler', so we cannot trust its result as
+      ;; indication for a remote file name.
+      (if-let ((tmpfile
+               (and (file-remote-p filename) (file-local-copy filename))))
          ;; Remote filename.
          (condition-case err
              (rename-file tmpfile newname ok-if-already-exists)
diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el
index fec4ea68ec..9413f7954f 100644
--- a/lisp/net/tramp.el
+++ b/lisp/net/tramp.el
@@ -3386,8 +3386,9 @@ BODY is the backend specific code."
         (lockname (file-truename (or ,lockname filename)))
         (handler (and (stringp ,visit)
                       (let ((inhibit-file-name-handlers
-                             (cons 'tramp-file-name-handler
-                                   inhibit-file-name-handlers))
+                             `(tramp-file-name-handler
+                               tramp-crypt-file-name-handler
+                               . inhibit-file-name-handlers))
                             (inhibit-file-name-operation 'write-region))
                         (find-file-name-handler ,visit 'write-region)))))
      (with-parsed-tramp-file-name filename nil
@@ -4221,7 +4222,9 @@ Parsing the remote \"ps\" output is controlled by
 It is not guaranteed, that all process attributes as described in
 `process-attributes' are returned.  The additional attribute
 `pid' shall be returned always."
-  (with-tramp-file-property vec "/" "process-attributes"
+  ;; Since Emacs 27.1.
+  (when (fboundp 'connection-local-criteria-for-default-directory)
+    (with-tramp-file-property vec "/" "process-attributes"
       (ignore-errors
         (with-temp-buffer
           (hack-connection-local-variables-apply
@@ -4265,7 +4268,7 @@ It is not guaranteed, that all process attributes as 
described in
                   (push (append res) result))
                 (forward-line))
               ;; Return result.
-              result))))))
+              result)))))))
 
 (defun tramp-handle-list-system-processes ()
   "Like `list-system-processes' for Tramp files."
diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el
index 2d2bef732e..643e19c1d2 100644
--- a/test/lisp/net/tramp-tests.el
+++ b/test/lisp/net/tramp-tests.el
@@ -65,9 +65,6 @@
 (declare-function tramp-method-out-of-band-p "tramp-sh")
 (declare-function tramp-smb-get-localname "tramp-smb")
 (defvar ange-ftp-make-backup-files)
-(defvar auto-save-file-name-transforms)
-(defvar lock-file-name-transforms)
-(defvar remote-file-name-inhibit-locks)
 (defvar tramp-connection-properties)
 (defvar tramp-copy-size-limit)
 (defvar tramp-display-escape-sequence-regexp)
@@ -77,12 +74,59 @@
 (defvar tramp-remote-path)
 (defvar tramp-remote-process-environment)
 
+;; Needed for Emacs 26.
+(declare-function with-connection-local-variables "files-x")
 ;; Needed for Emacs 27.
+(defvar lock-file-name-transforms)
 (defvar process-file-return-signal-string)
+(defvar remote-file-name-inhibit-locks)
 (defvar shell-command-dont-erase-buffer)
 ;; Needed for Emacs 28.
 (defvar dired-copy-dereference)
 
+;; `ert-resource-file' was introduced in Emacs 28.1.
+(unless (macrop 'ert-resource-file)
+  (eval-and-compile
+    (defvar ert-resource-directory-format "%s-resources/"
+      "Format for `ert-resource-directory'.")
+    (defvar ert-resource-directory-trim-left-regexp ""
+      "Regexp for `string-trim' (left) used by `ert-resource-directory'.")
+    (defvar ert-resource-directory-trim-right-regexp "\\(-tests?\\)?\\.el"
+      "Regexp for `string-trim' (right) used by `ert-resource-directory'.")
+
+    (defmacro ert-resource-directory ()
+      "Return absolute file name of the resource directory for this file.
+
+The path to the resource directory is the \"resources\" directory
+in the same directory as the test file.
+
+If that directory doesn't exist, use the directory named like the
+test file but formatted by `ert-resource-directory-format' and trimmed
+using `string-trim' with arguments
+`ert-resource-directory-trim-left-regexp' and
+`ert-resource-directory-trim-right-regexp'.  The default values mean
+that if called from a test file named \"foo-tests.el\", return
+the absolute file name for \"foo-resources\"."
+      `(let* ((testfile ,(or (bound-and-true-p byte-compile-current-file)
+                             (and load-in-progress load-file-name)
+                             buffer-file-name))
+              (default-directory (file-name-directory testfile)))
+        (file-truename
+         (if (file-accessible-directory-p "resources/")
+              (expand-file-name "resources/")
+            (expand-file-name
+             (format
+             ert-resource-directory-format
+              (string-trim testfile
+                          ert-resource-directory-trim-left-regexp
+                          ert-resource-directory-trim-right-regexp)))))))
+
+    (defmacro ert-resource-file (file)
+      "Return file name of resource file named FILE.
+A resource file is in the resource directory as per
+`ert-resource-directory'."
+      `(expand-file-name ,file (ert-resource-directory)))))
+
 ;; Beautify batch mode.
 (when noninteractive
   ;; Suppress nasty messages.
@@ -2505,7 +2549,9 @@ This checks also `file-name-as-directory', 
`file-name-directory',
           (setq-local file-precious-flag t)
           (setq-local backup-inhibited t)
           (insert "bar")
+         (should (buffer-modified-p))
           (should (null (save-buffer)))
+         (should (not (buffer-modified-p)))
           (should-not (cl-member tmp-name written-files :test #'string=)))
 
       ;; Cleanup.
@@ -2518,6 +2564,8 @@ This checks also `file-name-as-directory', 
`file-name-directory',
   (skip-unless (tramp--test-enabled))
   (skip-unless (not (tramp--test-ange-ftp-p)))
   (skip-unless (executable-find "gzip"))
+  ;; The function was introduced in Emacs 28.1.
+  (skip-unless (boundp 'tar-goto-file))
 
   (let* ((default-directory tramp-test-temporary-file-directory)
         (archive (ert-resource-file "foo.tar.gz"))
@@ -2531,20 +2579,26 @@ This checks also `file-name-as-directory', 
`file-name-directory',
          (copy-file archive tmp-file 'ok)
          ;; Read archive.  Check contents of foo.txt, and modify it.  Save.
          (with-current-buffer (setq buffer1 (find-file-noselect tmp-file))
-           (should (tar-goto-file "foo.txt"))
+           ;; The function was introduced in Emacs 28.1.
+           (with-no-warnings (should (tar-goto-file "foo.txt")))
            (save-current-buffer
              (setq buffer2 (tar-extract))
              (should (string-equal (buffer-string) "foo\n"))
              (goto-char (point-max))
              (insert "bar")
-              (should (null (save-buffer))))
-            (should (null (save-buffer))))
+             (should (buffer-modified-p))
+              (should (null (save-buffer)))
+             (should-not (buffer-modified-p)))
+           (should (buffer-modified-p))
+            (should (null (save-buffer)))
+           (should-not (buffer-modified-p)))
 
          (kill-buffer buffer1)
          (kill-buffer buffer2)
          ;; Read archive.  Check contents of modified foo.txt.
          (with-current-buffer (setq buffer1 (find-file-noselect tmp-file))
-           (should (tar-goto-file "foo.txt"))
+           ;; The function was introduced in Emacs 28.1.
+           (with-no-warnings (should (tar-goto-file "foo.txt")))
            (save-current-buffer
              (setq buffer2 (tar-extract))
              (should (string-equal (buffer-string) "foo\nbar\n")))))
@@ -5032,6 +5086,8 @@ If UNSTABLE is non-nil, the test is tagged as 
`:unstable'."
   (skip-unless (tramp--test-enabled))
   (skip-unless (tramp--test-sh-p))
   (skip-unless (not (tramp--test-crypt-p)))
+  ;; Since Emacs 27.1.
+  (skip-unless (macrop 'with-connection-local-variables))
 
   ;; We must use `file-truename' for the temporary directory, in
   ;; order to establish the connection prior running an asynchronous
@@ -5072,6 +5128,8 @@ If UNSTABLE is non-nil, the test is tagged as 
`:unstable'."
   (skip-unless (tramp--test-enabled))
   (skip-unless (tramp--test-sh-p))
   (skip-unless (not (tramp--test-crypt-p)))
+  ;; Since Emacs 27.1.
+  (skip-unless (macrop 'with-connection-local-variables))
   ;; Since Emacs 29.1.
   (skip-unless (boundp 'signal-process-functions))
 
@@ -5117,10 +5175,12 @@ If UNSTABLE is non-nil, the test is tagged as 
`:unstable'."
            (should (equal (process-get proc 'remote-command)
                           (with-connection-local-variables
                            `(,shell-file-name ,shell-command-switch 
,command))))
-           (should
-             (zerop
-              (signal-process
-               (process-get proc 'remote-pid) sigcode default-directory)))
+           ;; `signal-process' has argument REMOTE since Emacs 29.
+           (with-no-warnings
+             (should
+               (zerop
+               (signal-process
+                (process-get proc 'remote-pid) sigcode default-directory))))
            ;; Let the process accept the signal.
            (with-timeout (10 (tramp--test-timeout-handler))
              (while (accept-process-output proc 0 nil t)))
@@ -5181,9 +5241,11 @@ If UNSTABLE is non-nil, the test is tagged as 
`:unstable'."
 INPUT, if non-nil, is a string sent to the process."
   (let ((proc (async-shell-command command output-buffer error-buffer))
        (delete-exited-processes t))
-    (should (equal (process-get proc 'remote-command)
-                  (with-connection-local-variables
-                   `(,shell-file-name ,shell-command-switch ,command))))
+    ;; Since Emacs 27.1.
+    (when (macrop 'with-connection-local-variables)
+      (should (equal (process-get proc 'remote-command)
+                    (with-connection-local-variables
+                     `(,shell-file-name ,shell-command-switch ,command)))))
     (cl-letf (((symbol-function #'shell-command-sentinel) #'ignore))
       (when (stringp input)
        (process-send-string proc input))
@@ -5567,7 +5629,7 @@ Use direct async.")
   :tags '(:expensive-test)
   (skip-unless (tramp--test-enabled))
   ;; Since Emacs 27.1.
-  (skip-unless (fboundp 'with-connection-local-variables))
+  (skip-unless (macrop 'with-connection-local-variables))
 
   (let* ((default-directory tramp-test-temporary-file-directory)
         (tmp-name1 (tramp--test-make-temp-name))
@@ -5583,6 +5645,8 @@ Use direct async.")
           (should (file-directory-p tmp-name1))
 
          ;; `local-variable' is buffer-local due to explicit setting.
+         ;; We need `with-no-warnings', because `defvar-local' is not
+         ;; called at toplevel.
          (with-no-warnings
           (defvar-local local-variable 'buffer))
          (with-temp-buffer
@@ -6163,7 +6227,9 @@ Use direct async.")
             (with-temp-buffer
               (set-visited-file-name tmp-name1)
               (insert "foo")
-              (save-buffer))
+             (should (buffer-modified-p))
+              (save-buffer)
+             (should-not (buffer-modified-p)))
             (should-not (with-no-warnings (file-locked-p tmp-name1)))
            (with-no-warnings (lock-file tmp-name1))
            (should (eq (with-no-warnings (file-locked-p tmp-name1)) t))
@@ -6285,7 +6351,9 @@ Use direct async.")
                ;; buffer results in a prompt.
                (cl-letf (((symbol-function 'yes-or-no-p)
                           (lambda (_) (ert-fail "Test failed unexpectedly"))))
-                 (save-buffer))
+                 (should (buffer-modified-p))
+                 (save-buffer)
+                 (should-not (buffer-modified-p)))
                (should-not (file-locked-p tmp-name))
 
                ;; For local files, just changing the file
@@ -6317,7 +6385,9 @@ Use direct async.")
                  (cl-letf (((symbol-function 'yes-or-no-p) 
#'tramp--test-always)
                            ((symbol-function 'read-char-choice)
                             (lambda (&rest _) ?y)))
-                   (save-buffer))
+                   (should (buffer-modified-p))
+                   (save-buffer)
+                   (should-not (buffer-modified-p)))
                  (should-not (file-locked-p tmp-name))))
 
            ;; Cleanup.