X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/f15c8583198c3d6c26ca0c0a5b6fb019f98d6c3c..8e03731cb9083330939b2c9b2d3318f32e93e41d:/test/automated/tramp-tests.el diff --git a/test/automated/tramp-tests.el b/test/automated/tramp-tests.el index 3b72da8955..6972373bdf 100644 --- a/test/automated/tramp-tests.el +++ b/test/automated/tramp-tests.el @@ -46,7 +46,10 @@ (declare-function tramp-find-executable "tramp-sh") (declare-function tramp-get-remote-path "tramp-sh") +(declare-function tramp-get-remote-stat "tramp-sh") +(declare-function tramp-get-remote-perl "tramp-sh") (defvar tramp-copy-size-limit) +(defvar tramp-persistency-file-name) (defvar tramp-remote-process-environment) ;; There is no default value on w32 systems, which could work out of the box. @@ -68,7 +71,8 @@ (setq password-cache-expiry nil tramp-verbose 0 tramp-copy-size-limit nil - tramp-message-show-message nil) + tramp-message-show-message nil + tramp-persistency-file-name nil) ;; This shall happen on hydra only. (when (getenv "NIX_STORE") @@ -115,15 +119,16 @@ shall not contain a timeout." (declare (indent 1) (debug (natnump body))) `(let ((tramp-verbose ,verbose) (tramp-message-show-message t) - (tramp-debug-on-error t)) + (tramp-debug-on-error t) + (debug-ignored-errors + (cons "^make-symbolic-link not supported$" debug-ignored-errors))) (unwind-protect (progn ,@body) (when (> tramp-verbose 3) (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil (with-current-buffer (tramp-get-connection-buffer v) (message "%s" (buffer-string))) - (with-current-buffer - (tramp-get-debug-buffer v) + (with-current-buffer (tramp-get-debug-buffer v) (message "%s" (buffer-string)))))))) (ert-deftest tramp-test00-availability () @@ -558,8 +563,8 @@ shall not contain a timeout." (ert-deftest tramp-test06-directory-file-name () "Check `directory-file-name'. -This checks also `file-name-as-directory', `file-name-directory' -and `file-name-nondirectory'." +This checks also `file-name-as-directory', `file-name-directory', +`file-name-nondirectory' and `unhandled-file-name-directory'." (should (string-equal (directory-file-name "/method:host:/path/to/file") @@ -589,8 +594,7 @@ and `file-name-nondirectory'." (should (string-equal (file-name-nondirectory "/method:host:/path/to/file/") "")) (should-not - (file-remote-p - (unhandled-file-name-directory "/method:host:/path/to/file")))) + (unhandled-file-name-directory "/method:host:/path/to/file"))) (ert-deftest tramp-test07-file-exists-p () "Check `file-exist-p', `write-region' and `delete-file'." @@ -615,7 +619,15 @@ and `file-name-nondirectory'." (should (setq tmp-name2 (file-local-copy tmp-name1))) (with-temp-buffer (insert-file-contents tmp-name2) - (should (string-equal (buffer-string) "foo")))) + (should (string-equal (buffer-string) "foo"))) + ;; Check also that a file transfer with compression works. + (let ((default-directory tramp-test-temporary-file-directory) + (tramp-copy-size-limit 4) + (tramp-inline-compress-start-size 2)) + (delete-file tmp-name2) + (should (setq tmp-name2 (file-local-copy tmp-name1))))) + + ;; Cleanup. (ignore-errors (delete-file tmp-name1) (delete-file tmp-name2))))) @@ -639,6 +651,8 @@ and `file-name-nondirectory'." ;; Replace. (insert-file-contents tmp-name nil nil nil 'replace) (should (string-equal (buffer-string) "foo")))) + + ;; Cleanup. (ignore-errors (delete-file tmp-name))))) (ert-deftest tramp-test10-write-region () @@ -673,6 +687,8 @@ and `file-name-nondirectory'." (with-temp-buffer (insert-file-contents tmp-name) (should (string-equal (buffer-string) "34")))) + + ;; Cleanup. (ignore-errors (delete-file tmp-name))))) (ert-deftest tramp-test11-copy-file () @@ -701,6 +717,8 @@ and `file-name-nondirectory'." (should (file-exists-p (expand-file-name (file-name-nondirectory tmp-name1) tmp-name3)))) + + ;; Cleanup. (ignore-errors (delete-file tmp-name1)) (ignore-errors (delete-file tmp-name2)) (ignore-errors (delete-directory tmp-name3 'recursive))) @@ -721,6 +739,8 @@ and `file-name-nondirectory'." (should (file-exists-p (expand-file-name (file-name-nondirectory tmp-name1) tmp-name5)))) + + ;; Cleanup. (ignore-errors (delete-file tmp-name1)) (ignore-errors (delete-file tmp-name4)) (ignore-errors (delete-directory tmp-name5 'recursive))) @@ -741,6 +761,8 @@ and `file-name-nondirectory'." (should (file-exists-p (expand-file-name (file-name-nondirectory tmp-name4) tmp-name3)))) + + ;; Cleanup. (ignore-errors (delete-file tmp-name1)) (ignore-errors (delete-file tmp-name4)) (ignore-errors (delete-directory tmp-name3 'recursive))))) @@ -776,6 +798,8 @@ and `file-name-nondirectory'." (should (file-exists-p (expand-file-name (file-name-nondirectory tmp-name1) tmp-name3)))) + + ;; Cleanup. (ignore-errors (delete-file tmp-name1)) (ignore-errors (delete-file tmp-name2)) (ignore-errors (delete-directory tmp-name3 'recursive))) @@ -801,6 +825,8 @@ and `file-name-nondirectory'." (should (file-exists-p (expand-file-name (file-name-nondirectory tmp-name1) tmp-name5)))) + + ;; Cleanup. (ignore-errors (delete-file tmp-name1)) (ignore-errors (delete-file tmp-name4)) (ignore-errors (delete-directory tmp-name5 'recursive))) @@ -826,6 +852,8 @@ and `file-name-nondirectory'." (should (file-exists-p (expand-file-name (file-name-nondirectory tmp-name4) tmp-name3)))) + + ;; Cleanup. (ignore-errors (delete-file tmp-name1)) (ignore-errors (delete-file tmp-name4)) (ignore-errors (delete-directory tmp-name3 'recursive))))) @@ -835,13 +863,20 @@ and `file-name-nondirectory'." This tests also `file-directory-p' and `file-accessible-directory-p'." (skip-unless (tramp--test-enabled)) - (let ((tmp-name (tramp--test-make-temp-name))) + (let* ((tmp-name1 (tramp--test-make-temp-name)) + (tmp-name2 (expand-file-name "foo/bar" tmp-name1))) (unwind-protect (progn - (make-directory tmp-name) - (should (file-directory-p tmp-name)) - (should (file-accessible-directory-p tmp-name))) - (ignore-errors (delete-directory tmp-name))))) + (make-directory tmp-name1) + (should (file-directory-p tmp-name1)) + (should (file-accessible-directory-p tmp-name1)) + (should-error (make-directory tmp-name2) :type 'file-error) + (make-directory tmp-name2 'parents) + (should (file-directory-p tmp-name2)) + (should (file-accessible-directory-p tmp-name2))) + + ;; Cleanup. + (ignore-errors (delete-directory tmp-name1 'recursive))))) (ert-deftest tramp-test14-delete-directory () "Check `delete-directory'." @@ -890,6 +925,8 @@ This tests also `file-directory-p' and `file-accessible-directory-p'." (copy-directory tmp-name1 tmp-name2) (should (file-directory-p tmp-name3)) (should (file-exists-p tmp-name6))) + + ;; Cleanup. (ignore-errors (delete-directory tmp-name1 'recursive) (delete-directory tmp-name2 'recursive))))) @@ -920,6 +957,8 @@ This tests also `file-directory-p' and `file-accessible-directory-p'." (should (equal (directory-files tmp-name1 'full directory-files-no-dot-files-regexp) `(,tmp-name2 ,tmp-name3)))) + + ;; Cleanup. (ignore-errors (delete-directory tmp-name1 'recursive))))) (ert-deftest tramp-test17-insert-directory () @@ -959,9 +998,10 @@ This tests also `file-directory-p' and `file-accessible-directory-p'." (concat ;; There might be a summary line. "\\(total.+[[:digit:]]+\n\\)?" - ;; We don't know in which order "." and ".." appear. - "\\(.+ \\.?\\.\n\\)\\{2\\}" - ".+ foo$"))))) + ;; We don't know in which order ".", ".." and "foo" appear. + "\\(.+ \\(\\.?\\.\\|foo\\)\n\\)\\{3\\}"))))) + + ;; Cleanup. (ignore-errors (delete-directory tmp-name1 'recursive))))) (ert-deftest tramp-test18-file-attributes () @@ -969,17 +1009,23 @@ This tests also `file-directory-p' and `file-accessible-directory-p'." This tests also `file-readable-p' and `file-regular-p'." (skip-unless (tramp--test-enabled)) - (let ((tmp-name (tramp--test-make-temp-name)) - attr) + ;; We must use `file-truename' for the temporary directory, because + ;; it could be located on a symlinked directory. This would let the + ;; test fail. + (let* ((tramp-test-temporary-file-directory + (file-truename tramp-test-temporary-file-directory)) + (tmp-name1 (tramp--test-make-temp-name)) + (tmp-name2 (tramp--test-make-temp-name)) + attr) (unwind-protect (progn - (write-region "foo" nil tmp-name) - (should (file-exists-p tmp-name)) - (setq attr (file-attributes tmp-name)) + (write-region "foo" nil tmp-name1) + (should (file-exists-p tmp-name1)) + (setq attr (file-attributes tmp-name1)) (should (consp attr)) - (should (file-exists-p tmp-name)) - (should (file-readable-p tmp-name)) - (should (file-regular-p tmp-name)) + (should (file-exists-p tmp-name1)) + (should (file-readable-p tmp-name1)) + (should (file-regular-p tmp-name1)) ;; We do not test inodes and device numbers. (should (null (car attr))) (should (numberp (nth 1 attr))) ;; Link. @@ -994,18 +1040,34 @@ This tests also `file-readable-p' and `file-regular-p'." (should (numberp (nth 7 attr))) ;; Size. (should (stringp (nth 8 attr))) ;; Modes. - (setq attr (file-attributes tmp-name 'string)) + (setq attr (file-attributes tmp-name1 'string)) (should (stringp (nth 2 attr))) ;; Uid. (should (stringp (nth 3 attr))) ;; Gid. - (delete-file tmp-name) - (make-directory tmp-name) - (should (file-exists-p tmp-name)) - (should (file-readable-p tmp-name)) - (should-not (file-regular-p tmp-name)) - (setq attr (file-attributes tmp-name)) + (condition-case err + (progn + (make-symbolic-link tmp-name1 tmp-name2) + (should (file-exists-p tmp-name2)) + (should (file-symlink-p tmp-name2)) + (setq attr (file-attributes tmp-name2)) + (should (string-equal + (car attr) + (file-remote-p (file-truename tmp-name1) 'localname))) + (delete-file tmp-name2)) + (file-error + (should (string-equal (error-message-string err) + "make-symbolic-link not supported")))) + (delete-file tmp-name1) + + (make-directory tmp-name1) + (should (file-exists-p tmp-name1)) + (should (file-readable-p tmp-name1)) + (should-not (file-regular-p tmp-name1)) + (setq attr (file-attributes tmp-name1)) (should (eq (car attr) t))) - (ignore-errors (delete-directory tmp-name))))) + + ;; Cleanup. + (ignore-errors (delete-directory tmp-name1))))) (ert-deftest tramp-test19-directory-files-and-attributes () "Check `directory-files-and-attributes'." @@ -1046,6 +1108,8 @@ This tests also `file-readable-p' and `file-regular-p'." (equal (file-attributes (car elt)) (cdr elt))))) (setq attr (directory-files-and-attributes tmp-name2 nil "^b")) (should (equal (mapcar 'car attr) '("bar" "boz")))) + + ;; Cleanup. (ignore-errors (delete-directory tmp-name1 'recursive))))) (ert-deftest tramp-test20-file-modes () @@ -1075,6 +1139,8 @@ This tests also `file-executable-p', `file-writable-p' and `set-file-modes'." ;; A file is always writable for user "root". (unless (zerop (nth 2 (file-attributes tmp-name))) (should-not (file-writable-p tmp-name)))) + + ;; Cleanup. (ignore-errors (delete-file tmp-name))))) (ert-deftest tramp-test21-file-links () @@ -1109,6 +1175,8 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (should (file-symlink-p tmp-name2)) ;; `tmp-name3' is a local file name. (should-error (make-symbolic-link tmp-name1 tmp-name3))) + + ;; Cleanup. (ignore-errors (delete-file tmp-name1) (delete-file tmp-name2))) @@ -1124,6 +1192,8 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (should-not (file-symlink-p tmp-name2)) ;; `tmp-name3' is a local file name. (should-error (add-name-to-file tmp-name1 tmp-name3))) + + ;; Cleanup. (ignore-errors (delete-file tmp-name1) (delete-file tmp-name2))) @@ -1181,6 +1251,8 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." ;; `tmp-name3' does not exist. (should (file-newer-than-file-p tmp-name2 tmp-name3)) (should-not (file-newer-than-file-p tmp-name3 tmp-name1)))) + + ;; Cleanup. (ignore-errors (delete-file tmp-name1) (delete-file tmp-name2))))) @@ -1200,6 +1272,8 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (set-visited-file-modtime '(0 1)) (should (verify-visited-file-modtime)) (should (equal (visited-file-modtime) '(0 1 0 0))))) + + ;; Cleanup. (ignore-errors (delete-file tmp-name))))) (ert-deftest tramp-test24-file-name-completion () @@ -1222,6 +1296,8 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (should (equal (sort (file-name-all-completions "b" tmp-name) 'string-lessp) '("bold" "boz/")))) + + ;; Cleanup. (ignore-errors (delete-directory tmp-name 'recursive))))) (ert-deftest tramp-test25-load () @@ -1238,6 +1314,8 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." ;(should-error (load tmp-name nil 'nomessage 'nosuffix 'must-suffix)) (load tmp-name nil 'nomessage 'nosuffix) (should (featurep 'tramp-test-load))) + + ;; Cleanup. (ignore-errors (and (featurep 'tramp-test-load) (unload-feature 'tramp-test-load)) (delete-file tmp-name))))) @@ -1284,6 +1362,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." ;; A non-nil DISPLAY must not raise the buffer. (should-not (get-buffer-window (current-buffer) t)))) + ;; Cleanup. (ignore-errors (delete-file tmp-name))))) (ert-deftest tramp-test27-start-file-process () @@ -1312,6 +1391,8 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (while (< (- (point-max) (point-min)) (length "foo")) (accept-process-output proc 1))) (should (string-equal (buffer-string) "foo"))) + + ;; Cleanup. (ignore-errors (delete-process proc))) (unwind-protect @@ -1328,6 +1409,8 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (while (< (- (point-max) (point-min)) (length "foo")) (accept-process-output proc 1))) (should (string-equal (buffer-string) "foo"))) + + ;; Cleanup. (ignore-errors (delete-process proc) (delete-file tmp-name))) @@ -1347,6 +1430,8 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (while (< (- (point-max) (point-min)) (length "foo")) (accept-process-output proc 1))) (should (string-equal (buffer-string) "foo"))) + + ;; Cleanup. (ignore-errors (delete-process proc))))) (ert-deftest tramp-test28-shell-command () @@ -1376,6 +1461,8 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (should (string-equal (format "%s\n" (file-name-nondirectory tmp-name)) (buffer-string)))) + + ;; Cleanup. (ignore-errors (delete-file tmp-name))) (unwind-protect @@ -1401,6 +1488,8 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (should (string-equal (format "%s\n" (file-name-nondirectory tmp-name)) (buffer-string)))) + + ;; Cleanup. (ignore-errors (delete-file tmp-name))) (unwind-protect @@ -1428,6 +1517,8 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (should (string-equal (format "%s\n" (file-name-nondirectory tmp-name)) (buffer-string)))) + + ;; Cleanup. (ignore-errors (delete-file tmp-name))))) (ert-deftest tramp-test29-vc-registered () @@ -1488,40 +1579,183 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (list (file-name-nondirectory tmp-name2))))))) (should (vc-registered tmp-name2))) - (ignore-errors (delete-directory tmp-name1 'recursive))))) + ;; Cleanup. + (ignore-errors (delete-directory tmp-name1 'recursive))))) + +(ert-deftest tramp-test30-make-auto-save-file-name () + "Check `make-auto-save-file-name'." + (skip-unless (tramp--test-enabled)) + + (let ((tmp-name1 (tramp--test-make-temp-name)) + (tmp-name2 (tramp--test-make-temp-name))) + + (unwind-protect + (progn + ;; Use default `auto-save-file-name-transforms' mechanism. + (let (tramp-auto-save-directory) + (with-temp-buffer + (setq buffer-file-name tmp-name1) + (should + (string-equal + (make-auto-save-file-name) + ;; This is taken from original `make-auto-save-file-name'. + (expand-file-name + (format + "#%s#" + (subst-char-in-string + ?/ ?! (replace-regexp-in-string "!" "!!" tmp-name1))) + temporary-file-directory))))) + + ;; No mapping. + (let (tramp-auto-save-directory auto-save-file-name-transforms) + (with-temp-buffer + (setq buffer-file-name tmp-name1) + (should + (string-equal + (make-auto-save-file-name) + (expand-file-name + (format "#%s#" (file-name-nondirectory tmp-name1)) + tramp-test-temporary-file-directory))))) + + ;; Use default `tramp-auto-save-directory' mechanism. + (let ((tramp-auto-save-directory tmp-name2)) + (with-temp-buffer + (setq buffer-file-name tmp-name1) + (should + (string-equal + (make-auto-save-file-name) + ;; This is taken from Tramp. + (expand-file-name + (format + "#%s#" + (tramp-subst-strs-in-string + '(("_" . "|") + ("/" . "_a") + (":" . "_b") + ("|" . "__") + ("[" . "_l") + ("]" . "_r")) + tmp-name1)) + tmp-name2))) + (should (file-directory-p tmp-name2)))) + + ;; Relative file names shall work, too. + (let ((tramp-auto-save-directory ".")) + (with-temp-buffer + (setq buffer-file-name tmp-name1 + default-directory tmp-name2) + (should + (string-equal + (make-auto-save-file-name) + ;; This is taken from Tramp. + (expand-file-name + (format + "#%s#" + (tramp-subst-strs-in-string + '(("_" . "|") + ("/" . "_a") + (":" . "_b") + ("|" . "__") + ("[" . "_l") + ("]" . "_r")) + tmp-name1)) + tmp-name2))) + (should (file-directory-p tmp-name2))))) + + ;; Cleanup. + (ignore-errors (delete-file tmp-name1)) + (ignore-errors (delete-directory tmp-name2 'recursive))))) + +(defun tramp--test-adb-p () + "Check, whether the remote host runs Android. +This requires restrictions of file name syntax." + (tramp-adb-file-name-p tramp-test-temporary-file-directory)) + +(defun tramp--test-ftp-p () + "Check, whether an FTP-like method is used. +This does not support globbing characters in file names (yet)." + ;; Globbing characters are ??, ?* and ?\[. + (and (eq (tramp-find-foreign-file-name-handler + tramp-test-temporary-file-directory) + 'tramp-sh-file-name-handler) + (string-match + "ftp$" (file-remote-p tramp-test-temporary-file-directory 'method)))) + +(defun tramp--test-gvfs-p () + "Check, whether the remote host runs a GVFS based method. +This requires restrictions of file name syntax." + (tramp-gvfs-file-name-p tramp-test-temporary-file-directory)) (defun tramp--test-smb-or-windows-nt-p () "Check, whether the locale or remote host runs MS Windows. This requires restrictions of file name syntax." (or (eq system-type 'windows-nt) - (eq (tramp-find-foreign-file-name-handler - tramp-test-temporary-file-directory) - 'tramp-smb-file-name-handler))) + (tramp-smb-file-name-p tramp-test-temporary-file-directory))) + +(defun tramp--test-hpux-p () + "Check, whether the remote host runs HP-UX. +Several special characters do not work properly there." + ;; We must refill the cache. + (with-parsed-tramp-file-name + (file-truename tramp-test-temporary-file-directory) nil + (string-match "^HP-UX" (tramp-get-connection-property v "uname" "")))) (defun tramp--test-check-files (&rest files) - "Runs a simple but comprehensive test over every file in FILES." - (let ((tmp-name1 (tramp--test-make-temp-name)) - (tmp-name2 (tramp--test-make-temp-name 'local))) + "Run a simple but comprehensive test over every file in FILES." + ;; We must use `file-truename' for the temporary directory, because + ;; it could be located on a symlinked directory. This would let the + ;; test fail. + (let* ((tramp-test-temporary-file-directory + (file-truename tramp-test-temporary-file-directory)) + (tmp-name1 (tramp--test-make-temp-name)) + (tmp-name2 (tramp--test-make-temp-name 'local)) + (files (delq nil files))) (unwind-protect (progn (make-directory tmp-name1) (make-directory tmp-name2) - (dolist (elt (delq nil files)) - (let ((file1 (expand-file-name elt tmp-name1)) - (file2 (expand-file-name elt tmp-name2))) + (dolist (elt files) + (let* ((file1 (expand-file-name elt tmp-name1)) + (file2 (expand-file-name elt tmp-name2)) + (file3 (expand-file-name (concat elt "foo") tmp-name1))) (write-region elt nil file1) (should (file-exists-p file1)) + ;; Check file contents. (with-temp-buffer (insert-file-contents file1) (should (string-equal (buffer-string) elt))) + ;; Copy file both directions. (copy-file file1 tmp-name2) (should (file-exists-p file2)) (delete-file file1) (should-not (file-exists-p file1)) (copy-file file2 tmp-name1) - (should (file-exists-p file1)))) + (should (file-exists-p file1)) + + ;; Method "smb" supports `make-symbolic-link' only if the + ;; remote host has CIFS capabilities. tramp-adb.el and + ;; tramp-gvfs.el do not support symbolic links at all. + (condition-case err + (progn + (make-symbolic-link file1 file3) + (should (file-symlink-p file3)) + (should + (string-equal + (expand-file-name file1) (file-truename file3))) + (should + (string-equal + (car (file-attributes file3)) + (file-remote-p (file-truename file1) 'localname))) + ;; Check file contents. + (with-temp-buffer + (insert-file-contents file3) + (should (string-equal (buffer-string) elt))) + (delete-file file3)) + (file-error + (should (string-equal (error-message-string err) + "make-symbolic-link not supported")))))) ;; Check file names. (should (equal (directory-files @@ -1548,55 +1782,247 @@ This requires restrictions of file name syntax." (should (equal (directory-files tmp-name1 nil directory-files-no-dot-files-regexp) (directory-files - tmp-name2 nil directory-files-no-dot-files-regexp)))) + tmp-name2 nil directory-files-no-dot-files-regexp))) + + ;; Check directory creation. We use a subdirectory "foo" + ;; in order to avoid conflicts with previous file name tests. + (dolist (elt files) + (let* ((elt1 (concat elt "foo")) + (file1 (expand-file-name (concat "foo/" elt) tmp-name1)) + (file2 (expand-file-name elt file1)) + (file3 (expand-file-name elt1 file1))) + (make-directory file1 'parents) + (should (file-directory-p file1)) + (write-region elt nil file2) + (should (file-exists-p file2)) + (should + (equal + (directory-files file1 nil directory-files-no-dot-files-regexp) + `(,elt))) + (should + (equal + (caar (directory-files-and-attributes + file1 nil directory-files-no-dot-files-regexp)) + elt)) + + ;; Check symlink in `directory-files-and-attributes'. + (condition-case err + (progn + (make-symbolic-link file2 file3) + (should (file-symlink-p file3)) + (should + (string-equal + (caar (directory-files-and-attributes + file1 nil (regexp-quote elt1))) + elt1)) + (should + (string-equal + (cadr (car (directory-files-and-attributes + file1 nil (regexp-quote elt1)))) + (file-remote-p (file-truename file2) 'localname))) + (delete-file file3) + (should-not (file-exists-p file3))) + (file-error + (should (string-equal (error-message-string err) + "make-symbolic-link not supported")))) + + (delete-file file2) + (should-not (file-exists-p file2)) + (delete-directory file1) + (should-not (file-exists-p file1))))) + ;; Cleanup. (ignore-errors (delete-directory tmp-name1 'recursive)) (ignore-errors (delete-directory tmp-name2 'recursive))))) -;; This test is inspired by Bug#17238. -(ert-deftest tramp-test30-special-characters () - "Check special characters in file names." - (skip-unless (tramp--test-enabled)) - (skip-unless - (not - (memq - (tramp-find-foreign-file-name-handler tramp-test-temporary-file-directory) - '(tramp-adb-file-name-handler - tramp-gvfs-file-name-handler)))) - - ;; Newlines, slashes and backslashes in file names are not supported. - ;; So we don't test. +(defun tramp--test-special-characters () + "Perform the test in `tramp-test31-special-characters*'." + ;; Newlines, slashes and backslashes in file names are not + ;; supported. So we don't test. And we don't test the tab + ;; character on Windows or Cygwin, because the backslash is + ;; interpreted as a path separator, preventing "\t" from being + ;; expanded to . (tramp--test-check-files - (if (tramp--test-smb-or-windows-nt-p) "foo bar baz" " foo\tbar baz\t") + (if (or (tramp--test-gvfs-p) (tramp--test-smb-or-windows-nt-p)) + "foo bar baz" + (if (or (tramp--test-adb-p) (eq system-type 'cygwin)) + " foo bar baz " + " foo\tbar baz\t")) "$foo$bar$$baz$" "-foo-bar-baz-" "%foo%bar%baz%" "&foo&bar&baz&" - (unless (tramp--test-smb-or-windows-nt-p) "?foo?bar?baz?") - (unless (tramp--test-smb-or-windows-nt-p) "*foo*bar*baz*") - (if (tramp--test-smb-or-windows-nt-p) "'foo'bar'baz'" "'foo\"bar'baz\"") + (unless (or (tramp--test-ftp-p) + (tramp--test-gvfs-p) + (tramp--test-smb-or-windows-nt-p)) + "?foo?bar?baz?") + (unless (or (tramp--test-ftp-p) + (tramp--test-gvfs-p) + (tramp--test-smb-or-windows-nt-p)) + "*foo*bar*baz*") + (if (or (tramp--test-gvfs-p) (tramp--test-smb-or-windows-nt-p)) + "'foo'bar'baz'" + "'foo\"bar'baz\"") "#foo~bar#baz~" - (if (tramp--test-smb-or-windows-nt-p) "!foo!bar!baz!" "!foo|bar!baz|") - (if (tramp--test-smb-or-windows-nt-p) ";foo;bar;baz;" ":foo;bar:baz;") - (unless (tramp--test-smb-or-windows-nt-p) "bar") + (if (or (tramp--test-gvfs-p) (tramp--test-smb-or-windows-nt-p)) + "!foo!bar!baz!" + "!foo|bar!baz|") + (if (or (tramp--test-gvfs-p) (tramp--test-smb-or-windows-nt-p)) + ";foo;bar;baz;" + ":foo;bar:baz;") + (unless (or (tramp--test-gvfs-p) (tramp--test-smb-or-windows-nt-p)) + "bar") "(foo)bar(baz)" - "[foo]bar[baz]" + (unless (or (tramp--test-ftp-p) (tramp--test-gvfs-p)) "[foo]bar[baz]") "{foo}bar{baz}")) -(ert-deftest tramp-test31-utf8 () - "Check UTF8 encoding in file names and file contents." +;; These tests are inspired by Bug#17238. +(ert-deftest tramp-test31-special-characters () + "Check special characters in file names." (skip-unless (tramp--test-enabled)) + (tramp--test-special-characters)) + +(ert-deftest tramp-test31-special-characters-with-stat () + "Check special characters in file names. +Use the `stat' command." + (skip-unless (tramp--test-enabled)) + (skip-unless + (eq + (tramp-find-foreign-file-name-handler tramp-test-temporary-file-directory) + 'tramp-sh-file-name-handler)) + (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil + (skip-unless (tramp-get-remote-stat v))) + + (unwind-protect + (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil + (tramp-set-connection-property v "perl" nil) + (tramp--test-special-characters)) + + ;; Reset suppressed properties. + (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil + (tramp-set-connection-property v "perl" 'undef)))) + +(ert-deftest tramp-test31-special-characters-with-perl () + "Check special characters in file names. +Use the `perl' command." + (skip-unless (tramp--test-enabled)) + (skip-unless + (eq + (tramp-find-foreign-file-name-handler tramp-test-temporary-file-directory) + 'tramp-sh-file-name-handler)) + (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil + (skip-unless (tramp-get-remote-perl v))) + + (unwind-protect + (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil + (tramp-set-connection-property v "stat" nil) + (tramp--test-special-characters)) + + ;; Reset suppressed properties. + (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil + (tramp-set-connection-property v "stat" 'undef)))) + +(ert-deftest tramp-test31-special-characters-with-ls () + "Check special characters in file names. +Use the `ls' command." + (skip-unless (tramp--test-enabled)) + (skip-unless + (eq + (tramp-find-foreign-file-name-handler tramp-test-temporary-file-directory) + 'tramp-sh-file-name-handler)) + + (unwind-protect + (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil + (tramp-set-connection-property v "stat" nil) + (tramp-set-connection-property v "perl" nil) + (tramp--test-special-characters)) + + ;; Reset suppressed properties. + (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil + (tramp-set-connection-property v "stat" 'undef) + (tramp-set-connection-property v "perl" 'undef)))) + +(defun tramp--test-utf8 () + "Perform the test in `tramp-test32-utf8*'." (let ((coding-system-for-read 'utf-8) (coding-system-for-write 'utf-8) (file-name-coding-system 'utf-8)) (tramp--test-check-files - "أصبح بوسعك الآن تنزيل نسخة كاملة من موسوعة ويكيبيديا العربية لتصفحها بلا اتصال بالإنترنت" + (unless (tramp--test-hpux-p) "Γυρίστε το Γαλαξία με Ώτο Στοπ") + (unless (tramp--test-hpux-p) + "أصبح بوسعك الآن تنزيل نسخة كاملة من موسوعة ويكيبيديا العربية لتصفحها بلا اتصال بالإنترنت") "银河系漫游指南系列" "Автостопом по гала́ктике"))) +(ert-deftest tramp-test32-utf8 () + "Check UTF8 encoding in file names and file contents." + (skip-unless (tramp--test-enabled)) + + (tramp--test-utf8)) + +(ert-deftest tramp-test32-utf8-with-stat () + "Check UTF8 encoding in file names and file contents. +Use the `stat' command." + (skip-unless (tramp--test-enabled)) + (skip-unless + (eq + (tramp-find-foreign-file-name-handler tramp-test-temporary-file-directory) + 'tramp-sh-file-name-handler)) + (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil + (skip-unless (tramp-get-remote-stat v))) + + (unwind-protect + (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil + (tramp-set-connection-property v "perl" nil) + (tramp--test-utf8)) + + ;; Reset suppressed properties. + (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil + (tramp-set-connection-property v "perl" 'undef)))) + +(ert-deftest tramp-test32-utf8-with-perl () + "Check UTF8 encoding in file names and file contents. +Use the `perl' command." + (skip-unless (tramp--test-enabled)) + (skip-unless + (eq + (tramp-find-foreign-file-name-handler tramp-test-temporary-file-directory) + 'tramp-sh-file-name-handler)) + (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil + (skip-unless (tramp-get-remote-perl v))) + + (unwind-protect + (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil + (tramp-set-connection-property v "stat" nil) + (tramp--test-utf8)) + + ;; Reset suppressed properties. + (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil + (tramp-set-connection-property v "stat" 'undef)))) + +(ert-deftest tramp-test32-utf8-with-ls () + "Check UTF8 encoding in file names and file contents. +Use the `ls' command." + (skip-unless (tramp--test-enabled)) + (skip-unless + (eq + (tramp-find-foreign-file-name-handler tramp-test-temporary-file-directory) + 'tramp-sh-file-name-handler)) + + (unwind-protect + (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil + (tramp-set-connection-property v "stat" nil) + (tramp-set-connection-property v "perl" nil) + (tramp--test-utf8)) + + ;; Reset suppressed properties. + (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil + (tramp-set-connection-property v "stat" 'undef) + (tramp-set-connection-property v "perl" 'undef)))) + ;; This test is inspired by Bug#16928. -(ert-deftest tramp-test32-asynchronous-requests () +(ert-deftest tramp-test33-asynchronous-requests () "Check parallel asynchronous requests. Such requests could arrive from timers, process filters and process sentinels. They shall not disturb each other." @@ -1685,7 +2111,7 @@ process sentinels. They shall not disturb each other." (dolist (buf buffers) (ignore-errors (kill-buffer buf))))))) -(ert-deftest tramp-test33-recursive-load () +(ert-deftest tramp-test34-recursive-load () "Check that Tramp does not fail due to recursive load." (skip-unless (tramp--test-enabled)) @@ -1708,7 +2134,7 @@ process sentinels. They shall not disturb each other." (mapconcat 'shell-quote-argument load-path " -L ") (shell-quote-argument code))))))) -(ert-deftest tramp-test34-unload () +(ert-deftest tramp-test35-unload () "Check that Tramp and its subpackages unload completely. Since it unloads Tramp, it shall be the last test to run." ;; Mark as failed until all symbols are unbound. @@ -1729,7 +2155,6 @@ Since it unloads Tramp, it shall be the last test to run." (not (string-match "^tramp--?test" (symbol-name x))) (not (string-match "unload-hook$" (symbol-name x))) (ert-fail (format "`%s' still bound" x))))) -; (progn (message "`%s' still bound" x))))) ;; There shouldn't be left a hook function containing a Tramp ;; function. We do not regard the Tramp unload hooks. (mapatoms @@ -1749,7 +2174,6 @@ Since it unloads Tramp, it shall be the last test to run." ;; * file-ownership-preserved-p ;; * file-selinux-context ;; * find-backup-file-name -;; * make-auto-save-file-name ;; * set-file-acl ;; * set-file-selinux-context @@ -1758,11 +2182,11 @@ Since it unloads Tramp, it shall be the last test to run." ;; doesn't work well when an interactive password must be provided. ;; * Fix `tramp-test27-start-file-process' for `nc' and on MS ;; Windows (`process-send-eof'?). -;; * Fix `tramp-test30-special-characters' for `adb' and `nc'. -;; * Fix `tramp-test31-utf8' for `nc'/`telnet' (when target is a dumb +;; * Fix `tramp-test31-special-characters' for `nc'. +;; * Fix `tramp-test32-utf8' for `nc'/`telnet' (when target is a dumb ;; busybox). Seems to be in `directory-files'. -;; * Fix Bug#16928. Set expected error of `tramp-test32-asynchronous-requests'. -;; * Fix `tramp-test34-unload' (Not all symbols are unbound). Set +;; * Fix Bug#16928. Set expected error of `tramp-test33-asynchronous-requests'. +;; * Fix `tramp-test35-unload' (Not all symbols are unbound). Set ;; expected error. (defun tramp-test-all (&optional interactive)