1;;; tramp-tests.el --- Tests of remote file access -*- lexical-binding:t -*- 2 3;; Copyright (C) 2013-2021 Free Software Foundation, Inc. 4 5;; Author: Michael Albinus <michael.albinus@gmx.de> 6 7;; This file is part of GNU Emacs. 8;; 9;; GNU Emacs is free software: you can redistribute it and/or 10;; modify it under the terms of the GNU General Public License as 11;; published by the Free Software Foundation, either version 3 of the 12;; License, or (at your option) any later version. 13;; 14;; GNU Emacs is distributed in the hope that it will be useful, but 15;; WITHOUT ANY WARRANTY; without even the implied warranty of 16;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 17;; General Public License for more details. 18;; 19;; You should have received a copy of the GNU General Public License 20;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. 21 22;;; Commentary: 23 24;; Some of the tests require access to a remote host files. Since 25;; this could be problematic, a mock-up connection method "mock" is 26;; used. Emulating a remote connection, it simply calls "sh -i". 27;; Tramp's file name handlers still run, so this test is sufficient 28;; except for connection establishing. 29 30;; If you want to test a real Tramp connection, set 31;; $REMOTE_TEMPORARY_FILE_DIRECTORY to a suitable value in order to 32;; overwrite the default value. If you want to skip tests accessing a 33;; remote host, set this environment variable to "/dev/null" or 34;; whatever is appropriate on your system. 35 36;; For slow remote connections, `tramp-test44-asynchronous-requests' 37;; might be too heavy. Setting $REMOTE_PARALLEL_PROCESSES to a proper 38;; value less than 10 could help. 39 40;; A whole test run can be performed calling the command `tramp-test-all'. 41 42;;; Code: 43 44(require 'cl-lib) 45(require 'dired) 46(require 'dired-aux) 47(require 'ert) 48(require 'ert-x) 49(require 'seq) ; For `seq-random-elt', autoloaded since Emacs 28.1 50(require 'trace) 51(require 'tramp) 52(require 'vc) 53(require 'vc-bzr) 54(require 'vc-git) 55(require 'vc-hg) 56 57(declare-function tramp-check-remote-uname "tramp-sh") 58(declare-function tramp-find-executable "tramp-sh") 59(declare-function tramp-get-remote-chmod-h "tramp-sh") 60(declare-function tramp-get-remote-path "tramp-sh") 61(declare-function tramp-get-remote-perl "tramp-sh") 62(declare-function tramp-get-remote-stat "tramp-sh") 63(declare-function tramp-list-tramp-buffers "tramp-cmds") 64(declare-function tramp-method-out-of-band-p "tramp-sh") 65(declare-function tramp-smb-get-localname "tramp-smb") 66(defvar ange-ftp-make-backup-files) 67(defvar auto-save-file-name-transforms) 68(defvar lock-file-name-transforms) 69(defvar remote-file-name-inhibit-locks) 70(defvar tramp-connection-properties) 71(defvar tramp-copy-size-limit) 72(defvar tramp-display-escape-sequence-regexp) 73(defvar tramp-fuse-unmount-on-cleanup) 74(defvar tramp-inline-compress-start-size) 75(defvar tramp-persistency-file-name) 76(defvar tramp-remote-path) 77(defvar tramp-remote-process-environment) 78 79;; Needed for Emacs 27. 80(defvar process-file-return-signal-string) 81(defvar shell-command-dont-erase-buffer) 82;; Needed for Emacs 28. 83(defvar dired-copy-dereference) 84 85;; Beautify batch mode. 86(when noninteractive 87 ;; Suppress nasty messages. 88 (fset #'shell-command-sentinel #'ignore) 89 ;; We do not want to be interrupted. 90 (eval-after-load 'tramp-gvfs 91 '(fset 'tramp-gvfs-handler-askquestion 92 (lambda (_message _choices) '(t nil 0))))) 93 94;; There is no default value on w32 systems, which could work out of the box. 95(defconst tramp-test-temporary-file-directory 96 (cond 97 ((getenv "REMOTE_TEMPORARY_FILE_DIRECTORY")) 98 ((eq system-type 'windows-nt) null-device) 99 (t (add-to-list 100 'tramp-methods 101 '("mock" 102 (tramp-login-program "sh") 103 (tramp-login-args (("-i"))) 104 (tramp-remote-shell "/bin/sh") 105 (tramp-remote-shell-args ("-c")) 106 (tramp-connection-timeout 10))) 107 (add-to-list 108 'tramp-default-host-alist 109 `("\\`mock\\'" nil ,(system-name))) 110 ;; Emacs's Makefile sets $HOME to a nonexistent value. Needed 111 ;; in batch mode only, therefore. 112 (unless (and (null noninteractive) (file-directory-p "~/")) 113 (setenv "HOME" temporary-file-directory)) 114 (format "/mock::%s" temporary-file-directory))) 115 "Temporary directory for Tramp tests.") 116 117(defconst tramp-test-vec 118 (and (file-remote-p tramp-test-temporary-file-directory) 119 (tramp-dissect-file-name tramp-test-temporary-file-directory)) 120 "The used `tramp-file-name' structure.") 121 122(setq auth-source-save-behavior nil 123 password-cache-expiry nil 124 remote-file-name-inhibit-cache nil 125 tramp-allow-unsafe-temporary-files t 126 tramp-cache-read-persistent-data t ;; For auth-sources. 127 tramp-copy-size-limit nil 128 tramp-persistency-file-name nil 129 tramp-verbose 0) 130 131;; This should happen on hydra only. 132(when (getenv "EMACS_HYDRA_CI") 133 (add-to-list 'tramp-remote-path 'tramp-own-remote-path)) 134 135(defvar tramp--test-enabled-checked nil 136 "Cached result of `tramp--test-enabled'. 137If the function did run, the value is a cons cell, the `cdr' 138being the result.") 139 140(defun tramp--test-enabled () 141 "Whether remote file access is enabled." 142 (unless (consp tramp--test-enabled-checked) 143 (setq 144 tramp--test-enabled-checked 145 (cons 146 t (ignore-errors 147 (and 148 (file-remote-p tramp-test-temporary-file-directory) 149 (file-directory-p tramp-test-temporary-file-directory) 150 (file-writable-p tramp-test-temporary-file-directory)))))) 151 152 (when (cdr tramp--test-enabled-checked) 153 ;; Cleanup connection. 154 (ignore-errors 155 (tramp-cleanup-connection tramp-test-vec nil 'keep-password))) 156 157 ;; Return result. 158 (cdr tramp--test-enabled-checked)) 159 160(defun tramp--test-make-temp-name (&optional local quoted) 161 "Return a temporary file name for test. 162If LOCAL is non-nil, a local file name is returned. 163If QUOTED is non-nil, the local part of the file name is quoted. 164The temporary file is not created." 165 (funcall 166 (if quoted #'tramp-compat-file-name-quote #'identity) 167 (expand-file-name 168 (make-temp-name "tramp-test") 169 (if local temporary-file-directory tramp-test-temporary-file-directory)))) 170 171;; Method "smb" supports `make-symbolic-link' only if the remote host 172;; has CIFS capabilities. tramp-adb.el, tramp-gvfs.el, tramp-rclone.el 173;; and tramp-sshfs.el do not support symbolic links at all. 174(defmacro tramp--test-ignore-make-symbolic-link-error (&rest body) 175 "Run BODY, ignoring \"make-symbolic-link not supported\" file error." 176 (declare (indent defun) (debug (body))) 177 `(condition-case err 178 (progn ,@body) 179 (file-error 180 (unless (string-equal (error-message-string err) 181 "make-symbolic-link not supported") 182 (signal (car err) (cdr err)))))) 183 184;; Don't print messages in nested `tramp--test-instrument-test-case' calls. 185(defvar tramp--test-instrument-test-case-p nil 186 "Whether `tramp--test-instrument-test-case' run. 187This shall used dynamically bound only.") 188 189;; When `tramp-verbose' is greater than 10, and you want to trace 190;; other functions as well, do something like 191;; (let ((tramp-trace-functions '(file-name-non-special))) 192;; (tramp--test-instrument-test-case 11 193;; ...)) 194(defmacro tramp--test-instrument-test-case (verbose &rest body) 195 "Run BODY with `tramp-verbose' equal VERBOSE. 196Print the content of the Tramp connection and debug buffers, if 197`tramp-verbose' is greater than 3. Print traces if `tramp-verbose' 198is greater than 10. 199`should-error' is not handled properly. BODY shall not contain a timeout." 200 (declare (indent 1) (debug (natnump body))) 201 `(let* ((tramp-verbose (max (or ,verbose 0) (or tramp-verbose 0))) 202 (trace-buffer (tramp-trace-buffer-name tramp-test-vec)) 203 (debug-ignored-errors 204 (append 205 '("^make-symbolic-link not supported$" 206 "^error with add-name-to-file") 207 debug-ignored-errors)) 208 inhibit-message) 209 (unwind-protect 210 (let ((tramp--test-instrument-test-case-p t)) ,@body) 211 ;; Unwind forms. 212 (when (and (null tramp--test-instrument-test-case-p) (> tramp-verbose 3)) 213 (untrace-all) 214 (dolist (buf (tramp-list-tramp-buffers)) 215 (message ";; %s\n%s" buf (tramp-get-buffer-string buf)) 216 (kill-buffer buf)))))) 217 218(defsubst tramp--test-message (fmt-string &rest arguments) 219 "Emit a message into ERT *Messages*." 220 (tramp--test-instrument-test-case 0 221 (apply #'tramp-message tramp-test-vec 0 fmt-string arguments))) 222 223(defsubst tramp--test-backtrace () 224 "Dump a backtrace into ERT *Messages*." 225 (tramp--test-instrument-test-case 10 226 (tramp-backtrace tramp-test-vec))) 227 228(defmacro tramp--test-print-duration (message &rest body) 229 "Run BODY and print a message with duration, prompted by MESSAGE." 230 (declare (indent 1) (debug (stringp body))) 231 `(let ((start (current-time))) 232 (unwind-protect 233 (progn ,@body) 234 (tramp--test-message 235 "%s %f sec" ,message (float-time (time-subtract nil start)))))) 236 237;; `always' is introduced with Emacs 28.1. 238(defalias 'tramp--test-always 239 (if (fboundp 'always) 240 #'always 241 (lambda (&rest _arguments) 242 "Do nothing and return t. 243This function accepts any number of ARGUMENTS, but ignores them. 244Also see `ignore'." 245 t))) 246 247(ert-deftest tramp-test00-availability () 248 "Test availability of Tramp functions." 249 :expected-result (if (tramp--test-enabled) :passed :failed) 250 (tramp--test-message 251 "Remote directory: `%s'" tramp-test-temporary-file-directory) 252 (should (ignore-errors 253 (and 254 (file-remote-p tramp-test-temporary-file-directory) 255 (file-directory-p tramp-test-temporary-file-directory) 256 (file-writable-p tramp-test-temporary-file-directory))))) 257 258(ert-deftest tramp-test01-file-name-syntax () 259 "Check remote file name syntax." 260 (let ((syntax tramp-syntax)) 261 (unwind-protect 262 (progn 263 (tramp-change-syntax 'default) 264 ;; Simple cases. 265 (should (tramp-tramp-file-p "/method::")) 266 (should (tramp-tramp-file-p "/method:host:")) 267 (should (tramp-tramp-file-p "/method:user@:")) 268 (should (tramp-tramp-file-p "/method:user@host:")) 269 (should (tramp-tramp-file-p "/method:user@email@host:")) 270 271 ;; Using a port. 272 (should (tramp-tramp-file-p "/method:host#1234:")) 273 (should (tramp-tramp-file-p "/method:user@host#1234:")) 274 275 ;; Using an IPv4 address. 276 (should (tramp-tramp-file-p "/method:1.2.3.4:")) 277 (should (tramp-tramp-file-p "/method:user@1.2.3.4:")) 278 279 ;; Using an IPv6 address. 280 (should (tramp-tramp-file-p "/method:[::1]:")) 281 (should (tramp-tramp-file-p "/method:user@[::1]:")) 282 283 ;; Using an IPv4 mapped IPv6 address. 284 (should (tramp-tramp-file-p "/method:[::ffff:1.2.3.4]:")) 285 (should (tramp-tramp-file-p "/method:user@[::ffff:1.2.3.4]:")) 286 287 ;; Local file name part. 288 (should (tramp-tramp-file-p "/method:::")) 289 (should (tramp-tramp-file-p "/method::/:")) 290 (should (tramp-tramp-file-p "/method::/path/to/file")) 291 (should (tramp-tramp-file-p "/method::/:/path/to/file")) 292 (should (tramp-tramp-file-p "/method::file")) 293 (should (tramp-tramp-file-p "/method::/:file")) 294 295 ;; Multihop. 296 (should (tramp-tramp-file-p "/method1:|method2::")) 297 (should 298 (tramp-tramp-file-p "/method1:host1|method2:host2:")) 299 (should 300 (tramp-tramp-file-p "/method1:user1@host1|method2:user2@host2:")) 301 (should 302 (tramp-tramp-file-p 303 "/method1:user1@host1|method2:user2@host2|method3:user3@host3:")) 304 305 ;; No strings. 306 (should-not (tramp-tramp-file-p nil)) 307 (should-not (tramp-tramp-file-p 'symbol)) 308 ;; No newline or linefeed. 309 (should-not (tramp-tramp-file-p "/method::file\nname")) 310 (should-not (tramp-tramp-file-p "/method::file\rname")) 311 ;; Ange-FTP syntax. 312 (should-not (tramp-tramp-file-p "/host:")) 313 (should-not (tramp-tramp-file-p "/user@host:")) 314 (should-not (tramp-tramp-file-p "/1.2.3.4:")) 315 (should-not (tramp-tramp-file-p "/[]:")) 316 (should-not (tramp-tramp-file-p "/[::1]:")) 317 (should-not (tramp-tramp-file-p "/[::ffff:1.2.3.4]:")) 318 (should-not (tramp-tramp-file-p "/host:/:")) 319 (should-not (tramp-tramp-file-p "/host1|host2:")) 320 (should-not (tramp-tramp-file-p "/user1@host1|user2@host2:")) 321 ;; Quote with "/:" suppresses file name handlers. 322 (should-not (tramp-tramp-file-p "/::")) 323 (should-not (tramp-tramp-file-p "/:@:")) 324 (should-not (tramp-tramp-file-p "/:[]:")) 325 ;; When `tramp-mode' is nil, Tramp is not activated. 326 (let (tramp-mode) 327 (should-not (tramp-tramp-file-p "/method:user@host:"))) 328 ;; `tramp-ignored-file-name-regexp' suppresses Tramp. 329 (let ((tramp-ignored-file-name-regexp "^/method:user@host:")) 330 (should-not (tramp-tramp-file-p "/method:user@host:"))) 331 ;; Methods shall be at least two characters on MS Windows, 332 ;; except the default method. 333 (let ((system-type 'windows-nt)) 334 (should-not (tramp-tramp-file-p "/c:/path/to/file")) 335 (should-not (tramp-tramp-file-p "/c::/path/to/file")) 336 (should (tramp-tramp-file-p "/-::/path/to/file"))) 337 (let ((system-type 'gnu/linux)) 338 (should (tramp-tramp-file-p "/-:h:/path/to/file")) 339 (should (tramp-tramp-file-p "/m::/path/to/file")))) 340 341 ;; Exit. 342 (tramp-change-syntax syntax)))) 343 344(ert-deftest tramp-test01-file-name-syntax-simplified () 345 "Check simplified file name syntax." 346 :tags '(:expensive-test) 347 (let ((syntax tramp-syntax)) 348 (unwind-protect 349 (progn 350 (tramp-change-syntax 'simplified) 351 ;; Simple cases. 352 (should (tramp-tramp-file-p "/host:")) 353 (should (tramp-tramp-file-p "/user@:")) 354 (should (tramp-tramp-file-p "/user@host:")) 355 (should (tramp-tramp-file-p "/user@email@host:")) 356 357 ;; Using a port. 358 (should (tramp-tramp-file-p "/host#1234:")) 359 (should (tramp-tramp-file-p "/user@host#1234:")) 360 361 ;; Using an IPv4 address. 362 (should (tramp-tramp-file-p "/1.2.3.4:")) 363 (should (tramp-tramp-file-p "/user@1.2.3.4:")) 364 365 ;; Using an IPv6 address. 366 (should (tramp-tramp-file-p "/[::1]:")) 367 (should (tramp-tramp-file-p "/user@[::1]:")) 368 369 ;; Using an IPv4 mapped IPv6 address. 370 (should (tramp-tramp-file-p "/[::ffff:1.2.3.4]:")) 371 (should (tramp-tramp-file-p "/user@[::ffff:1.2.3.4]:")) 372 373 ;; Local file name part. 374 (should (tramp-tramp-file-p "/host::")) 375 (should (tramp-tramp-file-p "/host:/:")) 376 (should (tramp-tramp-file-p "/host:/path/to/file")) 377 (should (tramp-tramp-file-p "/host:/:/path/to/file")) 378 (should (tramp-tramp-file-p "/host:file")) 379 (should (tramp-tramp-file-p "/host:/:file")) 380 381 ;; Multihop. 382 (should (tramp-tramp-file-p "/host1|host2:")) 383 (should (tramp-tramp-file-p "/user1@host1|user2@host2:")) 384 (should (tramp-tramp-file-p "/user1@host1|user2@host2|user3@host3:")) 385 386 ;; No strings. 387 (should-not (tramp-tramp-file-p nil)) 388 (should-not (tramp-tramp-file-p 'symbol)) 389 ;; Quote with "/:" suppresses file name handlers. 390 (should-not (tramp-tramp-file-p "/::")) 391 (should-not (tramp-tramp-file-p "/:@:")) 392 (should-not (tramp-tramp-file-p "/:[]:"))) 393 394 ;; Exit. 395 (tramp-change-syntax syntax)))) 396 397(ert-deftest tramp-test01-file-name-syntax-separate () 398 "Check separate file name syntax." 399 :tags '(:expensive-test) 400 (let ((syntax tramp-syntax)) 401 (unwind-protect 402 (progn 403 (tramp-change-syntax 'separate) 404 ;; Simple cases. 405 (should (tramp-tramp-file-p "/[method/]")) 406 (should (tramp-tramp-file-p "/[method/host]")) 407 (should (tramp-tramp-file-p "/[method/user@]")) 408 (should (tramp-tramp-file-p "/[method/user@host]")) 409 (should (tramp-tramp-file-p "/[method/user@email@host]")) 410 411 ;; Using a port. 412 (should (tramp-tramp-file-p "/[method/host#1234]")) 413 (should (tramp-tramp-file-p "/[method/user@host#1234]")) 414 415 ;; Using an IPv4 address. 416 (should (tramp-tramp-file-p "/[method/1.2.3.4]")) 417 (should (tramp-tramp-file-p "/[method/user@1.2.3.4]")) 418 419 ;; Using an IPv6 address. 420 (should (tramp-tramp-file-p "/[method/::1]")) 421 (should (tramp-tramp-file-p "/[method/user@::1]")) 422 423 ;; Using an IPv4 mapped IPv6 address. 424 (should (tramp-tramp-file-p "/[method/::ffff:1.2.3.4]")) 425 (should (tramp-tramp-file-p "/[method/user@::ffff:1.2.3.4]")) 426 427 ;; Local file name part. 428 (should (tramp-tramp-file-p "/[method/]")) 429 (should (tramp-tramp-file-p "/[method/]/:")) 430 (should (tramp-tramp-file-p "/[method/]/path/to/file")) 431 (should (tramp-tramp-file-p "/[method/]/:/path/to/file")) 432 (should (tramp-tramp-file-p "/[method/]file")) 433 (should (tramp-tramp-file-p "/[method/]/:file")) 434 435 ;; Multihop. 436 (should (tramp-tramp-file-p "/[method1/|method2/]")) 437 (should (tramp-tramp-file-p "/[method1/host1|method2/host2]")) 438 (should 439 (tramp-tramp-file-p 440 "/[method1/user1@host1|method2/user2@host2]")) 441 (should 442 (tramp-tramp-file-p 443 "/[method1/user1@host1|method2/user2@host2|method3/user3@host3]")) 444 445 ;; No strings. 446 (should-not (tramp-tramp-file-p nil)) 447 (should-not (tramp-tramp-file-p 'symbol)) 448 ;; Ange-FTP syntax. 449 (should-not (tramp-tramp-file-p "/host:")) 450 (should-not (tramp-tramp-file-p "/user@host:")) 451 (should-not (tramp-tramp-file-p "/1.2.3.4:")) 452 (should-not (tramp-tramp-file-p "/host:/:")) 453 (should-not (tramp-tramp-file-p "/host1|host2:")) 454 (should-not (tramp-tramp-file-p "/user1@host1|user2@host2:")) 455 ;; Quote with "/:" suppresses file name handlers. 456 (should-not (tramp-tramp-file-p "/:[]"))) 457 458 ;; Exit. 459 (tramp-change-syntax syntax)))) 460 461(ert-deftest tramp-test02-file-name-dissect () 462 "Check remote file name components." 463 (let ((tramp-default-method "default-method") 464 (tramp-default-user "default-user") 465 (tramp-default-host "default-host") 466 tramp-default-method-alist 467 tramp-default-user-alist 468 tramp-default-host-alist 469 ;; Suppress method name check. 470 (non-essential t) 471 ;; Suppress check for multihops. 472 (tramp-cache-data (make-hash-table :test #'equal)) 473 (tramp-connection-properties '((nil "login-program" t))) 474 (syntax tramp-syntax)) 475 (unwind-protect 476 (progn 477 (tramp-change-syntax 'default) 478 ;; An unknown method shall raise an error. 479 (let (non-essential) 480 (should-error 481 (expand-file-name "/method:user@host:") 482 :type 'user-error)) 483 484 ;; Expand `tramp-default-user' and `tramp-default-host'. 485 (should 486 (string-equal 487 (file-remote-p "/method::") 488 (format "/%s:%s@%s:" "method" "default-user" "default-host"))) 489 (should (string-equal (file-remote-p "/method::" 'method) "method")) 490 (should 491 (string-equal (file-remote-p "/method::" 'user) "default-user")) 492 (should 493 (string-equal (file-remote-p "/method::" 'host) "default-host")) 494 (should (string-equal (file-remote-p "/method::" 'localname) "")) 495 (should (string-equal (file-remote-p "/method::" 'hop) nil)) 496 497 ;; Expand `tramp-default-method' and `tramp-default-user'. 498 (should 499 (string-equal 500 (file-remote-p "/-:host:") 501 (format "/%s:%s@%s:" "default-method" "default-user" "host"))) 502 (should 503 (string-equal (file-remote-p "/-:host:" 'method) "default-method")) 504 (should 505 (string-equal (file-remote-p "/-:host:" 'user) "default-user")) 506 (should (string-equal (file-remote-p "/-:host:" 'host) "host")) 507 (should (string-equal (file-remote-p "/-:host:" 'localname) "")) 508 (should (string-equal (file-remote-p "/-:host:" 'hop) nil)) 509 510 ;; Expand `tramp-default-method' and `tramp-default-host'. 511 (should 512 (string-equal 513 (file-remote-p "/-:user@:") 514 (format "/%s:%s@%s:" "default-method" "user" "default-host"))) 515 (should 516 (string-equal (file-remote-p "/-:user@:" 'method) "default-method")) 517 (should (string-equal (file-remote-p "/-:user@:" 'user) "user")) 518 (should 519 (string-equal (file-remote-p "/-:user@:" 'host) "default-host")) 520 (should (string-equal (file-remote-p "/-:user@:" 'localname) "")) 521 (should (string-equal (file-remote-p "/-:user@:" 'hop) nil)) 522 523 ;; Expand `tramp-default-method'. 524 (should (string-equal 525 (file-remote-p "/-:user@host:") 526 (format "/%s:%s@%s:" "default-method" "user" "host"))) 527 (should (string-equal 528 (file-remote-p "/-:user@host:" 'method) "default-method")) 529 (should (string-equal (file-remote-p "/-:user@host:" 'user) "user")) 530 (should (string-equal (file-remote-p "/-:user@host:" 'host) "host")) 531 (should (string-equal (file-remote-p "/-:user@host:" 'localname) "")) 532 (should (string-equal (file-remote-p "/-:user@host:" 'hop) nil)) 533 534 ;; Expand `tramp-default-user'. 535 (should (string-equal 536 (file-remote-p "/method:host:") 537 (format "/%s:%s@%s:" "method" "default-user" "host"))) 538 (should 539 (string-equal (file-remote-p "/method:host:" 'method) "method")) 540 (should 541 (string-equal (file-remote-p "/method:host:" 'user) "default-user")) 542 (should (string-equal (file-remote-p "/method:host:" 'host) "host")) 543 (should (string-equal (file-remote-p "/method:host:" 'localname) "")) 544 (should (string-equal (file-remote-p "/method:host:" 'hop) nil)) 545 546 ;; Expand `tramp-default-host'. 547 (should 548 (string-equal 549 (file-remote-p "/method:user@:") 550 (format "/%s:%s@%s:" "method" "user" "default-host"))) 551 (should 552 (string-equal (file-remote-p "/method:user@:" 'method) "method")) 553 (should (string-equal (file-remote-p "/method:user@:" 'user) "user")) 554 (should 555 (string-equal (file-remote-p "/method:user@:" 'host) "default-host")) 556 (should (string-equal (file-remote-p "/method:user@:" 'localname) "")) 557 (should (string-equal (file-remote-p "/method:user@:" 'hop) nil)) 558 559 ;; No expansion. 560 (should (string-equal 561 (file-remote-p "/method:user@host:") 562 (format "/%s:%s@%s:" "method" "user" "host"))) 563 (should (string-equal 564 (file-remote-p "/method:user@host:" 'method) "method")) 565 (should 566 (string-equal (file-remote-p "/method:user@host:" 'user) "user")) 567 (should 568 (string-equal (file-remote-p "/method:user@host:" 'host) "host")) 569 (should 570 (string-equal (file-remote-p "/method:user@host:" 'localname) "")) 571 (should (string-equal (file-remote-p "/method:user@host:" 'hop) nil)) 572 573 ;; No expansion. 574 (should (string-equal 575 (file-remote-p "/method:user@email@host:") 576 (format "/%s:%s@%s:" "method" "user@email" "host"))) 577 (should (string-equal 578 (file-remote-p "/method:user@email@host:" 'method) "method")) 579 (should 580 (string-equal 581 (file-remote-p "/method:user@email@host:" 'user) "user@email")) 582 (should (string-equal 583 (file-remote-p "/method:user@email@host:" 'host) "host")) 584 (should (string-equal 585 (file-remote-p "/method:user@email@host:" 'localname) "")) 586 (should (string-equal 587 (file-remote-p "/method:user@email@host:" 'hop) nil)) 588 589 ;; Expand `tramp-default-method' and `tramp-default-user'. 590 (should 591 (string-equal 592 (file-remote-p "/-:host#1234:") 593 (format "/%s:%s@%s:" "default-method" "default-user" "host#1234"))) 594 (should (string-equal 595 (file-remote-p "/-:host#1234:" 'method) "default-method")) 596 (should 597 (string-equal (file-remote-p "/-:host#1234:" 'user) "default-user")) 598 (should 599 (string-equal (file-remote-p "/-:host#1234:" 'host) "host#1234")) 600 (should (string-equal (file-remote-p "/-:host#1234:" 'localname) "")) 601 (should (string-equal (file-remote-p "/-:host#1234:" 'hop) nil)) 602 603 ;; Expand `tramp-default-method'. 604 (should (string-equal 605 (file-remote-p "/-:user@host#1234:") 606 (format "/%s:%s@%s:" "default-method" "user" "host#1234"))) 607 (should 608 (string-equal 609 (file-remote-p "/-:user@host#1234:" 'method) "default-method")) 610 (should 611 (string-equal (file-remote-p "/-:user@host#1234:" 'user) "user")) 612 (should 613 (string-equal 614 (file-remote-p "/-:user@host#1234:" 'host) "host#1234")) 615 (should 616 (string-equal (file-remote-p "/-:user@host#1234:" 'localname) "")) 617 (should (string-equal (file-remote-p "/-:user@host#1234:" 'hop) nil)) 618 619 ;; Expand `tramp-default-user'. 620 (should (string-equal 621 (file-remote-p "/method:host#1234:") 622 (format "/%s:%s@%s:" "method" "default-user" "host#1234"))) 623 (should (string-equal 624 (file-remote-p "/method:host#1234:" 'method) "method")) 625 (should (string-equal 626 (file-remote-p "/method:host#1234:" 'user) "default-user")) 627 (should (string-equal 628 (file-remote-p "/method:host#1234:" 'host) "host#1234")) 629 (should 630 (string-equal (file-remote-p "/method:host#1234:" 'localname) "")) 631 (should (string-equal (file-remote-p "/method:host#1234:" 'hop) nil)) 632 633 ;; No expansion. 634 (should (string-equal 635 (file-remote-p "/method:user@host#1234:") 636 (format "/%s:%s@%s:" "method" "user" "host#1234"))) 637 (should (string-equal 638 (file-remote-p "/method:user@host#1234:" 'method) "method")) 639 (should (string-equal 640 (file-remote-p "/method:user@host#1234:" 'user) "user")) 641 (should (string-equal 642 (file-remote-p "/method:user@host#1234:" 'host) "host#1234")) 643 (should (string-equal 644 (file-remote-p "/method:user@host#1234:" 'localname) "")) 645 (should (string-equal 646 (file-remote-p "/method:user@host#1234:" 'hop) nil)) 647 648 ;; Expand `tramp-default-method' and `tramp-default-user'. 649 (should 650 (string-equal 651 (file-remote-p "/-:1.2.3.4:") 652 (format "/%s:%s@%s:" "default-method" "default-user" "1.2.3.4"))) 653 (should 654 (string-equal 655 (file-remote-p "/-:1.2.3.4:" 'method) "default-method")) 656 (should 657 (string-equal (file-remote-p "/-:1.2.3.4:" 'user) "default-user")) 658 (should (string-equal (file-remote-p "/-:1.2.3.4:" 'host) "1.2.3.4")) 659 (should (string-equal (file-remote-p "/-:1.2.3.4:" 'localname) "")) 660 (should (string-equal (file-remote-p "/-:1.2.3.4:" 'hop) nil)) 661 662 ;; Expand `tramp-default-method'. 663 (should (string-equal 664 (file-remote-p "/-:user@1.2.3.4:") 665 (format "/%s:%s@%s:" "default-method" "user" "1.2.3.4"))) 666 (should (string-equal 667 (file-remote-p "/-:user@1.2.3.4:" 'method) "default-method")) 668 (should 669 (string-equal (file-remote-p "/-:user@1.2.3.4:" 'user) "user")) 670 (should 671 (string-equal (file-remote-p "/-:user@1.2.3.4:" 'host) "1.2.3.4")) 672 (should 673 (string-equal (file-remote-p "/-:user@1.2.3.4:" 'localname) "")) 674 (should 675 (string-equal (file-remote-p "/-:user@1.2.3.4:" 'hop) nil)) 676 677 ;; Expand `tramp-default-user'. 678 (should (string-equal 679 (file-remote-p "/method:1.2.3.4:") 680 (format "/%s:%s@%s:" "method" "default-user" "1.2.3.4"))) 681 (should 682 (string-equal (file-remote-p "/method:1.2.3.4:" 'method) "method")) 683 (should (string-equal 684 (file-remote-p "/method:1.2.3.4:" 'user) "default-user")) 685 (should 686 (string-equal (file-remote-p "/method:1.2.3.4:" 'host) "1.2.3.4")) 687 (should 688 (string-equal (file-remote-p "/method:1.2.3.4:" 'localname) "")) 689 (should (string-equal (file-remote-p "/method:1.2.3.4:" 'hop) nil)) 690 691 ;; No expansion. 692 (should (string-equal 693 (file-remote-p "/method:user@1.2.3.4:") 694 (format "/%s:%s@%s:" "method" "user" "1.2.3.4"))) 695 (should (string-equal 696 (file-remote-p "/method:user@1.2.3.4:" 'method) "method")) 697 (should 698 (string-equal (file-remote-p "/method:user@1.2.3.4:" 'user) "user")) 699 (should (string-equal 700 (file-remote-p "/method:user@1.2.3.4:" 'host) "1.2.3.4")) 701 (should (string-equal 702 (file-remote-p "/method:user@1.2.3.4:" 'localname) "")) 703 (should (string-equal 704 (file-remote-p "/method:user@1.2.3.4:" 'hop) nil)) 705 706 ;; Expand `tramp-default-method', `tramp-default-user' and 707 ;; `tramp-default-host'. 708 (should 709 (string-equal 710 (file-remote-p "/-:[]:") 711 (format 712 "/%s:%s@%s:" "default-method" "default-user" "default-host"))) 713 (should 714 (string-equal (file-remote-p "/-:[]:" 'method) "default-method")) 715 (should (string-equal (file-remote-p "/-:[]:" 'user) "default-user")) 716 (should (string-equal (file-remote-p "/-:[]:" 'host) "default-host")) 717 (should (string-equal (file-remote-p "/-:[]:" 'localname) "")) 718 (should (string-equal (file-remote-p "/-:[]:" 'hop) nil)) 719 720 ;; Expand `tramp-default-method' and `tramp-default-user'. 721 (let ((tramp-default-host "::1")) 722 (should 723 (string-equal 724 (file-remote-p "/-:[]:") 725 (format "/%s:%s@%s:" "default-method" "default-user" "[::1]"))) 726 (should 727 (string-equal (file-remote-p "/-:[]:" 'method) "default-method")) 728 (should 729 (string-equal (file-remote-p "/-:[]:" 'user) "default-user")) 730 (should (string-equal (file-remote-p "/-:[]:" 'host) "::1")) 731 (should (string-equal (file-remote-p "/-:[]:" 'localname) "")) 732 (should (string-equal (file-remote-p "/-:[]:" 'hop) nil))) 733 734 ;; Expand `tramp-default-method' and `tramp-default-user'. 735 (should 736 (string-equal 737 (file-remote-p "/-:[::1]:") 738 (format "/%s:%s@%s:" "default-method" "default-user" "[::1]"))) 739 (should 740 (string-equal (file-remote-p "/-:[::1]:" 'method) "default-method")) 741 (should 742 (string-equal (file-remote-p "/-:[::1]:" 'user) "default-user")) 743 (should (string-equal (file-remote-p "/-:[::1]:" 'host) "::1")) 744 (should (string-equal (file-remote-p "/-:[::1]:" 'localname) "")) 745 (should (string-equal (file-remote-p "/-:[::1]:" 'hop) nil)) 746 747 ;; Expand `tramp-default-method'. 748 (should (string-equal 749 (file-remote-p "/-:user@[::1]:") 750 (format "/%s:%s@%s:" "default-method" "user" "[::1]"))) 751 (should (string-equal 752 (file-remote-p "/-:user@[::1]:" 'method) "default-method")) 753 (should (string-equal (file-remote-p "/-:user@[::1]:" 'user) "user")) 754 (should (string-equal (file-remote-p "/-:user@[::1]:" 'host) "::1")) 755 (should (string-equal (file-remote-p "/-:user@[::1]:" 'localname) "")) 756 (should (string-equal (file-remote-p "/-:user@[::1]:" 'hop) nil)) 757 758 ;; Expand `tramp-default-user'. 759 (should (string-equal 760 (file-remote-p "/method:[::1]:") 761 (format "/%s:%s@%s:" "method" "default-user" "[::1]"))) 762 (should 763 (string-equal (file-remote-p "/method:[::1]:" 'method) "method")) 764 (should (string-equal 765 (file-remote-p "/method:[::1]:" 'user) "default-user")) 766 (should (string-equal (file-remote-p "/method:[::1]:" 'host) "::1")) 767 (should (string-equal (file-remote-p "/method:[::1]:" 'localname) "")) 768 (should (string-equal (file-remote-p "/method:[::1]:" 'hop) nil)) 769 770 ;; No expansion. 771 (should (string-equal 772 (file-remote-p "/method:user@[::1]:") 773 (format "/%s:%s@%s:" "method" "user" "[::1]"))) 774 (should (string-equal 775 (file-remote-p "/method:user@[::1]:" 'method) "method")) 776 (should 777 (string-equal (file-remote-p "/method:user@[::1]:" 'user) "user")) 778 (should 779 (string-equal (file-remote-p "/method:user@[::1]:" 'host) "::1")) 780 (should (string-equal 781 (file-remote-p "/method:user@[::1]:" 'localname) "")) 782 (should (string-equal (file-remote-p "/method:user@[::1]:" 'hop) nil)) 783 784 ;; Local file name part. 785 (should (string-equal (file-remote-p "/-:host:/:" 'localname) "/:")) 786 (should (string-equal (file-remote-p "/method:::" 'localname) ":")) 787 (should (string-equal (file-remote-p "/method:: " 'localname) " ")) 788 (should 789 (string-equal (file-remote-p "/method::file" 'localname) "file")) 790 (should (string-equal 791 (file-remote-p "/method::/path/to/file" 'localname) 792 "/path/to/file")) 793 794 ;; Multihop. 795 (should 796 (string-equal 797 (file-remote-p 798 "/method1:user1@host1|method2:user2@host2:/path/to/file") 799 (format "/%s:%s@%s|%s:%s@%s:" 800 "method1" "user1" "host1" "method2" "user2" "host2"))) 801 (should 802 (string-equal 803 (file-remote-p 804 "/method1:user1@host1|method2:user2@host2:/path/to/file" 'method) 805 "method2")) 806 (should 807 (string-equal 808 (file-remote-p 809 "/method1:user1@host1|method2:user2@host2:/path/to/file" 'user) 810 "user2")) 811 (should 812 (string-equal 813 (file-remote-p 814 "/method1:user1@host1|method2:user2@host2:/path/to/file" 'host) 815 "host2")) 816 (should 817 (string-equal 818 (file-remote-p 819 "/method1:user1@host1|method2:user2@host2:/path/to/file" 820 'localname) 821 "/path/to/file")) 822 (should 823 (string-equal 824 (file-remote-p 825 "/method1:user1@host1|method2:user2@host2:/path/to/file" 'hop) 826 (format "%s:%s@%s|" 827 "method1" "user1" "host1"))) 828 829 (should 830 (string-equal 831 (file-remote-p 832 (concat 833 "/method1:user1@host1" 834 "|method2:user2@host2" 835 "|method3:user3@host3:/path/to/file")) 836 (format "/%s:%s@%s|%s:%s@%s|%s:%s@%s:" 837 "method1" "user1" "host1" 838 "method2" "user2" "host2" 839 "method3" "user3" "host3"))) 840 (should 841 (string-equal 842 (file-remote-p 843 (concat 844 "/method1:user1@host1" 845 "|method2:user2@host2" 846 "|method3:user3@host3:/path/to/file") 847 'method) 848 "method3")) 849 (should 850 (string-equal 851 (file-remote-p 852 (concat 853 "/method1:user1@host1" 854 "|method2:user2@host2" 855 "|method3:user3@host3:/path/to/file") 856 'user) 857 "user3")) 858 (should 859 (string-equal 860 (file-remote-p 861 (concat 862 "/method1:user1@host1" 863 "|method2:user2@host2" 864 "|method3:user3@host3:/path/to/file") 865 'host) 866 "host3")) 867 (should 868 (string-equal 869 (file-remote-p 870 (concat 871 "/method1:user1@host1" 872 "|method2:user2@host2" 873 "|method3:user3@host3:/path/to/file") 874 'localname) 875 "/path/to/file")) 876 (should 877 (string-equal 878 (file-remote-p 879 (concat 880 "/method1:user1@host1" 881 "|method2:user2@host2" 882 "|method3:user3@host3:/path/to/file") 883 'hop) 884 (format "%s:%s@%s|%s:%s@%s|" 885 "method1" "user1" "host1" "method2" "user2" "host2"))) 886 887 ;; Expand `tramp-default-method-alist'. 888 (add-to-list 'tramp-default-method-alist '("host1" "user1" "method1")) 889 (add-to-list 'tramp-default-method-alist '("host2" "user2" "method2")) 890 (add-to-list 'tramp-default-method-alist '("host3" "user3" "method3")) 891 (should 892 (string-equal 893 (file-remote-p 894 (concat 895 "/-:user1@host1" 896 "|-:user2@host2" 897 "|-:user3@host3:/path/to/file")) 898 (format "/%s:%s@%s|%s:%s@%s|%s:%s@%s:" 899 "method1" "user1" "host1" 900 "method2" "user2" "host2" 901 "method3" "user3" "host3"))) 902 903 ;; Expand `tramp-default-user-alist'. 904 (add-to-list 'tramp-default-user-alist '("method1" "host1" "user1")) 905 (add-to-list 'tramp-default-user-alist '("method2" "host2" "user2")) 906 (add-to-list 'tramp-default-user-alist '("method3" "host3" "user3")) 907 (should 908 (string-equal 909 (file-remote-p 910 (concat 911 "/method1:host1" 912 "|method2:host2" 913 "|method3:host3:/path/to/file")) 914 (format "/%s:%s@%s|%s:%s@%s|%s:%s@%s:" 915 "method1" "user1" "host1" 916 "method2" "user2" "host2" 917 "method3" "user3" "host3"))) 918 919 ;; Expand `tramp-default-host-alist'. 920 (add-to-list 'tramp-default-host-alist '("method1" "user1" "host1")) 921 (add-to-list 'tramp-default-host-alist '("method2" "user2" "host2")) 922 (add-to-list 'tramp-default-host-alist '("method3" "user3" "host3")) 923 (should 924 (string-equal 925 (file-remote-p 926 (concat 927 "/method1:user1@" 928 "|method2:user2@" 929 "|method3:user3@:/path/to/file")) 930 (format "/%s:%s@%s|%s:%s@%s|%s:%s@%s:" 931 "method1" "user1" "host1" 932 "method2" "user2" "host2" 933 "method3" "user3" "host3"))) 934 935 ;; Ad-hoc user name and host name expansion. 936 (setq tramp-default-method-alist nil 937 tramp-default-user-alist nil 938 tramp-default-host-alist nil) 939 (should 940 (string-equal 941 (file-remote-p 942 (concat 943 "/method1:user1@host1" 944 "|method2:user2@" 945 "|method3:user3@:/path/to/file")) 946 (format "/%s:%s@%s|%s:%s@%s|%s:%s@%s:" 947 "method1" "user1" "host1" 948 "method2" "user2" "host1" 949 "method3" "user3" "host1"))) 950 (should 951 (string-equal 952 (file-remote-p 953 (concat 954 "/method1:%u@%h" 955 "|method2:user2@host2" 956 "|method3:%u@%h" 957 "|method4:user4%domain4@host4#1234:/path/to/file")) 958 (format "/%s:%s@%s|%s:%s@%s|%s:%s@%s|%s:%s@%s:" 959 "method1" "user2" "host2" 960 "method2" "user2" "host2" 961 "method3" "user4" "host4" 962 "method4" "user4%domain4" "host4#1234")))) 963 964 ;; Exit. 965 (tramp-change-syntax syntax)))) 966 967(ert-deftest tramp-test02-file-name-dissect-simplified () 968 "Check simplified file name components." 969 :tags '(:expensive-test) 970 (let ((tramp-default-method "default-method") 971 (tramp-default-user "default-user") 972 (tramp-default-host "default-host") 973 tramp-default-user-alist 974 tramp-default-host-alist 975 ;; Suppress method name check. 976 (non-essential t) 977 ;; Suppress check for multihops. 978 (tramp-cache-data (make-hash-table :test #'equal)) 979 (tramp-connection-properties '((nil "login-program" t))) 980 (syntax tramp-syntax)) 981 (unwind-protect 982 (progn 983 (tramp-change-syntax 'simplified) 984 ;; An unknown default method shall raise an error. 985 (let (non-essential) 986 (should-error 987 (expand-file-name "/user@host:") 988 :type 'user-error)) 989 990 ;; Expand `tramp-default-method' and `tramp-default-user'. 991 (should (string-equal 992 (file-remote-p "/host:") 993 (format "/%s@%s:" "default-user" "host"))) 994 (should (string-equal 995 (file-remote-p "/host:" 'method) "default-method")) 996 (should (string-equal (file-remote-p "/host:" 'user) "default-user")) 997 (should (string-equal (file-remote-p "/host:" 'host) "host")) 998 (should (string-equal (file-remote-p "/host:" 'localname) "")) 999 (should (string-equal (file-remote-p "/host:" 'hop) nil)) 1000 1001 ;; Expand `tramp-default-method' and `tramp-default-host'. 1002 (should (string-equal 1003 (file-remote-p "/user@:") 1004 (format "/%s@%s:" "user" "default-host"))) 1005 (should (string-equal 1006 (file-remote-p "/user@:" 'method) "default-method")) 1007 (should (string-equal (file-remote-p "/user@:" 'user) "user")) 1008 (should (string-equal (file-remote-p "/user@:" 'host) "default-host")) 1009 (should (string-equal (file-remote-p "/user@:" 'localname) "")) 1010 (should (string-equal (file-remote-p "/user@:" 'hop) nil)) 1011 1012 ;; Expand `tramp-default-method'. 1013 (should (string-equal 1014 (file-remote-p "/user@host:") 1015 (format "/%s@%s:" "user" "host"))) 1016 (should (string-equal 1017 (file-remote-p "/user@host:" 'method) "default-method")) 1018 (should (string-equal (file-remote-p "/user@host:" 'user) "user")) 1019 (should (string-equal (file-remote-p "/user@host:" 'host) "host")) 1020 (should (string-equal (file-remote-p "/user@host:" 'localname) "")) 1021 (should (string-equal (file-remote-p "/user@host:" 'hop) nil)) 1022 1023 ;; No expansion. 1024 (should (string-equal 1025 (file-remote-p "/user@email@host:") 1026 (format "/%s@%s:" "user@email" "host"))) 1027 (should (string-equal 1028 (file-remote-p 1029 "/user@email@host:" 'method) "default-method")) 1030 (should (string-equal 1031 (file-remote-p "/user@email@host:" 'user) "user@email")) 1032 (should (string-equal 1033 (file-remote-p "/user@email@host:" 'host) "host")) 1034 (should (string-equal 1035 (file-remote-p "/user@email@host:" 'localname) "")) 1036 (should (string-equal 1037 (file-remote-p "/user@email@host:" 'hop) nil)) 1038 1039 ;; Expand `tramp-default-method' and `tramp-default-user'. 1040 (should (string-equal 1041 (file-remote-p "/host#1234:") 1042 (format "/%s@%s:" "default-user" "host#1234"))) 1043 (should (string-equal 1044 (file-remote-p "/host#1234:" 'method) "default-method")) 1045 (should (string-equal 1046 (file-remote-p "/host#1234:" 'user) "default-user")) 1047 (should (string-equal 1048 (file-remote-p "/host#1234:" 'host) "host#1234")) 1049 (should (string-equal (file-remote-p "/host#1234:" 'localname) "")) 1050 (should (string-equal (file-remote-p "/host#1234:" 'hop) nil)) 1051 1052 ;; Expand `tramp-default-method'. 1053 (should (string-equal 1054 (file-remote-p "/user@host#1234:") 1055 (format "/%s@%s:" "user" "host#1234"))) 1056 (should (string-equal 1057 (file-remote-p "/user@host#1234:" 'method) "default-method")) 1058 (should (string-equal 1059 (file-remote-p "/user@host#1234:" 'user) "user")) 1060 (should (string-equal 1061 (file-remote-p "/user@host#1234:" 'host) "host#1234")) 1062 (should (string-equal 1063 (file-remote-p "/user@host#1234:" 'localname) "")) 1064 (should (string-equal (file-remote-p "/user@host#1234:" 'hop) nil)) 1065 1066 ;; Expand `tramp-default-method' and `tramp-default-user'. 1067 (should (string-equal 1068 (file-remote-p "/1.2.3.4:") 1069 (format "/%s@%s:" "default-user" "1.2.3.4"))) 1070 (should (string-equal 1071 (file-remote-p "/1.2.3.4:" 'method) "default-method")) 1072 (should (string-equal 1073 (file-remote-p "/1.2.3.4:" 'user) "default-user")) 1074 (should (string-equal (file-remote-p "/1.2.3.4:" 'host) "1.2.3.4")) 1075 (should (string-equal (file-remote-p "/1.2.3.4:" 'localname) "")) 1076 (should (string-equal (file-remote-p "/1.2.3.4:" 'hop) nil)) 1077 1078 ;; Expand `tramp-default-method'. 1079 (should (string-equal 1080 (file-remote-p "/user@1.2.3.4:") 1081 (format "/%s@%s:" "user" "1.2.3.4"))) 1082 (should (string-equal 1083 (file-remote-p "/user@1.2.3.4:" 'method) "default-method")) 1084 (should (string-equal (file-remote-p "/user@1.2.3.4:" 'user) "user")) 1085 (should (string-equal 1086 (file-remote-p "/user@1.2.3.4:" 'host) "1.2.3.4")) 1087 (should (string-equal (file-remote-p "/user@1.2.3.4:" 'localname) "")) 1088 (should (string-equal (file-remote-p "/user@1.2.3.4:" 'hop) nil)) 1089 1090 ;; Expand `tramp-default-method', `tramp-default-user' and 1091 ;; `tramp-default-host'. 1092 (should (string-equal 1093 (file-remote-p "/[]:") 1094 (format 1095 "/%s@%s:" "default-user" "default-host"))) 1096 (should (string-equal 1097 (file-remote-p "/[]:" 'method) "default-method")) 1098 (should (string-equal (file-remote-p "/[]:" 'user) "default-user")) 1099 (should (string-equal (file-remote-p "/[]:" 'host) "default-host")) 1100 (should (string-equal (file-remote-p "/[]:" 'localname) "")) 1101 (should (string-equal (file-remote-p "/[]:" 'hop) nil)) 1102 1103 ;; Expand `tramp-default-method' and `tramp-default-user'. 1104 (let ((tramp-default-host "::1")) 1105 (should (string-equal 1106 (file-remote-p "/[]:") 1107 (format "/%s@%s:" "default-user" "[::1]"))) 1108 (should (string-equal 1109 (file-remote-p "/[]:" 'method) "default-method")) 1110 (should (string-equal (file-remote-p "/[]:" 'user) "default-user")) 1111 (should (string-equal (file-remote-p "/[]:" 'host) "::1")) 1112 (should (string-equal (file-remote-p "/[]:" 'localname) "")) 1113 (should (string-equal (file-remote-p "/[]:" 'hop) nil))) 1114 1115 ;; Expand `tramp-default-method' and `tramp-default-user'. 1116 (should (string-equal 1117 (file-remote-p "/[::1]:") 1118 (format "/%s@%s:" "default-user" "[::1]"))) 1119 (should (string-equal 1120 (file-remote-p "/[::1]:" 'method) "default-method")) 1121 (should (string-equal (file-remote-p "/[::1]:" 'user) "default-user")) 1122 (should (string-equal (file-remote-p "/[::1]:" 'host) "::1")) 1123 (should (string-equal (file-remote-p "/[::1]:" 'localname) "")) 1124 (should (string-equal (file-remote-p "/[::1]:" 'hop) nil)) 1125 1126 ;; Expand `tramp-default-method'. 1127 (should (string-equal 1128 (file-remote-p "/user@[::1]:") 1129 (format "/%s@%s:" "user" "[::1]"))) 1130 (should (string-equal 1131 (file-remote-p "/user@[::1]:" 'method) "default-method")) 1132 (should (string-equal (file-remote-p "/user@[::1]:" 'user) "user")) 1133 (should (string-equal (file-remote-p "/user@[::1]:" 'host) "::1")) 1134 (should (string-equal (file-remote-p "/user@[::1]:" 'localname) "")) 1135 (should (string-equal (file-remote-p "/user@[::1]:" 'hop) nil)) 1136 1137 ;; Local file name part. 1138 (should (string-equal (file-remote-p "/host:/:" 'localname) "/:")) 1139 (should (string-equal (file-remote-p "/host::" 'localname) ":")) 1140 (should (string-equal (file-remote-p "/host: " 'localname) " ")) 1141 (should (string-equal (file-remote-p "/host:file" 'localname) "file")) 1142 (should (string-equal 1143 (file-remote-p "/host:/path/to/file" 'localname) 1144 "/path/to/file")) 1145 1146 ;; Multihop. 1147 (should 1148 (string-equal 1149 (file-remote-p "/user1@host1|user2@host2:/path/to/file") 1150 (format "/%s@%s|%s@%s:" "user1" "host1" "user2" "host2"))) 1151 (should 1152 (string-equal 1153 (file-remote-p 1154 "/user1@host1|user2@host2:/path/to/file" 'method) 1155 "default-method")) 1156 (should 1157 (string-equal 1158 (file-remote-p 1159 "/user1@host1|user2@host2:/path/to/file" 'user) 1160 "user2")) 1161 (should 1162 (string-equal 1163 (file-remote-p 1164 "/user1@host1|user2@host2:/path/to/file" 'host) 1165 "host2")) 1166 (should 1167 (string-equal 1168 (file-remote-p 1169 "/user1@host1|user2@host2:/path/to/file" 'localname) 1170 "/path/to/file")) 1171 (should 1172 (string-equal 1173 (file-remote-p 1174 "/user1@host1|user2@host2:/path/to/file" 'hop) 1175 (format "%s@%s|" "user1" "host1"))) 1176 1177 (should 1178 (string-equal 1179 (file-remote-p 1180 (concat 1181 "/user1@host1" 1182 "|user2@host2" 1183 "|user3@host3:/path/to/file")) 1184 (format "/%s@%s|%s@%s|%s@%s:" 1185 "user1" "host1" 1186 "user2" "host2" 1187 "user3" "host3"))) 1188 (should 1189 (string-equal 1190 (file-remote-p 1191 (concat 1192 "/user1@host1" 1193 "|user2@host2" 1194 "|user3@host3:/path/to/file") 1195 'method) 1196 "default-method")) 1197 (should 1198 (string-equal 1199 (file-remote-p 1200 (concat 1201 "/user1@host1" 1202 "|user2@host2" 1203 "|user3@host3:/path/to/file") 1204 'user) 1205 "user3")) 1206 (should 1207 (string-equal 1208 (file-remote-p 1209 (concat 1210 "/user1@host1" 1211 "|user2@host2" 1212 "|user3@host3:/path/to/file") 1213 'host) 1214 "host3")) 1215 (should 1216 (string-equal 1217 (file-remote-p 1218 (concat 1219 "/user1@host1" 1220 "|user2@host2" 1221 "|user3@host3:/path/to/file") 1222 'localname) 1223 "/path/to/file")) 1224 (should 1225 (string-equal 1226 (file-remote-p 1227 (concat 1228 "/user1@host1" 1229 "|user2@host2" 1230 "|user3@host3:/path/to/file") 1231 'hop) 1232 (format "%s@%s|%s@%s|" 1233 "user1" "host1" "user2" "host2"))) 1234 1235 ;; Expand `tramp-default-user-alist'. 1236 (add-to-list 'tramp-default-user-alist '(nil "host1" "user1")) 1237 (add-to-list 'tramp-default-user-alist '(nil "host2" "user2")) 1238 (add-to-list 'tramp-default-user-alist '(nil "host3" "user3")) 1239 (should 1240 (string-equal 1241 (file-remote-p 1242 (concat 1243 "/host1" 1244 "|host2" 1245 "|host3:/path/to/file")) 1246 (format "/%s@%s|%s@%s|%s@%s:" 1247 "user1" "host1" 1248 "user2" "host2" 1249 "user3" "host3"))) 1250 1251 ;; Expand `tramp-default-host-alist'. 1252 (add-to-list 'tramp-default-host-alist '(nil "user1" "host1")) 1253 (add-to-list 'tramp-default-host-alist '(nil "user2" "host2")) 1254 (add-to-list 'tramp-default-host-alist '(nil "user3" "host3")) 1255 (should 1256 (string-equal 1257 (file-remote-p 1258 (concat 1259 "/user1@" 1260 "|user2@" 1261 "|user3@:/path/to/file")) 1262 (format "/%s@%s|%s@%s|%s@%s:" 1263 "user1" "host1" 1264 "user2" "host2" 1265 "user3" "host3"))) 1266 1267 ;; Ad-hoc user name and host name expansion. 1268 (setq tramp-default-user-alist nil 1269 tramp-default-host-alist nil) 1270 (should 1271 (string-equal 1272 (file-remote-p 1273 (concat 1274 "/user1@host1" 1275 "|user2@" 1276 "|user3@:/path/to/file")) 1277 (format "/%s@%s|%s@%s|%s@%s:" 1278 "user1" "host1" 1279 "user2" "host1" 1280 "user3" "host1"))) 1281 (should 1282 (string-equal 1283 (file-remote-p 1284 (concat 1285 "/%u@%h" 1286 "|user2@host2" 1287 "|%u@%h" 1288 "|user4%domain4@host4#1234:/path/to/file")) 1289 (format "/%s@%s|%s@%s|%s@%s|%s@%s:" 1290 "user2" "host2" 1291 "user2" "host2" 1292 "user4" "host4" 1293 "user4%domain4" "host4#1234")))) 1294 1295 ;; Exit. 1296 (tramp-change-syntax syntax)))) 1297 1298(ert-deftest tramp-test02-file-name-dissect-separate () 1299 "Check separate file name components." 1300 :tags '(:expensive-test) 1301 (let ((tramp-default-method "default-method") 1302 (tramp-default-user "default-user") 1303 (tramp-default-host "default-host") 1304 tramp-default-method-alist 1305 tramp-default-user-alist 1306 tramp-default-host-alist 1307 ;; Suppress method name check. 1308 (non-essential t) 1309 ;; Suppress check for multihops. 1310 (tramp-cache-data (make-hash-table :test #'equal)) 1311 (tramp-connection-properties '((nil "login-program" t))) 1312 (syntax tramp-syntax)) 1313 (unwind-protect 1314 (progn 1315 (tramp-change-syntax 'separate) 1316 ;; An unknown method shall raise an error. 1317 (let (non-essential) 1318 (should-error 1319 (expand-file-name "/[method/user@host]") 1320 :type 'user-error)) 1321 1322 ;; Expand `tramp-default-user' and `tramp-default-host'. 1323 (should (string-equal 1324 (file-remote-p "/[method/]") 1325 (format 1326 "/[%s/%s@%s]" "method" "default-user" "default-host"))) 1327 (should (string-equal (file-remote-p "/[method/]" 'method) "method")) 1328 (should (string-equal 1329 (file-remote-p "/[method/]" 'user) "default-user")) 1330 (should (string-equal 1331 (file-remote-p "/[method/]" 'host) "default-host")) 1332 (should (string-equal (file-remote-p "/[method/]" 'localname) "")) 1333 (should (string-equal (file-remote-p "/[method/]" 'hop) nil)) 1334 1335 ;; Expand `tramp-default-method' and `tramp-default-user'. 1336 (should (string-equal 1337 (file-remote-p "/[/host]") 1338 (format 1339 "/[%s/%s@%s]" "default-method" "default-user" "host"))) 1340 (should (string-equal 1341 (file-remote-p "/[/host]" 'method) "default-method")) 1342 (should (string-equal 1343 (file-remote-p "/[/host]" 'user) "default-user")) 1344 (should (string-equal (file-remote-p "/[/host]" 'host) "host")) 1345 (should (string-equal (file-remote-p "/[/host]" 'localname) "")) 1346 (should (string-equal (file-remote-p "/[/host]" 'hop) nil)) 1347 1348 ;; Expand `tramp-default-method' and `tramp-default-host'. 1349 (should (string-equal 1350 (file-remote-p "/[/user@]") 1351 (format 1352 "/[%s/%s@%s]" "default-method" "user" "default-host"))) 1353 (should (string-equal 1354 (file-remote-p "/[/user@]" 'method) "default-method")) 1355 (should (string-equal (file-remote-p "/[/user@]" 'user) "user")) 1356 (should (string-equal 1357 (file-remote-p "/[/user@]" 'host) "default-host")) 1358 (should (string-equal (file-remote-p "/[/user@]" 'localname) "")) 1359 (should (string-equal (file-remote-p "/[/user@]" 'hop) nil)) 1360 1361 ;; Expand `tramp-default-method'. 1362 (should (string-equal 1363 (file-remote-p "/[/user@host]") 1364 (format "/[%s/%s@%s]" "default-method" "user" "host"))) 1365 (should (string-equal 1366 (file-remote-p "/[/user@host]" 'method) "default-method")) 1367 (should (string-equal (file-remote-p "/[/user@host]" 'user) "user")) 1368 (should (string-equal (file-remote-p "/[/user@host]" 'host) "host")) 1369 (should (string-equal (file-remote-p "/[/user@host]" 'localname) "")) 1370 (should (string-equal (file-remote-p "/[/user@host]" 'hop) nil)) 1371 1372 ;; Expand `tramp-default-method' and `tramp-default-user'. 1373 (should (string-equal 1374 (file-remote-p "/[-/host]") 1375 (format 1376 "/[%s/%s@%s]" "default-method" "default-user" "host"))) 1377 (should (string-equal 1378 (file-remote-p "/[-/host]" 'method) "default-method")) 1379 (should (string-equal 1380 (file-remote-p "/[-/host]" 'user) "default-user")) 1381 (should (string-equal (file-remote-p "/[-/host]" 'host) "host")) 1382 (should (string-equal (file-remote-p "/[-/host]" 'localname) "")) 1383 (should (string-equal (file-remote-p "/[-/host]" 'hop) nil)) 1384 1385 ;; Expand `tramp-default-method' and `tramp-default-host'. 1386 (should (string-equal 1387 (file-remote-p "/[-/user@]") 1388 (format 1389 "/[%s/%s@%s]" "default-method" "user" "default-host"))) 1390 (should (string-equal 1391 (file-remote-p "/[-/user@]" 'method) "default-method")) 1392 (should (string-equal (file-remote-p "/[-/user@]" 'user) "user")) 1393 (should (string-equal 1394 (file-remote-p "/[-/user@]" 'host) "default-host")) 1395 (should (string-equal (file-remote-p "/[-/user@]" 'localname) "")) 1396 (should (string-equal (file-remote-p "/[-/user@]" 'hop) nil)) 1397 1398 ;; Expand `tramp-default-method'. 1399 (should (string-equal 1400 (file-remote-p "/[-/user@host]") 1401 (format "/[%s/%s@%s]" "default-method" "user" "host"))) 1402 (should (string-equal 1403 (file-remote-p "/[-/user@host]" 'method) "default-method")) 1404 (should (string-equal (file-remote-p "/[-/user@host]" 'user) "user")) 1405 (should (string-equal (file-remote-p "/[-/user@host]" 'host) "host")) 1406 (should (string-equal (file-remote-p "/[-/user@host]" 'localname) "")) 1407 (should (string-equal (file-remote-p "/[-/user@host]" 'hop) nil)) 1408 1409 ;; Expand `tramp-default-user'. 1410 (should (string-equal 1411 (file-remote-p "/[method/host]") 1412 (format "/[%s/%s@%s]" "method" "default-user" "host"))) 1413 (should (string-equal 1414 (file-remote-p "/[method/host]" 'method) "method")) 1415 (should (string-equal 1416 (file-remote-p "/[method/host]" 'user) "default-user")) 1417 (should (string-equal (file-remote-p "/[method/host]" 'host) "host")) 1418 (should (string-equal (file-remote-p "/[method/host]" 'localname) "")) 1419 (should (string-equal (file-remote-p "/[method/host]" 'hop) nil)) 1420 1421 ;; Expand `tramp-default-host'. 1422 (should (string-equal 1423 (file-remote-p "/[method/user@]") 1424 (format "/[%s/%s@%s]" "method" "user" "default-host"))) 1425 (should (string-equal 1426 (file-remote-p "/[method/user@]" 'method) "method")) 1427 (should (string-equal (file-remote-p "/[method/user@]" 'user) "user")) 1428 (should (string-equal 1429 (file-remote-p "/[method/user@]" 'host) "default-host")) 1430 (should (string-equal 1431 (file-remote-p "/[method/user@]" 'localname) "")) 1432 (should (string-equal (file-remote-p "/[method/user@]" 'hop) nil)) 1433 1434 ;; No expansion. 1435 (should (string-equal 1436 (file-remote-p "/[method/user@host]") 1437 (format "/[%s/%s@%s]" "method" "user" "host"))) 1438 (should (string-equal 1439 (file-remote-p "/[method/user@host]" 'method) "method")) 1440 (should (string-equal 1441 (file-remote-p "/[method/user@host]" 'user) "user")) 1442 (should (string-equal 1443 (file-remote-p "/[method/user@host]" 'host) "host")) 1444 (should (string-equal 1445 (file-remote-p "/[method/user@host]" 'localname) "")) 1446 (should (string-equal 1447 (file-remote-p "/[method/user@host]" 'hop) nil)) 1448 1449 ;; No expansion. 1450 (should (string-equal 1451 (file-remote-p "/[method/user@email@host]") 1452 (format "/[%s/%s@%s]" "method" "user@email" "host"))) 1453 (should (string-equal 1454 (file-remote-p 1455 "/[method/user@email@host]" 'method) "method")) 1456 (should (string-equal 1457 (file-remote-p 1458 "/[method/user@email@host]" 'user) "user@email")) 1459 (should (string-equal 1460 (file-remote-p "/[method/user@email@host]" 'host) "host")) 1461 (should (string-equal 1462 (file-remote-p "/[method/user@email@host]" 'localname) "")) 1463 (should (string-equal 1464 (file-remote-p "/[method/user@email@host]" 'hop) nil)) 1465 1466 ;; Expand `tramp-default-method' and `tramp-default-user'. 1467 (should (string-equal 1468 (file-remote-p "/[/host#1234]") 1469 (format 1470 "/[%s/%s@%s]" "default-method" "default-user" "host#1234"))) 1471 (should (string-equal 1472 (file-remote-p "/[/host#1234]" 'method) "default-method")) 1473 (should (string-equal 1474 (file-remote-p "/[/host#1234]" 'user) "default-user")) 1475 (should (string-equal 1476 (file-remote-p "/[/host#1234]" 'host) "host#1234")) 1477 (should (string-equal (file-remote-p "/[/host#1234]" 'localname) "")) 1478 (should (string-equal (file-remote-p "/[/host#1234]" 'hop) nil)) 1479 1480 ;; Expand `tramp-default-method'. 1481 (should (string-equal 1482 (file-remote-p "/[/user@host#1234]") 1483 (format "/[%s/%s@%s]" "default-method" "user" "host#1234"))) 1484 (should (string-equal 1485 (file-remote-p 1486 "/[/user@host#1234]" 'method) "default-method")) 1487 (should (string-equal 1488 (file-remote-p 1489 "/[/user@host#1234]" 'user) "user")) 1490 (should (string-equal 1491 (file-remote-p "/[/user@host#1234]" 'host) "host#1234")) 1492 (should (string-equal 1493 (file-remote-p "/[/user@host#1234]" 'localname) "")) 1494 (should (string-equal (file-remote-p "/[/user@host#1234]" 'hop) nil)) 1495 1496 ;; Expand `tramp-default-method' and `tramp-default-user'. 1497 (should (string-equal 1498 (file-remote-p "/[-/host#1234]") 1499 (format 1500 "/[%s/%s@%s]" "default-method" "default-user" "host#1234"))) 1501 (should (string-equal 1502 (file-remote-p "/[-/host#1234]" 'method) "default-method")) 1503 (should (string-equal 1504 (file-remote-p "/[-/host#1234]" 'user) "default-user")) 1505 (should (string-equal 1506 (file-remote-p "/[-/host#1234]" 'host) "host#1234")) 1507 (should (string-equal (file-remote-p "/[-/host#1234]" 'localname) "")) 1508 (should (string-equal (file-remote-p "/[-/host#1234]" 'hop) nil)) 1509 1510 ;; Expand `tramp-default-method'. 1511 (should (string-equal 1512 (file-remote-p "/[-/user@host#1234]") 1513 (format "/[%s/%s@%s]" "default-method" "user" "host#1234"))) 1514 (should (string-equal 1515 (file-remote-p 1516 "/[-/user@host#1234]" 'method) "default-method")) 1517 (should (string-equal 1518 (file-remote-p 1519 "/[-/user@host#1234]" 'user) "user")) 1520 (should (string-equal 1521 (file-remote-p "/[-/user@host#1234]" 'host) "host#1234")) 1522 (should (string-equal 1523 (file-remote-p "/[-/user@host#1234]" 'localname) "")) 1524 (should (string-equal (file-remote-p "/[-/user@host#1234]" 'hop) nil)) 1525 1526 ;; Expand `tramp-default-user'. 1527 (should (string-equal 1528 (file-remote-p "/[method/host#1234]") 1529 (format "/[%s/%s@%s]" "method" "default-user" "host#1234"))) 1530 (should (string-equal 1531 (file-remote-p "/[method/host#1234]" 'method) "method")) 1532 (should (string-equal 1533 (file-remote-p "/[method/host#1234]" 'user) "default-user")) 1534 (should (string-equal 1535 (file-remote-p "/[method/host#1234]" 'host) "host#1234")) 1536 (should (string-equal 1537 (file-remote-p "/[method/host#1234]" 'localname) "")) 1538 (should (string-equal (file-remote-p "/[method/host#1234]" 'hop) nil)) 1539 1540 ;; No expansion. 1541 (should (string-equal 1542 (file-remote-p "/[method/user@host#1234]") 1543 (format "/[%s/%s@%s]" "method" "user" "host#1234"))) 1544 (should (string-equal 1545 (file-remote-p "/[method/user@host#1234]" 'method) "method")) 1546 (should (string-equal 1547 (file-remote-p "/[method/user@host#1234]" 'user) "user")) 1548 (should (string-equal 1549 (file-remote-p 1550 "/[method/user@host#1234]" 'host) "host#1234")) 1551 (should (string-equal 1552 (file-remote-p "/[method/user@host#1234]" 'localname) "")) 1553 (should (string-equal 1554 (file-remote-p "/[method/user@host#1234]" 'hop) nil)) 1555 1556 ;; Expand `tramp-default-method' and `tramp-default-user'. 1557 (should (string-equal 1558 (file-remote-p "/[/1.2.3.4]") 1559 (format 1560 "/[%s/%s@%s]" "default-method" "default-user" "1.2.3.4"))) 1561 (should (string-equal 1562 (file-remote-p "/[/1.2.3.4]" 'method) "default-method")) 1563 (should (string-equal 1564 (file-remote-p "/[/1.2.3.4]" 'user) "default-user")) 1565 (should (string-equal 1566 (file-remote-p "/[/1.2.3.4]" 'host) "1.2.3.4")) 1567 (should (string-equal (file-remote-p "/[/1.2.3.4]" 'localname) "")) 1568 (should (string-equal (file-remote-p "/[/1.2.3.4]" 'hop) nil)) 1569 1570 ;; Expand `tramp-default-method'. 1571 (should (string-equal 1572 (file-remote-p "/[/user@1.2.3.4]") 1573 (format "/[%s/%s@%s]" "default-method" "user" "1.2.3.4"))) 1574 (should (string-equal 1575 (file-remote-p 1576 "/[/user@1.2.3.4]" 'method) "default-method")) 1577 (should (string-equal 1578 (file-remote-p "/[/user@1.2.3.4]" 'user) "user")) 1579 (should (string-equal 1580 (file-remote-p "/[/user@1.2.3.4]" 'host) "1.2.3.4")) 1581 (should (string-equal 1582 (file-remote-p "/[/user@1.2.3.4]" 'localname) "")) 1583 (should (string-equal (file-remote-p "/[/user@1.2.3.4]" 'hop) nil)) 1584 1585 ;; Expand `tramp-default-method' and `tramp-default-user'. 1586 (should (string-equal 1587 (file-remote-p "/[-/1.2.3.4]") 1588 (format 1589 "/[%s/%s@%s]" "default-method" "default-user" "1.2.3.4"))) 1590 (should (string-equal 1591 (file-remote-p "/[-/1.2.3.4]" 'method) "default-method")) 1592 (should (string-equal 1593 (file-remote-p "/[-/1.2.3.4]" 'user) "default-user")) 1594 (should (string-equal 1595 (file-remote-p "/[-/1.2.3.4]" 'host) "1.2.3.4")) 1596 (should (string-equal (file-remote-p "/[-/1.2.3.4]" 'localname) "")) 1597 (should (string-equal (file-remote-p "/[-/1.2.3.4]" 'hop) nil)) 1598 1599 ;; Expand `tramp-default-method'. 1600 (should (string-equal 1601 (file-remote-p "/[-/user@1.2.3.4]") 1602 (format "/[%s/%s@%s]" "default-method" "user" "1.2.3.4"))) 1603 (should (string-equal 1604 (file-remote-p 1605 "/[-/user@1.2.3.4]" 'method) "default-method")) 1606 (should (string-equal 1607 (file-remote-p "/[-/user@1.2.3.4]" 'user) "user")) 1608 (should (string-equal 1609 (file-remote-p "/[-/user@1.2.3.4]" 'host) "1.2.3.4")) 1610 (should (string-equal 1611 (file-remote-p "/[-/user@1.2.3.4]" 'localname) "")) 1612 (should (string-equal (file-remote-p "/[-/user@1.2.3.4]" 'hop) nil)) 1613 1614 ;; Expand `tramp-default-user'. 1615 (should (string-equal 1616 (file-remote-p "/[method/1.2.3.4]") 1617 (format "/[%s/%s@%s]" "method" "default-user" "1.2.3.4"))) 1618 (should (string-equal 1619 (file-remote-p "/[method/1.2.3.4]" 'method) "method")) 1620 (should (string-equal 1621 (file-remote-p "/[method/1.2.3.4]" 'user) "default-user")) 1622 (should (string-equal 1623 (file-remote-p "/[method/1.2.3.4]" 'host) "1.2.3.4")) 1624 (should (string-equal 1625 (file-remote-p "/[method/1.2.3.4]" 'localname) "")) 1626 (should (string-equal (file-remote-p "/[method/1.2.3.4]" 'hop) nil)) 1627 1628 ;; No expansion. 1629 (should (string-equal 1630 (file-remote-p "/[method/user@1.2.3.4]") 1631 (format "/[%s/%s@%s]" "method" "user" "1.2.3.4"))) 1632 (should (string-equal 1633 (file-remote-p "/[method/user@1.2.3.4]" 'method) "method")) 1634 (should (string-equal 1635 (file-remote-p "/[method/user@1.2.3.4]" 'user) "user")) 1636 (should (string-equal 1637 (file-remote-p "/[method/user@1.2.3.4]" 'host) "1.2.3.4")) 1638 (should (string-equal 1639 (file-remote-p "/[method/user@1.2.3.4]" 'localname) "")) 1640 (should (string-equal 1641 (file-remote-p "/[method/user@1.2.3.4]" 'hop) nil)) 1642 1643 ;; Expand `tramp-default-method', `tramp-default-user' and 1644 ;; `tramp-default-host'. 1645 (should (string-equal 1646 (file-remote-p "/[/]") 1647 (format 1648 "/[%s/%s@%s]" 1649 "default-method" "default-user" "default-host"))) 1650 (should (string-equal 1651 (file-remote-p "/[/]" 'method) "default-method")) 1652 (should (string-equal (file-remote-p "/[/]" 'user) "default-user")) 1653 (should (string-equal (file-remote-p "/[/]" 'host) "default-host")) 1654 (should (string-equal (file-remote-p "/[/]" 'localname) "")) 1655 (should (string-equal (file-remote-p "/[/]" 'hop) nil)) 1656 1657 ;; Expand `tramp-default-method' and `tramp-default-user'. 1658 (let ((tramp-default-host "::1")) 1659 (should (string-equal 1660 (file-remote-p "/[/]") 1661 (format 1662 "/[%s/%s@%s]" 1663 "default-method" "default-user" "::1"))) 1664 (should (string-equal 1665 (file-remote-p "/[/]" 'method) "default-method")) 1666 (should (string-equal (file-remote-p "/[/]" 'user) "default-user")) 1667 (should (string-equal (file-remote-p "/[/]" 'host) "::1")) 1668 (should (string-equal (file-remote-p "/[/]" 'localname) "")) 1669 (should (string-equal (file-remote-p "/[/]" 'hop) nil))) 1670 1671 ;; Expand `tramp-default-method' and `tramp-default-user'. 1672 (should (string-equal 1673 (file-remote-p "/[/::1]") 1674 (format 1675 "/[%s/%s@%s]" "default-method" "default-user" "::1"))) 1676 (should (string-equal 1677 (file-remote-p "/[/::1]" 'method) "default-method")) 1678 (should (string-equal 1679 (file-remote-p "/[/::1]" 'user) "default-user")) 1680 (should (string-equal (file-remote-p "/[/::1]" 'host) "::1")) 1681 (should (string-equal (file-remote-p "/[/::1]" 'localname) "")) 1682 (should (string-equal (file-remote-p "/[/::1]" 'hop) nil)) 1683 1684 ;; Expand `tramp-default-method'. 1685 (should (string-equal 1686 (file-remote-p "/[/user@::1]") 1687 (format "/[%s/%s@%s]" "default-method" "user" "::1"))) 1688 (should (string-equal 1689 (file-remote-p "/[/user@::1]" 'method) "default-method")) 1690 (should (string-equal (file-remote-p "/[/user@::1]" 'user) "user")) 1691 (should (string-equal (file-remote-p "/[/user@::1]" 'host) "::1")) 1692 (should (string-equal (file-remote-p "/[/user@::1]" 'localname) "")) 1693 (should (string-equal (file-remote-p "/[/user@::1]" 'hop) nil)) 1694 1695 ;; Expand `tramp-default-method', `tramp-default-user' and 1696 ;; `tramp-default-host'. 1697 (should (string-equal 1698 (file-remote-p "/[-/]") 1699 (format 1700 "/[%s/%s@%s]" 1701 "default-method" "default-user" "default-host"))) 1702 (should (string-equal 1703 (file-remote-p "/[-/]" 'method) "default-method")) 1704 (should (string-equal (file-remote-p "/[-/]" 'user) "default-user")) 1705 (should (string-equal (file-remote-p "/[-/]" 'host) "default-host")) 1706 (should (string-equal (file-remote-p "/[-/]" 'localname) "")) 1707 (should (string-equal (file-remote-p "/[-/]" 'hop) nil)) 1708 1709 ;; Expand `tramp-default-method' and `tramp-default-user'. 1710 (let ((tramp-default-host "::1")) 1711 (should (string-equal 1712 (file-remote-p "/[-/]") 1713 (format 1714 "/[%s/%s@%s]" 1715 "default-method" "default-user" "::1"))) 1716 (should (string-equal 1717 (file-remote-p "/[-/]" 'method) "default-method")) 1718 (should (string-equal (file-remote-p "/[-/]" 'user) "default-user")) 1719 (should (string-equal (file-remote-p "/[-/]" 'host) "::1")) 1720 (should (string-equal (file-remote-p "/[-/]" 'localname) "")) 1721 (should (string-equal (file-remote-p "/[-/]" 'hop) nil))) 1722 1723 ;; Expand `tramp-default-method' and `tramp-default-user'. 1724 (should (string-equal 1725 (file-remote-p "/[-/::1]") 1726 (format 1727 "/[%s/%s@%s]" "default-method" "default-user" "::1"))) 1728 (should (string-equal 1729 (file-remote-p "/[-/::1]" 'method) "default-method")) 1730 (should (string-equal 1731 (file-remote-p "/[-/::1]" 'user) "default-user")) 1732 (should (string-equal (file-remote-p "/[-/::1]" 'host) "::1")) 1733 (should (string-equal (file-remote-p "/[-/::1]" 'localname) "")) 1734 (should (string-equal (file-remote-p "/[-/::1]" 'hop) nil)) 1735 1736 ;; Expand `tramp-default-method'. 1737 (should (string-equal 1738 (file-remote-p "/[-/user@::1]") 1739 (format "/[%s/%s@%s]" "default-method" "user" "::1"))) 1740 (should (string-equal 1741 (file-remote-p "/[-/user@::1]" 'method) "default-method")) 1742 (should (string-equal (file-remote-p "/[-/user@::1]" 'user) "user")) 1743 (should (string-equal (file-remote-p "/[-/user@::1]" 'host) "::1")) 1744 (should (string-equal (file-remote-p "/[-/user@::1]" 'localname) "")) 1745 (should (string-equal (file-remote-p "/[-/user@::1]" 'hop) nil)) 1746 1747 ;; Expand `tramp-default-user'. 1748 (should (string-equal 1749 (file-remote-p "/[method/::1]") 1750 (format "/[%s/%s@%s]" "method" "default-user" "::1"))) 1751 (should (string-equal 1752 (file-remote-p "/[method/::1]" 'method) "method")) 1753 (should (string-equal 1754 (file-remote-p "/[method/::1]" 'user) "default-user")) 1755 (should (string-equal (file-remote-p "/[method/::1]" 'host) "::1")) 1756 (should (string-equal (file-remote-p "/[method/::1]" 'localname) "")) 1757 (should (string-equal (file-remote-p "/[method/::1]" 'hop) nil)) 1758 1759 ;; No expansion. 1760 (should (string-equal 1761 (file-remote-p "/[method/user@::1]") 1762 (format "/[%s/%s@%s]" "method" "user" "::1"))) 1763 (should (string-equal 1764 (file-remote-p "/[method/user@::1]" 'method) "method")) 1765 (should (string-equal 1766 (file-remote-p "/[method/user@::1]" 'user) "user")) 1767 (should (string-equal 1768 (file-remote-p "/[method/user@::1]" 'host) "::1")) 1769 (should (string-equal 1770 (file-remote-p "/[method/user@::1]" 'localname) "")) 1771 (should (string-equal (file-remote-p "/[method/user@::1]" 'hop) nil)) 1772 1773 ;; Local file name part. 1774 (should (string-equal (file-remote-p "/[/host]/:" 'localname) "/:")) 1775 (should (string-equal (file-remote-p "/[-/host]/:" 'localname) "/:")) 1776 (should (string-equal (file-remote-p "/[method/]:" 'localname) ":")) 1777 (should (string-equal (file-remote-p "/[method/] " 'localname) " ")) 1778 (should (string-equal 1779 (file-remote-p "/[method/]file" 'localname) "file")) 1780 (should (string-equal 1781 (file-remote-p "/[method/]/path/to/file" 'localname) 1782 "/path/to/file")) 1783 1784 ;; Multihop. 1785 (should 1786 (string-equal 1787 (file-remote-p 1788 "/[method1/user1@host1|method2/user2@host2]/path/to/file") 1789 (format "/[%s/%s@%s|%s/%s@%s]" 1790 "method1" "user1" "host1" "method2" "user2" "host2"))) 1791 (should 1792 (string-equal 1793 (file-remote-p 1794 "/[method1/user1@host1|method2/user2@host2]/path/to/file" 'method) 1795 "method2")) 1796 (should 1797 (string-equal 1798 (file-remote-p 1799 "/[method1/user1@host1|method2/user2@host2]/path/to/file" 'user) 1800 "user2")) 1801 (should 1802 (string-equal 1803 (file-remote-p 1804 "/[method1/user1@host1|method2/user2@host2]/path/to/file" 'host) 1805 "host2")) 1806 (should 1807 (string-equal 1808 (file-remote-p 1809 "/[method1/user1@host1|method2/user2@host2]/path/to/file" 1810 'localname) 1811 "/path/to/file")) 1812 (should 1813 (string-equal 1814 (file-remote-p 1815 "/[method1/user1@host1|method2/user2@host2]/path/to/file" 'hop) 1816 (format "%s/%s@%s|" 1817 "method1" "user1" "host1"))) 1818 1819 (should 1820 (string-equal 1821 (file-remote-p 1822 (concat 1823 "/[method1/user1@host1" 1824 "|method2/user2@host2" 1825 "|method3/user3@host3]/path/to/file")) 1826 (format "/[%s/%s@%s|%s/%s@%s|%s/%s@%s]" 1827 "method1" "user1" "host1" 1828 "method2" "user2" "host2" 1829 "method3" "user3" "host3"))) 1830 (should 1831 (string-equal 1832 (file-remote-p 1833 (concat 1834 "/[method1/user1@host1" 1835 "|method2/user2@host2" 1836 "|method3/user3@host3]/path/to/file") 1837 'method) 1838 "method3")) 1839 (should 1840 (string-equal 1841 (file-remote-p 1842 (concat 1843 "/[method1/user1@host1" 1844 "|method2/user2@host2" 1845 "|method3/user3@host3]/path/to/file") 1846 'user) 1847 "user3")) 1848 (should 1849 (string-equal 1850 (file-remote-p 1851 (concat 1852 "/[method1/user1@host1" 1853 "|method2/user2@host2" 1854 "|method3/user3@host3]/path/to/file") 1855 'host) 1856 "host3")) 1857 (should 1858 (string-equal 1859 (file-remote-p 1860 (concat 1861 "/[method1/user1@host1" 1862 "|method2/user2@host2" 1863 "|method3/user3@host3]/path/to/file") 1864 'localname) 1865 "/path/to/file")) 1866 (should 1867 (string-equal 1868 (file-remote-p 1869 (concat 1870 "/[method1/user1@host1" 1871 "|method2/user2@host2" 1872 "|method3/user3@host3]/path/to/file") 1873 'hop) 1874 (format "%s/%s@%s|%s/%s@%s|" 1875 "method1" "user1" "host1" "method2" "user2" "host2"))) 1876 1877 ;; Expand `tramp-default-method-alist'. 1878 (add-to-list 'tramp-default-method-alist '("host1" "user1" "method1")) 1879 (add-to-list 'tramp-default-method-alist '("host2" "user2" "method2")) 1880 (add-to-list 'tramp-default-method-alist '("host3" "user3" "method3")) 1881 (should 1882 (string-equal 1883 (file-remote-p 1884 (concat 1885 "/[/user1@host1" 1886 "|/user2@host2" 1887 "|/user3@host3]/path/to/file")) 1888 (format "/[%s/%s@%s|%s/%s@%s|%s/%s@%s]" 1889 "method1" "user1" "host1" 1890 "method2" "user2" "host2" 1891 "method3" "user3" "host3"))) 1892 1893 ;; Expand `tramp-default-user-alist'. 1894 (add-to-list 'tramp-default-user-alist '("method1" "host1" "user1")) 1895 (add-to-list 'tramp-default-user-alist '("method2" "host2" "user2")) 1896 (add-to-list 'tramp-default-user-alist '("method3" "host3" "user3")) 1897 (should 1898 (string-equal 1899 (file-remote-p 1900 (concat 1901 "/[method1/host1" 1902 "|method2/host2" 1903 "|method3/host3]/path/to/file")) 1904 (format "/[%s/%s@%s|%s/%s@%s|%s/%s@%s]" 1905 "method1" "user1" "host1" 1906 "method2" "user2" "host2" 1907 "method3" "user3" "host3"))) 1908 1909 ;; Expand `tramp-default-host-alist'. 1910 (add-to-list 'tramp-default-host-alist '("method1" "user1" "host1")) 1911 (add-to-list 'tramp-default-host-alist '("method2" "user2" "host2")) 1912 (add-to-list 'tramp-default-host-alist '("method3" "user3" "host3")) 1913 (should 1914 (string-equal 1915 (file-remote-p 1916 (concat 1917 "/[method1/user1@" 1918 "|method2/user2@" 1919 "|method3/user3@]/path/to/file")) 1920 (format "/[%s/%s@%s|%s/%s@%s|%s/%s@%s]" 1921 "method1" "user1" "host1" 1922 "method2" "user2" "host2" 1923 "method3" "user3" "host3"))) 1924 1925 ;; Ad-hoc user name and host name expansion. 1926 (setq tramp-default-method-alist nil 1927 tramp-default-user-alist nil 1928 tramp-default-host-alist nil) 1929 (should 1930 (string-equal 1931 (file-remote-p 1932 (concat 1933 "/[method1/user1@host1" 1934 "|method2/user2@" 1935 "|method3/user3@]/path/to/file")) 1936 (format "/[%s/%s@%s|%s/%s@%s|%s/%s@%s]" 1937 "method1" "user1" "host1" 1938 "method2" "user2" "host1" 1939 "method3" "user3" "host1"))) 1940 (should 1941 (string-equal 1942 (file-remote-p 1943 (concat 1944 "/[method1/%u@%h" 1945 "|method2/user2@host2" 1946 "|method3/%u@%h" 1947 "|method4/user4%domain4@host4#1234]/path/to/file")) 1948 (format "/[%s/%s@%s|%s/%s@%s|%s/%s@%s|%s/%s@%s]" 1949 "method1" "user2" "host2" 1950 "method2" "user2" "host2" 1951 "method3" "user4" "host4" 1952 "method4" "user4%domain4" "host4#1234")))) 1953 1954 ;; Exit. 1955 (tramp-change-syntax syntax)))) 1956 1957(ert-deftest tramp-test03-file-name-defaults () 1958 "Check default values for some methods." 1959 (skip-unless (eq tramp-syntax 'default)) 1960 1961 ;; Default values in tramp-adb.el. 1962 (when (assoc "adb" tramp-methods) 1963 (should (string-equal (file-remote-p "/adb::" 'host) ""))) 1964 ;; Default values in tramp-ftp.el. 1965 (when (assoc "ftp" tramp-methods) 1966 (should (string-equal (file-remote-p "/-:ftp.host:" 'method) "ftp")) 1967 (dolist (u '("ftp" "anonymous")) 1968 (should 1969 (string-equal (file-remote-p (format "/-:%s@:" u) 'method) "ftp")))) 1970 ;; Default values in tramp-sh.el and tramp-sudoedit.el. 1971 (when (assoc "su" tramp-methods) 1972 (dolist (h `("127.0.0.1" "[::1]" "localhost" "localhost6" ,(system-name))) 1973 (should 1974 (string-equal (file-remote-p (format "/-:root@%s:" h) 'method) "su"))) 1975 (dolist (m '("su" "sudo" "ksu" "doas" "sudoedit")) 1976 (should (string-equal (file-remote-p (format "/%s::" m) 'user) "root")) 1977 (should 1978 (string-equal (file-remote-p (format "/%s::" m) 'host) (system-name)))) 1979 (dolist (m '("rcp" "remcp" "rsh" "telnet" "krlogin" "fcp" "nc")) 1980 (should 1981 (string-equal 1982 (file-remote-p (format "/%s::" m) 'user) (user-login-name))))) 1983 ;; Default values in tramp-smb.el. 1984 (when (assoc "smb" tramp-methods) 1985 (should (string-equal (file-remote-p "/smb::" 'user) nil)))) 1986 1987;; The following test is inspired by Bug#30946. 1988(ert-deftest tramp-test03-file-name-host-rules () 1989 "Check host name rules for host-less methods." 1990 (skip-unless (eq tramp-syntax 'default)) 1991 (skip-unless (tramp--test-enabled)) 1992 (skip-unless (tramp--test-sh-p)) 1993 1994 ;; Host names must match rules in case the command template of a 1995 ;; method doesn't use them. 1996 (dolist (m '("su" "sg" "sudo" "doas" "ksu")) 1997 (let (tramp-connection-properties tramp-default-proxies-alist) 1998 (ignore-errors 1999 (tramp-cleanup-connection tramp-test-vec nil 'keep-password)) 2000 ;; Single hop. The host name must match `tramp-local-host-regexp'. 2001 (should-error 2002 (find-file (format "/%s:foo:" m)) 2003 :type 'user-error) 2004 ;; Multi hop. The host name must match the previous hop. 2005 (should-error 2006 (find-file 2007 (format 2008 "%s|%s:foo:" 2009 (substring (file-remote-p tramp-test-temporary-file-directory) 0 -1) 2010 m)) 2011 :type 'user-error)))) 2012 2013(ert-deftest tramp-test03-file-name-method-rules () 2014 "Check file name rules for some methods." 2015 (skip-unless (eq tramp-syntax 'default)) 2016 (skip-unless (tramp--test-enabled)) 2017 2018 ;; Multi hops are allowed for inline methods only. 2019 (let (non-essential) 2020 (should-error 2021 (expand-file-name "/ssh:user1@host1|method:user2@host2:/path/to/file") 2022 :type 'user-error) 2023 (should-error 2024 (expand-file-name "/method:user1@host1|ssh:user2@host2:/path/to/file") 2025 :type 'user-error)) 2026 2027 ;; Samba does not support file names with periods followed by 2028 ;; spaces, and trailing periods or spaces. 2029 (when (tramp--test-smb-p) 2030 (dolist (file '("foo." "foo. bar" "foo ")) 2031 (should-error 2032 (tramp-smb-get-localname 2033 (tramp-dissect-file-name 2034 (expand-file-name file tramp-test-temporary-file-directory))) 2035 :type 'file-error)))) 2036 2037(ert-deftest tramp-test04-substitute-in-file-name () 2038 "Check `substitute-in-file-name'." 2039 (skip-unless (eq tramp-syntax 'default)) 2040 2041 ;; Suppress method name check. We cannot use the string "foo" as 2042 ;; user name, because (substitute-in-string "/~foo") returns 2043 ;; different values depending on the existence of user "foo" (see 2044 ;; Bug#43052). 2045 (let ((tramp-methods (cons '("method") tramp-methods)) 2046 (foo (downcase (md5 (current-time-string))))) 2047 (should 2048 (string-equal (substitute-in-file-name "/method:host:///foo") "/foo")) 2049 (should 2050 (string-equal 2051 (substitute-in-file-name "/method:host://foo") "/method:host:/foo")) 2052 (should 2053 (string-equal (substitute-in-file-name "/method:host:/path///foo") "/foo")) 2054 (should 2055 (string-equal 2056 (substitute-in-file-name "/method:host:/path//foo") "/method:host:/foo")) 2057 ;; Quoting local part. 2058 (should 2059 (string-equal 2060 (substitute-in-file-name "/method:host:/:///foo") 2061 "/method:host:/:///foo")) 2062 (should 2063 (string-equal 2064 (substitute-in-file-name "/method:host:/://foo") "/method:host:/://foo")) 2065 (should 2066 (string-equal 2067 (substitute-in-file-name "/method:host:/:/path///foo") 2068 "/method:host:/:/path///foo")) 2069 (should 2070 (string-equal 2071 (substitute-in-file-name "/method:host:/:/path//foo") 2072 "/method:host:/:/path//foo")) 2073 2074 (should 2075 (string-equal 2076 (substitute-in-file-name (concat "/method:host://~" foo)) 2077 (concat "/~" foo))) 2078 (should 2079 (string-equal 2080 (substitute-in-file-name (concat "/method:host:/~" foo)) 2081 (concat "/method:host:/~" foo))) 2082 (should 2083 (string-equal 2084 (substitute-in-file-name (concat "/method:host:/path//~" foo)) 2085 (concat "/~" foo))) 2086 ;; (substitute-in-file-name "/path/~foo") expands only for a local 2087 ;; user "foo" to "/~foo"". Otherwise, it doesn't expand. 2088 (should 2089 (string-equal 2090 (substitute-in-file-name (concat "/method:host:/path/~" foo)) 2091 (concat "/method:host:/path/~" foo))) 2092 ;; Quoting local part. 2093 (should 2094 (string-equal 2095 (substitute-in-file-name (concat "/method:host:/://~" foo)) 2096 (concat "/method:host:/://~" foo))) 2097 (should 2098 (string-equal 2099 (substitute-in-file-name (concat "/method:host:/:/~" foo)) 2100 (concat "/method:host:/:/~" foo))) 2101 (should 2102 (string-equal 2103 (substitute-in-file-name (concat "/method:host:/:/path//~" foo)) 2104 (concat "/method:host:/:/path//~" foo))) 2105 (should 2106 (string-equal 2107 (substitute-in-file-name (concat "/method:host:/:/path/~" foo)) 2108 (concat "/method:host:/:/path/~" foo))) 2109 2110 (let (process-environment) 2111 (should 2112 (string-equal 2113 (substitute-in-file-name "/method:host:/path/$FOO") 2114 "/method:host:/path/$FOO")) 2115 (setenv "FOO" "bla") 2116 (should 2117 (string-equal 2118 (substitute-in-file-name "/method:host:/path/$FOO") 2119 "/method:host:/path/bla")) 2120 (should 2121 (string-equal 2122 (substitute-in-file-name "/method:host:/path/$$FOO") 2123 "/method:host:/path/$FOO")) 2124 ;; Quoting local part. 2125 (should 2126 (string-equal 2127 (substitute-in-file-name "/method:host:/:/path/$FOO") 2128 "/method:host:/:/path/$FOO")) 2129 (setenv "FOO" "bla") 2130 (should 2131 (string-equal 2132 (substitute-in-file-name "/method:host:/:/path/$FOO") 2133 "/method:host:/:/path/$FOO")) 2134 (should 2135 (string-equal 2136 (substitute-in-file-name "/method:host:/:/path/$$FOO") 2137 "/method:host:/:/path/$$FOO"))))) 2138 2139(ert-deftest tramp-test05-expand-file-name () 2140 "Check `expand-file-name'." 2141 (skip-unless (eq tramp-syntax 'default)) 2142 2143 ;; Suppress method name check. 2144 (let ((tramp-methods (cons '("method") tramp-methods))) 2145 (should 2146 (string-equal 2147 (expand-file-name "/method:host:/path/./file") "/method:host:/path/file")) 2148 (should 2149 (string-equal 2150 (expand-file-name "/method:host:/path/../file") "/method:host:/file")) 2151 (should 2152 (string-equal 2153 (expand-file-name "/method:host:/path/.") "/method:host:/path")) 2154 (should 2155 (string-equal 2156 (expand-file-name "/method:host:/path/..") "/method:host:/")) 2157 (should 2158 (string-equal 2159 (expand-file-name "." "/method:host:/path/") "/method:host:/path")) 2160 (should 2161 (string-equal 2162 (expand-file-name "" "/method:host:/path/") "/method:host:/path")) 2163 ;; Quoting local part. 2164 (should 2165 (string-equal 2166 (expand-file-name "/method:host:/:/path/./file") 2167 "/method:host:/:/path/file")) 2168 (should 2169 (string-equal 2170 (expand-file-name "/method:host:/:/path/../file") "/method:host:/:/file")) 2171 (should 2172 (string-equal 2173 (expand-file-name "/method:host:/:/~/path/./file") 2174 "/method:host:/:/~/path/file")))) 2175 2176;; The following test is inspired by Bug#26911 and Bug#34834. They 2177;; were bugs in `expand-file-name'. 2178(ert-deftest tramp-test05-expand-file-name-relative () 2179 "Check `expand-file-name'." 2180 (skip-unless (tramp--test-enabled)) 2181 ;; The bugs are fixed in Emacs 28.1. 2182 (skip-unless (tramp--test-emacs28-p)) 2183 ;; Methods with a share do not expand "/path/..". 2184 (skip-unless (not (tramp--test-share-p))) 2185 2186 (should 2187 (string-equal 2188 (let ((default-directory 2189 (concat 2190 (file-remote-p tramp-test-temporary-file-directory) "/path"))) 2191 (expand-file-name ".." "./")) 2192 (concat (file-remote-p tramp-test-temporary-file-directory) "/")))) 2193 2194(ert-deftest tramp-test05-expand-file-name-top () 2195 "Check `expand-file-name'." 2196 (skip-unless (tramp--test-enabled)) 2197 (skip-unless (not (tramp--test-ange-ftp-p))) 2198 2199 (let ((dir (concat (file-remote-p tramp-test-temporary-file-directory) "/"))) 2200 (dolist (local '("." "..")) 2201 (should (string-equal (expand-file-name local dir) dir)) 2202 (should (string-equal (expand-file-name (concat dir local)) dir))))) 2203 2204(ert-deftest tramp-test06-directory-file-name () 2205 "Check `directory-file-name'. 2206This checks also `file-name-as-directory', `file-name-directory', 2207`file-name-nondirectory' and `unhandled-file-name-directory'." 2208 (skip-unless (eq tramp-syntax 'default)) 2209 2210 ;; Suppress method name check. 2211 (let ((tramp-methods (cons '("method") tramp-methods))) 2212 (should 2213 (string-equal 2214 (directory-file-name "/method:host:/path/to/file") 2215 "/method:host:/path/to/file")) 2216 (should 2217 (string-equal 2218 (directory-file-name "/method:host:/path/to/file/") 2219 "/method:host:/path/to/file")) 2220 (should 2221 (string-equal 2222 (directory-file-name "/method:host:/path/to/file//") 2223 "/method:host:/path/to/file")) 2224 (should 2225 (string-equal 2226 (file-name-as-directory "/method:host:/path/to/file") 2227 "/method:host:/path/to/file/")) 2228 (should 2229 (string-equal 2230 (file-name-as-directory "/method:host:/path/to/file/") 2231 "/method:host:/path/to/file/")) 2232 (should 2233 (string-equal 2234 (file-name-directory "/method:host:/path/to/file") 2235 "/method:host:/path/to/")) 2236 (should 2237 (string-equal 2238 (file-name-directory "/method:host:/path/to/file/") 2239 "/method:host:/path/to/file/")) 2240 (should 2241 (string-equal (file-name-directory "/method:host:file") "/method:host:")) 2242 (should 2243 (string-equal 2244 (file-name-directory "/method:host:path/") "/method:host:path/")) 2245 (should 2246 (string-equal 2247 (file-name-directory "/method:host:path/to") "/method:host:path/")) 2248 (should 2249 (string-equal 2250 (file-name-nondirectory "/method:host:/path/to/file") "file")) 2251 (should 2252 (string-equal (file-name-nondirectory "/method:host:/path/to/file/") "")) 2253 (should-not 2254 (unhandled-file-name-directory "/method:host:/path/to/file"))) 2255 2256 ;; Bug#10085. 2257 (when (tramp--test-enabled) ;; Packages like tramp-gvfs.el might be disabled. 2258 (dolist (non-essential '(nil t)) 2259 ;; We must clear `tramp-default-method'. On hydra, it is "ftp", 2260 ;; which ruins the tests. 2261 (let ((tramp-default-method 2262 (file-remote-p tramp-test-temporary-file-directory 'method)) 2263 (host (file-remote-p tramp-test-temporary-file-directory 'host))) 2264 (dolist 2265 (file 2266 `(,(format "/%s::" tramp-default-method) 2267 ,(format 2268 "/-:%s:" 2269 (if (string-match-p tramp-ipv6-regexp host) 2270 (concat 2271 tramp-prefix-ipv6-format host tramp-postfix-ipv6-format) 2272 host)))) 2273 (should (string-equal (directory-file-name file) file)) 2274 (should 2275 (string-equal 2276 (file-name-as-directory file) 2277 (if non-essential 2278 file (concat file (if (tramp--test-ange-ftp-p) "/" "./"))))) 2279 (should (string-equal (file-name-directory file) file)) 2280 (should (string-equal (file-name-nondirectory file) ""))))))) 2281 2282(ert-deftest tramp-test07-abbreviate-file-name () 2283 "Check that Tramp abbreviates file names correctly." 2284 (skip-unless (tramp--test-enabled)) 2285 (skip-unless (tramp--test-emacs29-p)) 2286 (skip-unless (not (tramp--test-ange-ftp-p))) 2287 2288 (let* ((remote-host (file-remote-p tramp-test-temporary-file-directory)) 2289 ;; Not all methods can expand "~". 2290 (home-dir (ignore-errors (expand-file-name (concat remote-host "~"))))) 2291 (skip-unless home-dir) 2292 2293 ;; Check home-dir abbreviation. 2294 (unless (string-suffix-p "~" home-dir) 2295 (should (equal (abbreviate-file-name (concat home-dir "/foo/bar")) 2296 (concat remote-host "~/foo/bar"))) 2297 (should (equal (abbreviate-file-name 2298 (concat remote-host "/nowhere/special")) 2299 (concat remote-host "/nowhere/special")))) 2300 2301 ;; Check `directory-abbrev-alist' abbreviation. 2302 (let ((directory-abbrev-alist 2303 `((,(concat "\\`" (regexp-quote home-dir) "/foo") 2304 . ,(concat home-dir "/f")) 2305 (,(concat "\\`" (regexp-quote remote-host) "/nowhere") 2306 . ,(concat remote-host "/nw"))))) 2307 (should (equal (abbreviate-file-name (concat home-dir "/foo/bar")) 2308 (concat remote-host "~/f/bar"))) 2309 (should (equal (abbreviate-file-name 2310 (concat remote-host "/nowhere/special")) 2311 (concat remote-host "/nw/special")))) 2312 2313 ;; Check that home-dir abbreviation doesn't occur when home-dir is just "/". 2314 (setq home-dir (concat remote-host "/")) 2315 ;; The remote home directory is kept in the connection property 2316 ;; "home-directory". We fake this setting. 2317 (tramp-set-connection-property tramp-test-vec "home-directory" home-dir) 2318 (should (equal (concat home-dir "foo/bar") 2319 (abbreviate-file-name (concat home-dir "foo/bar")))) 2320 (tramp-flush-connection-property tramp-test-vec "home-directory"))) 2321 2322(ert-deftest tramp-test07-file-exists-p () 2323 "Check `file-exist-p', `write-region' and `delete-file'." 2324 (skip-unless (tramp--test-enabled)) 2325 2326 (dolist (quoted (if (tramp--test-expensive-test-p) '(nil t) '(nil))) 2327 (let ((tmp-name (tramp--test-make-temp-name nil quoted))) 2328 (should-not (file-exists-p tmp-name)) 2329 (write-region "foo" nil tmp-name) 2330 (should (file-exists-p tmp-name)) 2331 (delete-file tmp-name) 2332 (should-not (file-exists-p tmp-name)) 2333 2334 ;; Trashing files doesn't work when `system-move-file-to-trash' 2335 ;; is defined (on MS Windows and macOS), and for crypted remote 2336 ;; files. 2337 (unless (or (fboundp 'system-move-file-to-trash) (tramp--test-crypt-p)) 2338 (let ((trash-directory (tramp--test-make-temp-name 'local quoted)) 2339 (delete-by-moving-to-trash t)) 2340 (make-directory trash-directory) 2341 (should-not (file-exists-p tmp-name)) 2342 (write-region "foo" nil tmp-name) 2343 (should (file-exists-p tmp-name)) 2344 (delete-file tmp-name 'trash) 2345 (should-not (file-exists-p tmp-name)) 2346 (should 2347 (or (file-exists-p 2348 (expand-file-name 2349 (file-name-nondirectory tmp-name) trash-directory)) 2350 ;; Gdrive. 2351 (file-symlink-p 2352 (expand-file-name 2353 (file-name-nondirectory tmp-name) trash-directory)))) 2354 (delete-directory trash-directory 'recursive) 2355 (should-not (file-exists-p trash-directory))))))) 2356 2357(ert-deftest tramp-test08-file-local-copy () 2358 "Check `file-local-copy'." 2359 (skip-unless (tramp--test-enabled)) 2360 2361 (dolist (quoted (if (tramp--test-expensive-test-p) '(nil t) '(nil))) 2362 (let ((tmp-name1 (tramp--test-make-temp-name nil quoted)) 2363 tmp-name2) 2364 (unwind-protect 2365 (progn 2366 (write-region "foo" nil tmp-name1) 2367 (should (setq tmp-name2 (file-local-copy tmp-name1))) 2368 (with-temp-buffer 2369 (insert-file-contents tmp-name2) 2370 (should (string-equal (buffer-string) "foo"))) 2371 ;; Check also that a file transfer with compression works. 2372 (let ((default-directory tramp-test-temporary-file-directory) 2373 (tramp-copy-size-limit 4) 2374 (tramp-inline-compress-start-size 2)) 2375 (delete-file tmp-name2) 2376 (should (setq tmp-name2 (file-local-copy tmp-name1)))) 2377 ;; Error case. 2378 (delete-file tmp-name1) 2379 (delete-file tmp-name2) 2380 (should-error 2381 (setq tmp-name2 (file-local-copy tmp-name1)) 2382 :type 'file-missing)) 2383 2384 ;; Cleanup. 2385 (ignore-errors 2386 (delete-file tmp-name1) 2387 (delete-file tmp-name2)))))) 2388 2389(ert-deftest tramp-test09-insert-file-contents () 2390 "Check `insert-file-contents'." 2391 (skip-unless (tramp--test-enabled)) 2392 2393 (dolist (quoted (if (tramp--test-expensive-test-p) '(nil t) '(nil))) 2394 (let ((tmp-name (tramp--test-make-temp-name nil quoted))) 2395 (unwind-protect 2396 (with-temp-buffer 2397 (write-region "foo" nil tmp-name) 2398 (let ((point (point))) 2399 (insert-file-contents tmp-name) 2400 (should (string-equal (buffer-string) "foo")) 2401 (should (= point (point)))) 2402 (goto-char (1+ (point))) 2403 (let ((point (point))) 2404 (insert-file-contents tmp-name) 2405 (should (string-equal (buffer-string) "ffoooo")) 2406 (should (= point (point)))) 2407 ;; Insert partly. 2408 (let ((point (point))) 2409 (insert-file-contents tmp-name nil 1 3) 2410 (should (string-equal (buffer-string) "foofoooo")) 2411 (should (= point (point)))) 2412 ;; Replace. 2413 (let ((point (point))) 2414 (insert-file-contents tmp-name nil nil nil 'replace) 2415 (should (string-equal (buffer-string) "foo")) 2416 (should (= point (point)))) 2417 ;; Error case. 2418 (delete-file tmp-name) 2419 (should-error 2420 (insert-file-contents tmp-name) 2421 :type 'file-missing)) 2422 2423 ;; Cleanup. 2424 (ignore-errors (delete-file tmp-name)))))) 2425 2426(ert-deftest tramp-test10-write-region () 2427 "Check `write-region'." 2428 (skip-unless (tramp--test-enabled)) 2429 2430 (dolist (quoted (if (tramp--test-expensive-test-p) '(nil t) '(nil))) 2431 (let ((tmp-name (tramp--test-make-temp-name nil quoted)) 2432 (inhibit-message t)) 2433 (unwind-protect 2434 (progn 2435 ;; Write buffer. Use absolute and relative file name. 2436 (with-temp-buffer 2437 (insert "foo") 2438 (write-region nil nil tmp-name)) 2439 (with-temp-buffer 2440 (insert-file-contents tmp-name) 2441 (should (string-equal (buffer-string) "foo"))) 2442 (delete-file tmp-name) 2443 (with-temp-buffer 2444 (insert "foo") 2445 (should-not (file-exists-p tmp-name)) 2446 (let ((default-directory (file-name-directory tmp-name))) 2447 (should-not (file-exists-p (file-name-nondirectory tmp-name))) 2448 (write-region nil nil (file-name-nondirectory tmp-name)) 2449 (should (file-exists-p (file-name-nondirectory tmp-name)))) 2450 (should (file-exists-p tmp-name))) 2451 (with-temp-buffer 2452 (insert-file-contents tmp-name) 2453 (should (string-equal (buffer-string) "foo"))) 2454 2455 ;; Append. 2456 (unless (tramp--test-ange-ftp-p) 2457 (with-temp-buffer 2458 (insert "bla") 2459 (write-region nil nil tmp-name 'append)) 2460 (with-temp-buffer 2461 (insert-file-contents tmp-name) 2462 (should (string-equal (buffer-string) "foobla"))) 2463 (with-temp-buffer 2464 (insert "baz") 2465 (write-region nil nil tmp-name 3)) 2466 (with-temp-buffer 2467 (insert-file-contents tmp-name) 2468 (should (string-equal (buffer-string) "foobaz"))) 2469 (delete-file tmp-name) 2470 (with-temp-buffer 2471 (insert "foo") 2472 (write-region nil nil tmp-name 'append)) 2473 (with-temp-buffer 2474 (insert-file-contents tmp-name) 2475 (should (string-equal (buffer-string) "foo")))) 2476 2477 ;; Write string. 2478 (write-region "foo" nil tmp-name) 2479 (with-temp-buffer 2480 (insert-file-contents tmp-name) 2481 (should (string-equal (buffer-string) "foo"))) 2482 2483 ;; Write partly. 2484 (with-temp-buffer 2485 (insert "123456789") 2486 (write-region 3 5 tmp-name)) 2487 (with-temp-buffer 2488 (insert-file-contents tmp-name) 2489 (should (string-equal (buffer-string) "34"))) 2490 2491 ;; Check message. 2492 (let (inhibit-message) 2493 (dolist (noninteractive (unless (tramp--test-ange-ftp-p) '(nil t))) 2494 (dolist (visit '(nil t "string" no-message)) 2495 (ert-with-message-capture tramp--test-messages 2496 (write-region "foo" nil tmp-name nil visit) 2497 ;; We must check the last line. There could be 2498 ;; other messages from the progress reporter. 2499 (should 2500 (string-match-p 2501 (if (and (null noninteractive) 2502 (or (eq visit t) (null visit) (stringp visit))) 2503 (format "^Wrote %s\n\\'" (regexp-quote tmp-name)) 2504 "^\\'") 2505 tramp--test-messages)))))) 2506 2507 ;; We do not test lockname here. See 2508 ;; `tramp-test39-make-lock-file-name'. 2509 2510 ;; Do not overwrite if excluded. 2511 (cl-letf (((symbol-function #'y-or-n-p) #'tramp--test-always) 2512 ;; Ange-FTP. 2513 ((symbol-function 'yes-or-no-p) #'tramp--test-always)) 2514 (write-region "foo" nil tmp-name nil nil nil 'mustbenew)) 2515 (should-error 2516 (cl-letf (((symbol-function #'y-or-n-p) #'ignore) 2517 ;; Ange-FTP. 2518 ((symbol-function #'yes-or-no-p) #'ignore)) 2519 (write-region "foo" nil tmp-name nil nil nil 'mustbenew)) 2520 :type 'file-already-exists) 2521 (should-error 2522 (write-region "foo" nil tmp-name nil nil nil 'excl) 2523 :type 'file-already-exists)) 2524 2525 ;; Cleanup. 2526 (ignore-errors (delete-file tmp-name)))))) 2527 2528;; The following test is inspired by Bug#35497. 2529(ert-deftest tramp-test10-write-region-file-precious-flag () 2530 "Check that `file-precious-flag' is respected with Tramp in use." 2531 (skip-unless (tramp--test-enabled)) 2532 (skip-unless (tramp--test-sh-p)) 2533 ;; The bug is fixed in Emacs 27.1. 2534 (skip-unless (tramp--test-emacs27-p)) 2535 2536 (let* ((tmp-name (tramp--test-make-temp-name)) 2537 (inhibit-message t) 2538 written-files 2539 (advice (lambda (_start _end filename &rest _r) 2540 (push filename written-files)))) 2541 2542 (unwind-protect 2543 (with-current-buffer (find-file-noselect tmp-name) 2544 ;; Write initial contents. Adapt `visited-file-modtime' 2545 ;; in order to suppress confirmation. 2546 (insert "foo") 2547 (write-region nil nil tmp-name) 2548 (set-visited-file-modtime) 2549 ;; Run the test. 2550 (advice-add 'write-region :before advice) 2551 (setq-local file-precious-flag t) 2552 (setq-local backup-inhibited t) 2553 (insert "bar") 2554 (should (null (save-buffer))) 2555 (should-not (cl-member tmp-name written-files :test #'string=))) 2556 2557 ;; Cleanup. 2558 (ignore-errors (advice-remove 'write-region advice)) 2559 (ignore-errors (delete-file tmp-name))))) 2560 2561(ert-deftest tramp-test11-copy-file () 2562 "Check `copy-file'." 2563 (skip-unless (tramp--test-enabled)) 2564 2565 ;; `filename-non-special' has been fixed in Emacs 27.1, see Bug#29579. 2566 (dolist (quoted 2567 (if (and (tramp--test-expensive-test-p) (tramp--test-emacs27-p)) 2568 '(nil t) '(nil))) 2569 (let ((tmp-name1 (tramp--test-make-temp-name nil quoted)) 2570 (tmp-name2 (tramp--test-make-temp-name nil quoted)) 2571 (tmp-name3 (tramp--test-make-temp-name 'local quoted))) 2572 (dolist (source-target 2573 `(;; Copy on remote side. 2574 (,tmp-name1 . ,tmp-name2) 2575 ;; Copy from remote side to local side. 2576 (,tmp-name1 . ,tmp-name3) 2577 ;; Copy from local side to remote side. 2578 (,tmp-name3 . ,tmp-name1))) 2579 (let ((source (car source-target)) 2580 (target (cdr source-target))) 2581 2582 ;; Copy simple file. 2583 (unwind-protect 2584 (progn 2585 (should-error 2586 (copy-file source target) 2587 :type 'file-missing) 2588 (write-region "foo" nil source) 2589 (should (file-exists-p source)) 2590 (copy-file source target) 2591 (should (file-exists-p target)) 2592 (with-temp-buffer 2593 (insert-file-contents target) 2594 (should (string-equal (buffer-string) "foo"))) 2595 (when (tramp--test-expensive-test-p) 2596 (should-error 2597 (copy-file source target) 2598 :type 'file-already-exists)) 2599 (copy-file source target 'ok)) 2600 2601 ;; Cleanup. 2602 (ignore-errors (delete-file source)) 2603 (ignore-errors (delete-file target))) 2604 2605 ;; Copy file to directory. 2606 (unwind-protect 2607 ;; This doesn't work on FTP. 2608 (unless (tramp--test-ange-ftp-p) 2609 (write-region "foo" nil source) 2610 (should (file-exists-p source)) 2611 (make-directory target) 2612 (should (file-directory-p target)) 2613 (when (tramp--test-expensive-test-p) 2614 (should-error 2615 (copy-file source target) 2616 :type 'file-already-exists) 2617 (should-error 2618 (copy-file source target 'ok) 2619 :type 'file-error)) 2620 (copy-file source (file-name-as-directory target)) 2621 (should 2622 (file-exists-p 2623 (expand-file-name (file-name-nondirectory source) target)))) 2624 2625 ;; Cleanup. 2626 (ignore-errors (delete-file source)) 2627 (ignore-errors (delete-directory target 'recursive))) 2628 2629 ;; Copy directory to existing directory. 2630 (unwind-protect 2631 ;; This doesn't work on FTP. 2632 (unless (tramp--test-ange-ftp-p) 2633 (make-directory source) 2634 (should (file-directory-p source)) 2635 (write-region "foo" nil (expand-file-name "foo" source)) 2636 (should (file-exists-p (expand-file-name "foo" source))) 2637 (make-directory target) 2638 (should (file-directory-p target)) 2639 ;; Directory `target' exists already, so we must use 2640 ;; `file-name-as-directory'. 2641 (copy-file source (file-name-as-directory target)) 2642 (should 2643 (file-exists-p 2644 (expand-file-name 2645 (concat (file-name-nondirectory source) "/foo") target)))) 2646 2647 ;; Cleanup. 2648 (ignore-errors (delete-directory source 'recursive)) 2649 (ignore-errors (delete-directory target 'recursive))) 2650 2651 ;; Copy directory/file to non-existing directory. 2652 (unwind-protect 2653 ;; This doesn't work on FTP. 2654 (unless (tramp--test-ange-ftp-p) 2655 (make-directory source) 2656 (should (file-directory-p source)) 2657 (write-region "foo" nil (expand-file-name "foo" source)) 2658 (should (file-exists-p (expand-file-name "foo" source))) 2659 (make-directory target) 2660 (should (file-directory-p target)) 2661 (copy-file 2662 source 2663 (expand-file-name (file-name-nondirectory source) target)) 2664 (should 2665 (file-exists-p 2666 (expand-file-name 2667 (concat (file-name-nondirectory source) "/foo") target)))) 2668 2669 ;; Cleanup. 2670 (ignore-errors (delete-directory source 'recursive)) 2671 (ignore-errors (delete-directory target 'recursive)))))))) 2672 2673(ert-deftest tramp-test12-rename-file () 2674 "Check `rename-file'." 2675 (skip-unless (tramp--test-enabled)) 2676 2677 ;; `filename-non-special' has been fixed in Emacs 27.1, see Bug#29579. 2678 (dolist (quoted 2679 (if (and (tramp--test-expensive-test-p) (tramp--test-emacs27-p)) 2680 '(nil t) '(nil))) 2681 (let ((tmp-name1 (tramp--test-make-temp-name nil quoted)) 2682 (tmp-name2 (tramp--test-make-temp-name nil quoted)) 2683 (tmp-name3 (tramp--test-make-temp-name 'local quoted))) 2684 (dolist (source-target 2685 `(;; Rename on remote side. 2686 (,tmp-name1 . ,tmp-name2) 2687 ;; Rename from remote side to local side. 2688 (,tmp-name1 . ,tmp-name3) 2689 ;; Rename from local side to remote side. 2690 (,tmp-name3 . ,tmp-name1))) 2691 (let ((source (car source-target)) 2692 (target (cdr source-target))) 2693 2694 ;; Rename simple file. 2695 (unwind-protect 2696 (progn 2697 (should-error 2698 (rename-file source target) 2699 :type 'file-missing) 2700 (write-region "foo" nil source) 2701 (should (file-exists-p source)) 2702 (rename-file source target) 2703 (should-not (file-exists-p source)) 2704 (should (file-exists-p target)) 2705 (with-temp-buffer 2706 (insert-file-contents target) 2707 (should (string-equal (buffer-string) "foo"))) 2708 (write-region "foo" nil source) 2709 (should (file-exists-p source)) 2710 (when (tramp--test-expensive-test-p) 2711 (should-error 2712 (rename-file source target) 2713 :type 'file-already-exists)) 2714 (rename-file source target 'ok) 2715 (should-not (file-exists-p source))) 2716 2717 ;; Cleanup. 2718 (ignore-errors (delete-file source)) 2719 (ignore-errors (delete-file target))) 2720 2721 ;; Rename file to directory. 2722 (unwind-protect 2723 (progn 2724 (write-region "foo" nil source) 2725 (should (file-exists-p source)) 2726 (make-directory target) 2727 (should (file-directory-p target)) 2728 (when (tramp--test-expensive-test-p) 2729 (should-error 2730 (rename-file source target) 2731 :type 'file-already-exists) 2732 (should-error 2733 (rename-file source target 'ok) 2734 :type 'file-error)) 2735 (rename-file source (file-name-as-directory target)) 2736 (should-not (file-exists-p source)) 2737 (should 2738 (file-exists-p 2739 (expand-file-name (file-name-nondirectory source) target)))) 2740 2741 ;; Cleanup. 2742 (ignore-errors (delete-file source)) 2743 (ignore-errors (delete-directory target 'recursive))) 2744 2745 ;; Rename directory to existing directory. 2746 (unwind-protect 2747 ;; This doesn't work on FTP. 2748 (unless (tramp--test-ange-ftp-p) 2749 (make-directory source) 2750 (should (file-directory-p source)) 2751 (write-region "foo" nil (expand-file-name "foo" source)) 2752 (should (file-exists-p (expand-file-name "foo" source))) 2753 (make-directory target) 2754 (should (file-directory-p target)) 2755 ;; Directory `target' exists already, so we must use 2756 ;; `file-name-as-directory'. 2757 (rename-file source (file-name-as-directory target)) 2758 (should-not (file-exists-p source)) 2759 (should 2760 (file-exists-p 2761 (expand-file-name 2762 (concat (file-name-nondirectory source) "/foo") target)))) 2763 2764 ;; Cleanup. 2765 (ignore-errors (delete-directory source 'recursive)) 2766 (ignore-errors (delete-directory target 'recursive))) 2767 2768 ;; Rename directory/file to non-existing directory. 2769 (unwind-protect 2770 ;; This doesn't work on FTP. 2771 (unless (tramp--test-ange-ftp-p) 2772 (make-directory source) 2773 (should (file-directory-p source)) 2774 (write-region "foo" nil (expand-file-name "foo" source)) 2775 (should (file-exists-p (expand-file-name "foo" source))) 2776 (make-directory target) 2777 (should (file-directory-p target)) 2778 (rename-file 2779 source 2780 (expand-file-name (file-name-nondirectory source) target)) 2781 (should-not (file-exists-p source)) 2782 (should 2783 (file-exists-p 2784 (expand-file-name 2785 (concat (file-name-nondirectory source) "/foo") target)))) 2786 2787 ;; Cleanup. 2788 (ignore-errors (delete-directory source 'recursive)) 2789 (ignore-errors (delete-directory target 'recursive)))))))) 2790 2791(ert-deftest tramp-test13-make-directory () 2792 "Check `make-directory'. 2793This tests also `file-directory-p' and `file-accessible-directory-p'." 2794 (skip-unless (tramp--test-enabled)) 2795 2796 (dolist (quoted (if (tramp--test-expensive-test-p) '(nil t) '(nil))) 2797 (let* ((tmp-name1 (tramp--test-make-temp-name nil quoted)) 2798 (tmp-name2 (expand-file-name "foo/bar" tmp-name1)) 2799 (unusual-file-mode-1 #o740) 2800 (unusual-file-mode-2 #o710)) 2801 (unwind-protect 2802 (progn 2803 (with-file-modes unusual-file-mode-1 2804 (make-directory tmp-name1)) 2805 (should-error 2806 (make-directory tmp-name1) 2807 :type 'file-already-exists) 2808 (should (file-directory-p tmp-name1)) 2809 (should (file-accessible-directory-p tmp-name1)) 2810 (when (tramp--test-supports-set-file-modes-p) 2811 (should (equal (format "%#o" unusual-file-mode-1) 2812 (format "%#o" (file-modes tmp-name1))))) 2813 (should-error 2814 (make-directory tmp-name2) 2815 :type 'file-error) 2816 (with-file-modes unusual-file-mode-2 2817 (make-directory tmp-name2 'parents)) 2818 (should (file-directory-p tmp-name2)) 2819 (should (file-accessible-directory-p tmp-name2)) 2820 (when (tramp--test-supports-set-file-modes-p) 2821 (should (equal (format "%#o" unusual-file-mode-2) 2822 (format "%#o" (file-modes tmp-name2))))) 2823 ;; If PARENTS is non-nil, `make-directory' shall not 2824 ;; signal an error when DIR exists already. 2825 (make-directory tmp-name2 'parents)) 2826 2827 ;; Cleanup. 2828 (ignore-errors (delete-directory tmp-name1 'recursive)))))) 2829 2830(ert-deftest tramp-test14-delete-directory () 2831 "Check `delete-directory'." 2832 (skip-unless (tramp--test-enabled)) 2833 2834 (dolist (quoted (if (tramp--test-expensive-test-p) '(nil t) '(nil))) 2835 (let* ((tmp-name1 (tramp--test-make-temp-name nil quoted)) 2836 (tmp-name2 (expand-file-name "foo" tmp-name1))) 2837 ;; Delete empty directory. 2838 (make-directory tmp-name1) 2839 (should (file-directory-p tmp-name1)) 2840 (delete-directory tmp-name1) 2841 (should-not (file-directory-p tmp-name1)) 2842 ;; Delete non-empty directory. 2843 (make-directory tmp-name1) 2844 (should (file-directory-p tmp-name1)) 2845 (write-region "foo" nil (expand-file-name "bla" tmp-name1)) 2846 (should (file-exists-p (expand-file-name "bla" tmp-name1))) 2847 (make-directory tmp-name2) 2848 (should (file-directory-p tmp-name2)) 2849 (write-region "foo" nil (expand-file-name "bla" tmp-name2)) 2850 (should (file-exists-p (expand-file-name "bla" tmp-name2))) 2851 (should-error 2852 (delete-directory tmp-name1) 2853 :type 'file-error) 2854 (delete-directory tmp-name1 'recursive) 2855 (should-not (file-directory-p tmp-name1)) 2856 2857 ;; Trashing directories works only since Emacs 27.1. It doesn't 2858 ;; work when `system-move-file-to-trash' is defined (on MS 2859 ;; Windows and macOS), for crypted remote directories and for 2860 ;; ange-ftp. 2861 (when (and (not (fboundp 'system-move-file-to-trash)) 2862 (not (tramp--test-crypt-p)) (not (tramp--test-ftp-p)) 2863 (tramp--test-emacs27-p)) 2864 (let ((trash-directory (tramp--test-make-temp-name 'local quoted)) 2865 (delete-by-moving-to-trash t)) 2866 (make-directory trash-directory) 2867 ;; Delete empty directory. 2868 (make-directory tmp-name1) 2869 (should (file-directory-p tmp-name1)) 2870 (delete-directory tmp-name1 nil 'trash) 2871 (should-not (file-directory-p tmp-name1)) 2872 (should 2873 (file-exists-p 2874 (expand-file-name 2875 (file-name-nondirectory tmp-name1) trash-directory))) 2876 (delete-directory trash-directory 'recursive) 2877 (should-not (file-exists-p trash-directory)) 2878 ;; Delete non-empty directory. 2879 (make-directory tmp-name1) 2880 (should (file-directory-p tmp-name1)) 2881 (write-region "foo" nil (expand-file-name "bla" tmp-name1)) 2882 (should (file-exists-p (expand-file-name "bla" tmp-name1))) 2883 (make-directory tmp-name2) 2884 (should (file-directory-p tmp-name2)) 2885 (write-region "foo" nil (expand-file-name "bla" tmp-name2)) 2886 (should (file-exists-p (expand-file-name "bla" tmp-name2))) 2887 (should-error 2888 (delete-directory tmp-name1 nil 'trash) 2889 ;; tramp-rclone.el and tramp-sshfs.el call the local 2890 ;; `delete-directory'. This raises another error. 2891 :type (if (tramp--test-fuse-p) 'error 'file-error)) 2892 (delete-directory tmp-name1 'recursive 'trash) 2893 (should-not (file-directory-p tmp-name1)) 2894 (should 2895 (file-exists-p 2896 (format 2897 "%s/%s/bla" trash-directory (file-name-nondirectory tmp-name1)))) 2898 (should 2899 (file-exists-p 2900 (format 2901 "%s/%s/%s/bla" trash-directory (file-name-nondirectory tmp-name1) 2902 (file-name-nondirectory tmp-name2)))) 2903 (delete-directory trash-directory 'recursive) 2904 (should-not (file-exists-p trash-directory))))))) 2905 2906(ert-deftest tramp-test15-copy-directory () 2907 "Check `copy-directory'." 2908 (skip-unless (tramp--test-enabled)) 2909 (skip-unless (not (tramp--test-rclone-p))) 2910 2911 (dolist (quoted (if (tramp--test-expensive-test-p) '(nil t) '(nil))) 2912 (let* ((tmp-name1 (tramp--test-make-temp-name nil quoted)) 2913 (tmp-name2 (tramp--test-make-temp-name nil quoted)) 2914 (tmp-name3 (expand-file-name 2915 (file-name-nondirectory tmp-name1) tmp-name2)) 2916 (tmp-name4 (expand-file-name "foo" tmp-name1)) 2917 (tmp-name5 (expand-file-name "foo" tmp-name2)) 2918 (tmp-name6 (expand-file-name "foo" tmp-name3)) 2919 (tmp-name7 (tramp--test-make-temp-name nil quoted))) 2920 2921 ;; Copy complete directory. 2922 (unwind-protect 2923 (progn 2924 (should-error 2925 (copy-directory tmp-name1 tmp-name2) 2926 :type 'file-missing) 2927 ;; Copy empty directory. 2928 (make-directory tmp-name1) 2929 (write-region "foo" nil tmp-name4) 2930 (should (file-directory-p tmp-name1)) 2931 (should (file-exists-p tmp-name4)) 2932 (copy-directory tmp-name1 tmp-name2) 2933 (should (file-directory-p tmp-name2)) 2934 (should (file-exists-p tmp-name5)) 2935 ;; Target directory does exist already. 2936 (should-error 2937 (copy-directory tmp-name1 tmp-name2) 2938 :type 'file-already-exists) 2939 (copy-directory tmp-name1 (file-name-as-directory tmp-name2)) 2940 (should (file-directory-p tmp-name3)) 2941 (should (file-exists-p tmp-name6))) 2942 2943 ;; Cleanup. 2944 (ignore-errors 2945 (delete-directory tmp-name1 'recursive) 2946 (delete-directory tmp-name2 'recursive))) 2947 2948 ;; Copy directory contents. 2949 (unwind-protect 2950 (progn 2951 ;; Copy empty directory. 2952 (make-directory tmp-name1) 2953 (write-region "foo" nil tmp-name4) 2954 (should (file-directory-p tmp-name1)) 2955 (should (file-exists-p tmp-name4)) 2956 (copy-directory tmp-name1 tmp-name2 nil 'parents 'contents) 2957 (should (file-directory-p tmp-name2)) 2958 (should (file-exists-p tmp-name5)) 2959 ;; Target directory does exist already. 2960 (delete-file tmp-name5) 2961 (should-not (file-exists-p tmp-name5)) 2962 (copy-directory 2963 tmp-name1 (file-name-as-directory tmp-name2) 2964 nil 'parents 'contents) 2965 (should (file-directory-p tmp-name2)) 2966 (should (file-exists-p tmp-name5)) 2967 (should-not (file-directory-p tmp-name3)) 2968 (should-not (file-exists-p tmp-name6))) 2969 2970 ;; Cleanup. 2971 (ignore-errors 2972 (delete-directory tmp-name1 'recursive) 2973 (delete-directory tmp-name2 'recursive))) 2974 2975 ;; Copy symlink to directory. Implemented since Emacs 28.1. 2976 (when (boundp 'copy-directory-create-symlink) 2977 (dolist (copy-directory-create-symlink '(nil t)) 2978 (unwind-protect 2979 (tramp--test-ignore-make-symbolic-link-error 2980 ;; Copy to file name. 2981 (make-directory tmp-name1) 2982 (write-region "foo" nil tmp-name4) 2983 (make-symbolic-link tmp-name1 tmp-name7) 2984 (should (file-directory-p tmp-name1)) 2985 (should (file-exists-p tmp-name4)) 2986 (should (file-symlink-p tmp-name7)) 2987 (copy-directory tmp-name7 tmp-name2) 2988 (if copy-directory-create-symlink 2989 (should 2990 (string-equal 2991 (file-symlink-p tmp-name2) (file-symlink-p tmp-name7))) 2992 (should (file-directory-p tmp-name2))) 2993 ;; Copy to directory name. 2994 (delete-directory tmp-name2 'recursive) 2995 (make-directory tmp-name2) 2996 (should (file-directory-p tmp-name2)) 2997 (copy-directory tmp-name7 (file-name-as-directory tmp-name2)) 2998 (if copy-directory-create-symlink 2999 (should 3000 (string-equal 3001 (file-symlink-p 3002 (expand-file-name 3003 (file-name-nondirectory tmp-name7) tmp-name2)) 3004 (file-symlink-p tmp-name7))) 3005 (should 3006 (file-directory-p 3007 (expand-file-name 3008 (file-name-nondirectory tmp-name7) tmp-name2))))) 3009 3010 ;; Cleanup. 3011 (ignore-errors 3012 (delete-directory tmp-name1 'recursive) 3013 (delete-directory tmp-name2 'recursive) 3014 (delete-directory tmp-name7 'recursive)))))))) 3015 3016(ert-deftest tramp-test16-directory-files () 3017 "Check `directory-files'." 3018 (skip-unless (tramp--test-enabled)) 3019 3020 (dolist (quoted (if (tramp--test-expensive-test-p) '(nil t) '(nil))) 3021 (let* ((tmp-name1 (tramp--test-make-temp-name nil quoted)) 3022 (tmp-name2 (expand-file-name "bla" tmp-name1)) 3023 (tmp-name3 (expand-file-name "foo" tmp-name1))) 3024 (unwind-protect 3025 (progn 3026 (should-error 3027 (directory-files tmp-name1) 3028 :type 'file-missing) 3029 (make-directory tmp-name1) 3030 (write-region "foo" nil tmp-name2) 3031 (write-region "bla" nil tmp-name3) 3032 (should (file-directory-p tmp-name1)) 3033 (should (file-exists-p tmp-name2)) 3034 (should (file-exists-p tmp-name3)) 3035 (should (equal (directory-files tmp-name1) '("." ".." "bla" "foo"))) 3036 (should (equal (directory-files tmp-name1 'full) 3037 `(,(concat tmp-name1 "/.") 3038 ,(concat tmp-name1 "/..") 3039 ,tmp-name2 ,tmp-name3))) 3040 (should (equal (directory-files 3041 tmp-name1 nil directory-files-no-dot-files-regexp) 3042 '("bla" "foo"))) 3043 (should (equal (directory-files 3044 tmp-name1 'full directory-files-no-dot-files-regexp) 3045 `(,tmp-name2 ,tmp-name3))) 3046 ;; Check the COUNT arg. It exists since Emacs 28. 3047 (when (tramp--test-emacs28-p) 3048 (with-no-warnings 3049 (should 3050 (equal 3051 (directory-files 3052 tmp-name1 nil directory-files-no-dot-files-regexp nil 1) 3053 '("bla")))))) 3054 3055 ;; Cleanup. 3056 (ignore-errors (delete-directory tmp-name1 'recursive)))))) 3057 3058;; This is not a file name handler test. But Tramp needed to apply an 3059;; advice for older Emacs versions, so we check that this has been fixed. 3060(ert-deftest tramp-test16-file-expand-wildcards () 3061 "Check `file-expand-wildcards'." 3062 (skip-unless (tramp--test-enabled)) 3063 3064 (dolist (quoted (if (tramp--test-expensive-test-p) '(nil t) '(nil))) 3065 (let* ((tmp-name1 (tramp--test-make-temp-name nil quoted)) 3066 (tmp-name2 (expand-file-name "foo" tmp-name1)) 3067 (tmp-name3 (expand-file-name "bar" tmp-name1)) 3068 (tmp-name4 (expand-file-name "baz" tmp-name1)) 3069 (default-directory tmp-name1)) 3070 (unwind-protect 3071 (progn 3072 (make-directory tmp-name1) 3073 (write-region "foo" nil tmp-name2) 3074 (write-region "bar" nil tmp-name3) 3075 (write-region "baz" nil tmp-name4) 3076 (should (file-directory-p tmp-name1)) 3077 (should (file-exists-p tmp-name2)) 3078 (should (file-exists-p tmp-name3)) 3079 (should (file-exists-p tmp-name4)) 3080 3081 ;; `sort' works destructive. 3082 (should 3083 (equal (file-expand-wildcards "*") 3084 (sort (copy-sequence '("foo" "bar" "baz")) 'string<))) 3085 (should 3086 (equal (file-expand-wildcards "ba?") 3087 (sort (copy-sequence '("bar" "baz")) 'string<))) 3088 (should 3089 (equal (file-expand-wildcards "ba[rz]") 3090 (sort (copy-sequence '("bar" "baz")) 'string<))) 3091 3092 (should 3093 (equal 3094 (file-expand-wildcards "*" 'full) 3095 (sort 3096 (copy-sequence `(,tmp-name2 ,tmp-name3 ,tmp-name4)) 'string<))) 3097 (should 3098 (equal 3099 (file-expand-wildcards "ba?" 'full) 3100 (sort (copy-sequence `(,tmp-name3 ,tmp-name4)) 'string<))) 3101 (should 3102 (equal 3103 (file-expand-wildcards "ba[rz]" 'full) 3104 (sort (copy-sequence `(,tmp-name3 ,tmp-name4)) 'string<))) 3105 3106 (should 3107 (equal 3108 (file-expand-wildcards (concat tmp-name1 "/" "*")) 3109 (sort 3110 (copy-sequence `(,tmp-name2 ,tmp-name3 ,tmp-name4)) 'string<))) 3111 (should 3112 (equal 3113 (file-expand-wildcards (concat tmp-name1 "/" "ba?")) 3114 (sort (copy-sequence `(,tmp-name3 ,tmp-name4)) 'string<))) 3115 (should 3116 (equal 3117 (file-expand-wildcards (concat tmp-name1 "/" "ba[rz]")) 3118 (sort (copy-sequence `(,tmp-name3 ,tmp-name4)) 'string<)))) 3119 3120 ;; Cleanup. 3121 (ignore-errors (delete-directory tmp-name1 'recursive)))))) 3122 3123(ert-deftest tramp-test17-insert-directory () 3124 "Check `insert-directory'." 3125 (skip-unless (tramp--test-enabled)) 3126 ;; Ange-FTP is very special. It does not include the header line 3127 ;; (this is performed by `dired'). If FULL is nil, it shows just 3128 ;; one file. So we refrain from testing. 3129 (skip-unless (not (tramp--test-ange-ftp-p))) 3130 ;; `insert-directory' of crypted remote directories works only since 3131 ;; Emacs 27.1. 3132 (skip-unless (or (not (tramp--test-crypt-p)) (tramp--test-emacs27-p))) 3133 3134 (dolist (quoted (if (tramp--test-expensive-test-p) '(nil t) '(nil))) 3135 (let* ((tmp-name1 3136 (expand-file-name (tramp--test-make-temp-name nil quoted))) 3137 (tmp-name2 (expand-file-name "foo" tmp-name1)) 3138 ;; We test for the summary line. Keyword "total" could be localized. 3139 (process-environment 3140 (append '("LANG=C" "LANGUAGE=C" "LC_ALL=C") process-environment))) 3141 (unwind-protect 3142 (progn 3143 (make-directory tmp-name1) 3144 (write-region "foo" nil tmp-name2) 3145 (should (file-directory-p tmp-name1)) 3146 (should (file-exists-p tmp-name2)) 3147 (with-temp-buffer 3148 (insert-directory tmp-name1 nil) 3149 (goto-char (point-min)) 3150 (should (looking-at-p (regexp-quote tmp-name1)))) 3151 (with-temp-buffer 3152 (insert-directory (file-name-as-directory tmp-name1) nil) 3153 (goto-char (point-min)) 3154 (should 3155 (looking-at-p 3156 (regexp-quote (file-name-as-directory tmp-name1))))) 3157 (with-temp-buffer 3158 (insert-directory tmp-name1 "-al") 3159 (goto-char (point-min)) 3160 (should 3161 (looking-at-p (format "^.+ %s$" (regexp-quote tmp-name1))))) 3162 (with-temp-buffer 3163 (insert-directory (file-name-as-directory tmp-name1) "-al") 3164 (goto-char (point-min)) 3165 (should 3166 (looking-at-p (format "^.+ %s/$" (regexp-quote tmp-name1))))) 3167 (with-temp-buffer 3168 (insert-directory 3169 (file-name-as-directory tmp-name1) "-al" nil 'full-directory-p) 3170 (goto-char (point-min)) 3171 (should 3172 (looking-at-p 3173 (concat 3174 ;; There might be a summary line. 3175 "\\(total.+[[:digit:]]+ ?[kKMGTPEZY]?i?B?\n\\)?" 3176 ;; We don't know in which order ".", ".." and "foo" appear. 3177 (format 3178 "\\(.+ %s\\( ->.+\\)?\n\\)\\{%d\\}" 3179 (regexp-opt (directory-files tmp-name1)) 3180 (length (directory-files tmp-name1))))))) 3181 3182 ;; Check error cases. 3183 (when (and (tramp--test-supports-set-file-modes-p) 3184 ;; With "sshfs", directories with zero file 3185 ;; modes are still "accessible". 3186 (not (tramp--test-sshfs-p)) 3187 ;; A directory is always accessible for user "root". 3188 (not (zerop (file-attribute-user-id 3189 (file-attributes tmp-name1))))) 3190 (set-file-modes tmp-name1 0) 3191 (with-temp-buffer 3192 (should-error 3193 (insert-directory tmp-name1 nil) 3194 :type 'file-error)) 3195 (set-file-modes tmp-name1 #o777)) 3196 (delete-directory tmp-name1 'recursive) 3197 (with-temp-buffer 3198 (should-error 3199 (insert-directory tmp-name1 nil) 3200 :type 'file-missing))) 3201 3202 ;; Cleanup. 3203 (ignore-errors (delete-directory tmp-name1 'recursive)))))) 3204 3205(ert-deftest tramp-test17-dired-with-wildcards () 3206 "Check `dired' with wildcards." 3207 ;; `separate' syntax and IPv6 host name syntax do not work. 3208 (skip-unless (not (string-match-p "\\[" tramp-test-temporary-file-directory))) 3209 (skip-unless (tramp--test-enabled)) 3210 (skip-unless (tramp--test-sh-p)) 3211 (skip-unless (not (tramp--test-rsync-p))) 3212 ;; Wildcards are not supported in tramp-crypt.el. 3213 (skip-unless (not (tramp--test-crypt-p))) 3214 3215 (dolist (quoted (if (tramp--test-expensive-test-p) '(nil t) '(nil))) 3216 (let* ((tmp-name1 3217 (expand-file-name (tramp--test-make-temp-name nil quoted))) 3218 (tmp-name2 3219 (expand-file-name (tramp--test-make-temp-name nil quoted))) 3220 (tmp-name3 (expand-file-name "foo" tmp-name1)) 3221 (tmp-name4 (expand-file-name "bar" tmp-name2)) 3222 (tramp-test-temporary-file-directory 3223 (funcall 3224 (if quoted #'tramp-compat-file-name-quote #'identity) 3225 tramp-test-temporary-file-directory)) 3226 buffer) 3227 (unwind-protect 3228 (progn 3229 (make-directory tmp-name1) 3230 (write-region "foo" nil tmp-name3) 3231 (should (file-directory-p tmp-name1)) 3232 (should (file-exists-p tmp-name3)) 3233 (make-directory tmp-name2) 3234 (write-region "foo" nil tmp-name4) 3235 (should (file-directory-p tmp-name2)) 3236 (should (file-exists-p tmp-name4)) 3237 3238 ;; Check for expanded directory names. 3239 (with-current-buffer 3240 (setq buffer 3241 (dired-noselect 3242 (expand-file-name 3243 "tramp-test*" tramp-test-temporary-file-directory))) 3244 (goto-char (point-min)) 3245 (should 3246 (re-search-forward 3247 (regexp-quote 3248 (file-relative-name 3249 tmp-name1 tramp-test-temporary-file-directory)))) 3250 (goto-char (point-min)) 3251 (should 3252 (re-search-forward 3253 (regexp-quote 3254 (file-relative-name 3255 tmp-name2 tramp-test-temporary-file-directory))))) 3256 (kill-buffer buffer) 3257 3258 ;; Check for expanded directory and file names. 3259 (with-current-buffer 3260 (setq buffer 3261 (dired-noselect 3262 (expand-file-name 3263 "tramp-test*/*" tramp-test-temporary-file-directory))) 3264 (goto-char (point-min)) 3265 (should 3266 (re-search-forward 3267 (regexp-quote 3268 (file-relative-name 3269 tmp-name3 tramp-test-temporary-file-directory)))) 3270 (goto-char (point-min)) 3271 (should 3272 (re-search-forward 3273 (regexp-quote 3274 (file-relative-name 3275 tmp-name4 3276 tramp-test-temporary-file-directory))))) 3277 (kill-buffer buffer) 3278 3279 ;; Check for special characters. 3280 (setq tmp-name3 (expand-file-name "*?" tmp-name1)) 3281 (setq tmp-name4 (expand-file-name "[a-z0-9]" tmp-name2)) 3282 (write-region "foo" nil tmp-name3) 3283 (should (file-exists-p tmp-name3)) 3284 (write-region "foo" nil tmp-name4) 3285 (should (file-exists-p tmp-name4)) 3286 3287 (with-current-buffer 3288 (setq buffer 3289 (dired-noselect 3290 (expand-file-name 3291 "tramp-test*/*" tramp-test-temporary-file-directory))) 3292 (goto-char (point-min)) 3293 (should 3294 (re-search-forward 3295 (regexp-quote 3296 (file-relative-name 3297 tmp-name3 tramp-test-temporary-file-directory)))) 3298 (goto-char (point-min)) 3299 (should 3300 (re-search-forward 3301 (regexp-quote 3302 (file-relative-name 3303 tmp-name4 3304 tramp-test-temporary-file-directory))))) 3305 (kill-buffer buffer)) 3306 3307 ;; Cleanup. 3308 (ignore-errors (kill-buffer buffer)) 3309 (ignore-errors (delete-directory tmp-name1 'recursive)) 3310 (ignore-errors (delete-directory tmp-name2 'recursive)))))) 3311 3312;; The following test is inspired by Bug#45691. 3313(ert-deftest tramp-test17-insert-directory-one-file () 3314 "Check `insert-directory' inside directory listing." 3315 (skip-unless (tramp--test-enabled)) 3316 ;; Relative file names in dired are not supported in tramp-crypt.el. 3317 (skip-unless (not (tramp--test-crypt-p))) 3318 3319 (dolist (quoted (if (tramp--test-expensive-test-p) '(nil t) '(nil))) 3320 (let* ((tmp-name1 3321 (expand-file-name (tramp--test-make-temp-name nil quoted))) 3322 (tmp-name2 (expand-file-name "foo" tmp-name1)) 3323 (tmp-name3 (expand-file-name "bar" tmp-name1)) 3324 (dired-copy-preserve-time t) 3325 (dired-recursive-copies 'top) 3326 dired-copy-dereference 3327 buffer) 3328 (unwind-protect 3329 (progn 3330 (make-directory tmp-name1) 3331 (write-region "foo" nil tmp-name2) 3332 (should (file-directory-p tmp-name1)) 3333 (should (file-exists-p tmp-name2)) 3334 3335 ;; Check, that `insert-directory' works properly. 3336 (with-current-buffer 3337 (setq buffer (dired-noselect tmp-name1 "--dired -al")) 3338 (read-only-mode -1) 3339 (goto-char (point-min)) 3340 (while (not (or (eobp) 3341 (string-equal 3342 (dired-get-filename 'no-dir 'no-error) 3343 (file-name-nondirectory tmp-name2)))) 3344 (forward-line 1)) 3345 (should-not (eobp)) 3346 (copy-file tmp-name2 tmp-name3) 3347 (insert-directory 3348 (file-name-nondirectory tmp-name3) "--dired -al -d") 3349 ;; Point shall still be the recent file. 3350 (should 3351 (string-equal 3352 (dired-get-filename 'no-dir 'no-error) 3353 (file-name-nondirectory tmp-name2))) 3354 (should-not (re-search-forward "dired" nil t)) 3355 ;; The copied file has been inserted the line before. 3356 (forward-line -1) 3357 (should 3358 (string-equal 3359 (dired-get-filename 'no-dir 'no-error) 3360 (file-name-nondirectory tmp-name3)))) 3361 (kill-buffer buffer)) 3362 3363 ;; Cleanup. 3364 (ignore-errors (kill-buffer buffer)) 3365 (ignore-errors (delete-directory tmp-name1 'recursive)))))) 3366 3367(ert-deftest tramp-test18-file-attributes () 3368 "Check `file-attributes'. 3369This tests also `access-file', `file-readable-p', 3370`file-regular-p' and `file-ownership-preserved-p'." 3371 (skip-unless (tramp--test-enabled)) 3372 3373 (dolist (quoted (if (tramp--test-expensive-test-p) '(nil t) '(nil))) 3374 ;; We must use `file-truename' for the temporary directory, 3375 ;; because it could be located on a symlinked directory. This 3376 ;; would let the test fail. 3377 (let* ((tramp-test-temporary-file-directory 3378 (file-truename tramp-test-temporary-file-directory)) 3379 (tmp-name1 (tramp--test-make-temp-name nil quoted)) 3380 (tmp-name2 (tramp--test-make-temp-name nil quoted)) 3381 ;; File name with "//". 3382 (tmp-name3 3383 (format 3384 "%s%s" 3385 (file-remote-p tmp-name1) 3386 (replace-regexp-in-string 3387 "/" "//" (file-remote-p tmp-name1 'localname)))) 3388 ;; `file-ownership-preserved-p' is implemented only in tramp-sh.el. 3389 (test-file-ownership-preserved-p (tramp--test-sh-p)) 3390 attr) 3391 (unwind-protect 3392 (progn 3393 ;; A sticky bit could damage the `file-ownership-preserved-p' test. 3394 (when 3395 (and test-file-ownership-preserved-p 3396 (zerop (logand 3397 #o1000 3398 (file-modes tramp-test-temporary-file-directory)))) 3399 (write-region "foo" nil tmp-name1) 3400 (setq test-file-ownership-preserved-p 3401 (= (file-attribute-group-id (file-attributes tmp-name1)) 3402 (tramp-get-remote-gid tramp-test-vec 'integer))) 3403 (delete-file tmp-name1)) 3404 3405 (when (tramp--test-supports-set-file-modes-p) 3406 (write-region "foo" nil tmp-name1) 3407 ;; A file is always accessible for user "root". 3408 (unless 3409 (zerop (file-attribute-user-id (file-attributes tmp-name1))) 3410 (set-file-modes tmp-name1 0) 3411 (should-error 3412 (access-file tmp-name1 "error") 3413 :type tramp-permission-denied) 3414 (set-file-modes tmp-name1 #o777)) 3415 (delete-file tmp-name1)) 3416 (should-error 3417 (access-file tmp-name1 "error") 3418 :type 'file-missing) 3419 3420 ;; `file-ownership-preserved-p' should return t for 3421 ;; non-existing files. 3422 (when test-file-ownership-preserved-p 3423 (should (file-ownership-preserved-p tmp-name1 'group))) 3424 (write-region "foo" nil tmp-name1) 3425 (should (file-exists-p tmp-name1)) 3426 (should (file-readable-p tmp-name1)) 3427 (should (file-regular-p tmp-name1)) 3428 (should-not (access-file tmp-name1 "error")) 3429 (when test-file-ownership-preserved-p 3430 (should (file-ownership-preserved-p tmp-name1 'group))) 3431 3432 ;; We do not test inodes and device numbers. 3433 (setq attr (file-attributes tmp-name1)) 3434 (should (consp attr)) 3435 (should (null (file-attribute-type attr))) 3436 (should (numberp (file-attribute-link-number attr))) 3437 (should (numberp (file-attribute-user-id attr))) 3438 (should (numberp (file-attribute-group-id attr))) 3439 (should 3440 (stringp (current-time-string (file-attribute-access-time attr)))) 3441 (should 3442 (stringp 3443 (current-time-string (file-attribute-modification-time attr)))) 3444 (should 3445 (stringp 3446 (current-time-string (file-attribute-status-change-time attr)))) 3447 (should (numberp (file-attribute-size attr))) 3448 (should (stringp (file-attribute-modes attr))) 3449 3450 (setq attr (file-attributes tmp-name1 'string)) 3451 (should (stringp (file-attribute-user-id attr))) 3452 (should (stringp (file-attribute-group-id attr))) 3453 3454 (tramp--test-ignore-make-symbolic-link-error 3455 (should-error 3456 (access-file tmp-name2 "error") 3457 :type 'file-missing) 3458 (when test-file-ownership-preserved-p 3459 (should (file-ownership-preserved-p tmp-name2 'group))) 3460 (make-symbolic-link tmp-name1 tmp-name2) 3461 (should (file-exists-p tmp-name2)) 3462 (should (file-symlink-p tmp-name2)) 3463 (should-not (access-file tmp-name2 "error")) 3464 (when test-file-ownership-preserved-p 3465 (should (file-ownership-preserved-p tmp-name2 'group))) 3466 (setq attr (file-attributes tmp-name2)) 3467 (should 3468 (string-equal 3469 (funcall 3470 (if quoted #'tramp-compat-file-name-quote #'identity) 3471 (file-attribute-type attr)) 3472 (file-remote-p (file-truename tmp-name1) 'localname))) 3473 (delete-file tmp-name2)) 3474 3475 ;; Check, that "//" in symlinks are handled properly. 3476 (with-temp-buffer 3477 (let ((default-directory tramp-test-temporary-file-directory)) 3478 (shell-command 3479 (format 3480 "ln -s %s %s" 3481 (tramp-file-name-localname 3482 (tramp-dissect-file-name tmp-name3)) 3483 (tramp-file-name-localname 3484 (tramp-dissect-file-name tmp-name2))) 3485 t))) 3486 (when (file-symlink-p tmp-name2) 3487 (setq attr (file-attributes tmp-name2)) 3488 (should 3489 (string-equal 3490 (file-attribute-type attr) 3491 (tramp-file-name-localname 3492 (tramp-dissect-file-name tmp-name3)))) 3493 (delete-file tmp-name2)) 3494 3495 (when test-file-ownership-preserved-p 3496 (should (file-ownership-preserved-p tmp-name1 'group))) 3497 (delete-file tmp-name1) 3498 (make-directory tmp-name1) 3499 (should (file-exists-p tmp-name1)) 3500 (should (file-readable-p tmp-name1)) 3501 (should-not (file-regular-p tmp-name1)) 3502 (should-not (access-file tmp-name1 "")) 3503 (when test-file-ownership-preserved-p 3504 (should (file-ownership-preserved-p tmp-name1 'group))) 3505 (setq attr (file-attributes tmp-name1)) 3506 (should (eq (file-attribute-type attr) t))) 3507 3508 ;; Cleanup. 3509 (ignore-errors (delete-directory tmp-name1)) 3510 (ignore-errors (delete-file tmp-name1)) 3511 (ignore-errors (delete-file tmp-name2)))))) 3512 3513(defvar tramp--test-start-time nil 3514 "Keep the start time of the current test, a float number.") 3515 3516(defsubst tramp--test-file-attributes-equal-p (attr1 attr2) 3517 "Check, whether file attributes ATTR1 and ATTR2 are equal. 3518They might differ only in time attributes or directory size." 3519 (let ((attr1 (copy-sequence attr1)) 3520 (attr2 (copy-sequence attr2)) 3521 (start-time (- tramp--test-start-time 10))) 3522 ;; Link number. For directories, it includes the number of 3523 ;; subdirectories. Set it to 1. 3524 (when (eq (file-attribute-type attr1) t) 3525 (setcar (nthcdr 1 attr1) 1)) 3526 (when (eq (file-attribute-type attr2) t) 3527 (setcar (nthcdr 1 attr2) 1)) 3528 ;; Access time. 3529 (setcar (nthcdr 4 attr1) tramp-time-dont-know) 3530 (setcar (nthcdr 4 attr2) tramp-time-dont-know) 3531 ;; Modification time. If any of the time values is "don't know", 3532 ;; we cannot compare, and we normalize the time stamps. If the 3533 ;; time value is newer than the test start time, normalize it, 3534 ;; because due to caching the time stamps could differ slightly (a 3535 ;; few seconds). We use a test start time minus 10 seconds, in 3536 ;; order to compensate a possible timestamp resolution higher than 3537 ;; a second on the remote machine. 3538 (when (or (tramp-compat-time-equal-p 3539 (file-attribute-modification-time attr1) tramp-time-dont-know) 3540 (tramp-compat-time-equal-p 3541 (file-attribute-modification-time attr2) tramp-time-dont-know)) 3542 (setcar (nthcdr 5 attr1) tramp-time-dont-know) 3543 (setcar (nthcdr 5 attr2) tramp-time-dont-know)) 3544 (when (< start-time 3545 (float-time (file-attribute-modification-time attr1))) 3546 (setcar (nthcdr 5 attr1) tramp-time-dont-know)) 3547 (when (< start-time 3548 (float-time (file-attribute-modification-time attr2))) 3549 (setcar (nthcdr 5 attr2) tramp-time-dont-know)) 3550 ;; Status change time. Ditto. 3551 (when (or (tramp-compat-time-equal-p 3552 (file-attribute-status-change-time attr1) tramp-time-dont-know) 3553 (tramp-compat-time-equal-p 3554 (file-attribute-status-change-time attr2) tramp-time-dont-know)) 3555 (setcar (nthcdr 6 attr1) tramp-time-dont-know) 3556 (setcar (nthcdr 6 attr2) tramp-time-dont-know)) 3557 (when (< start-time (float-time (file-attribute-status-change-time attr1))) 3558 (setcar (nthcdr 6 attr1) tramp-time-dont-know)) 3559 (when (< start-time (float-time (file-attribute-status-change-time attr2))) 3560 (setcar (nthcdr 6 attr2) tramp-time-dont-know)) 3561 ;; Size. Set it to 0 for directories, because it might have 3562 ;; changed. For example the upper directory "../". 3563 (when (eq (file-attribute-type attr1) t) 3564 (setcar (nthcdr 7 attr1) 0)) 3565 (when (eq (file-attribute-type attr2) t) 3566 (setcar (nthcdr 7 attr2) 0)) 3567 ;; The check. 3568 (unless (equal attr1 attr2) (tramp--test-message "%S\n%S" attr1 attr2)) 3569 (equal attr1 attr2))) 3570 3571;; This isn't 100% correct, but better than no explainer at all. 3572(put #'tramp--test-file-attributes-equal-p 'ert-explainer #'ert--explain-equal) 3573 3574(ert-deftest tramp-test19-directory-files-and-attributes () 3575 "Check `directory-files-and-attributes'." 3576 (skip-unless (tramp--test-enabled)) 3577 3578 (dolist (quoted (if (tramp--test-expensive-test-p) '(nil t) '(nil))) 3579 ;; `directory-files-and-attributes' contains also values for 3580 ;; "../". Ensure that this doesn't change during tests, for 3581 ;; example due to handling temporary files. 3582 (let* ((tmp-name1 (tramp--test-make-temp-name nil quoted)) 3583 (tmp-name2 (expand-file-name "bla" tmp-name1)) 3584 attr) 3585 (unwind-protect 3586 (progn 3587 (should-error 3588 (directory-files-and-attributes tmp-name1) 3589 :type 'file-missing) 3590 (make-directory tmp-name1) 3591 (should (file-directory-p tmp-name1)) 3592 (setq tramp--test-start-time 3593 (float-time 3594 (file-attribute-modification-time 3595 (file-attributes tmp-name1)))) 3596 (make-directory tmp-name2) 3597 (should (file-directory-p tmp-name2)) 3598 (write-region "foo" nil (expand-file-name "foo" tmp-name2)) 3599 (write-region "bar" nil (expand-file-name "bar" tmp-name2)) 3600 (write-region "boz" nil (expand-file-name "boz" tmp-name2)) 3601 3602 (setq attr (directory-files-and-attributes tmp-name2)) 3603 (should (consp attr)) 3604 (dolist (elt attr) 3605 (should 3606 (tramp--test-file-attributes-equal-p 3607 (file-attributes (expand-file-name (car elt) tmp-name2)) 3608 (cdr elt)))) 3609 3610 (setq attr (directory-files-and-attributes tmp-name2 'full)) 3611 (should (consp attr)) 3612 (dolist (elt attr) 3613 (should 3614 (tramp--test-file-attributes-equal-p 3615 (file-attributes (car elt)) (cdr elt)))) 3616 3617 (setq attr (directory-files-and-attributes tmp-name2 nil "\\`b")) 3618 (should (equal (mapcar #'car attr) '("bar" "boz"))) 3619 3620 ;; Check the COUNT arg. It exists since Emacs 28. 3621 (when (tramp--test-emacs28-p) 3622 (with-no-warnings 3623 (setq attr (directory-files-and-attributes 3624 tmp-name2 nil "\\`b" nil nil 1)) 3625 (should (equal (mapcar #'car attr) '("bar")))))) 3626 3627 ;; Cleanup. 3628 (ignore-errors (delete-directory tmp-name1 'recursive)))))) 3629 3630(ert-deftest tramp-test20-file-modes () 3631 "Check `file-modes'. 3632This tests also `file-executable-p', `file-writable-p' and `set-file-modes'." 3633 (skip-unless (tramp--test-enabled)) 3634 (skip-unless (tramp--test-supports-set-file-modes-p)) 3635 3636 (dolist (quoted (if (tramp--test-expensive-test-p) '(nil t) '(nil))) 3637 (let ((tmp-name1 (tramp--test-make-temp-name nil quoted)) 3638 (tmp-name2 (tramp--test-make-temp-name nil quoted))) 3639 3640 (unwind-protect 3641 (progn 3642 (write-region "foo" nil tmp-name1) 3643 (should (file-exists-p tmp-name1)) 3644 (set-file-modes tmp-name1 #o777) 3645 (should (= (file-modes tmp-name1) #o777)) 3646 (should (file-executable-p tmp-name1)) 3647 (should (file-writable-p tmp-name1)) 3648 (set-file-modes tmp-name1 #o444) 3649 (should (= (file-modes tmp-name1) #o444)) 3650 (should-not (file-executable-p tmp-name1)) 3651 ;; A file is always writable for user "root". 3652 (unless (zerop (file-attribute-user-id (file-attributes tmp-name1))) 3653 (should-not (file-writable-p tmp-name1))) 3654 ;; Check the NOFOLLOW arg. It exists since Emacs 28. For 3655 ;; regular files, there shouldn't be a difference. 3656 (when (tramp--test-emacs28-p) 3657 (with-no-warnings 3658 (set-file-modes tmp-name1 #o222 'nofollow) 3659 (should (= (file-modes tmp-name1 'nofollow) #o222))))) 3660 3661 ;; Cleanup. 3662 (ignore-errors (delete-file tmp-name1))) 3663 3664 ;; Check the NOFOLLOW arg. It exists since Emacs 28. It is 3665 ;; implemented for tramp-gvfs.el and tramp-sh.el. However, 3666 ;; tramp-gvfs,el does not support creating symbolic links. And 3667 ;; in tramp-sh.el, we must ensure that the remote chmod command 3668 ;; supports the "-h" argument. 3669 (when (and (tramp--test-emacs28-p) (tramp--test-sh-p) 3670 (tramp-get-remote-chmod-h tramp-test-vec)) 3671 (unwind-protect 3672 (with-no-warnings 3673 (write-region "foo" nil tmp-name1) 3674 (should (file-exists-p tmp-name1)) 3675 (make-symbolic-link tmp-name1 tmp-name2) 3676 (should 3677 (string-equal 3678 (funcall 3679 (if quoted #'tramp-compat-file-name-unquote #'identity) 3680 (file-remote-p tmp-name1 'localname)) 3681 (file-symlink-p tmp-name2))) 3682 ;; Both report the modes of `tmp-name1'. 3683 (should 3684 (= (file-modes tmp-name1) (file-modes tmp-name2))) 3685 ;; `tmp-name1' is a regular file. NOFOLLOW doesn't matter. 3686 (should 3687 (= (file-modes tmp-name1) (file-modes tmp-name1 'nofollow))) 3688 ;; `tmp-name2' is a symbolic link. It has different permissions. 3689 (should-not 3690 (= (file-modes tmp-name2) (file-modes tmp-name2 'nofollow))) 3691 (should-not 3692 (= (file-modes tmp-name1 'nofollow) 3693 (file-modes tmp-name2 'nofollow))) 3694 ;; Change permissions. 3695 (set-file-modes tmp-name1 #o200) 3696 (set-file-modes tmp-name2 #o200) 3697 (should 3698 (= (file-modes tmp-name1) (file-modes tmp-name2) #o200)) 3699 ;; Change permissions with NOFOLLOW. 3700 (set-file-modes tmp-name1 #o300 'nofollow) 3701 (set-file-modes tmp-name2 #o300 'nofollow) 3702 (should 3703 (= (file-modes tmp-name1 'nofollow) 3704 (file-modes tmp-name2 'nofollow))) 3705 (should-not (= (file-modes tmp-name1) (file-modes tmp-name2)))) 3706 3707 ;; Cleanup. 3708 (ignore-errors (delete-file tmp-name1)) 3709 (ignore-errors (delete-file tmp-name2))))))) 3710 3711;; Method "smb" could run into "NT_STATUS_REVISION_MISMATCH" error. 3712(defmacro tramp--test-ignore-add-name-to-file-error (&rest body) 3713 "Run BODY, ignoring \"error with add-name-to-file\" file error." 3714 (declare (indent defun) (debug (body))) 3715 `(condition-case err 3716 (progn ,@body) 3717 (file-error 3718 (unless (string-match-p "^error with add-name-to-file" 3719 (error-message-string err)) 3720 (signal (car err) (cdr err)))))) 3721 3722(ert-deftest tramp-test21-file-links () 3723 "Check `file-symlink-p'. 3724This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." 3725 (skip-unless (tramp--test-enabled)) 3726 3727 (dolist (quoted (if (tramp--test-expensive-test-p) '(nil t) '(nil))) 3728 ;; We must use `file-truename' for the temporary directory, 3729 ;; because it could be located on a symlinked directory. This 3730 ;; would let the test fail. 3731 (let* ((tramp-test-temporary-file-directory 3732 (file-truename tramp-test-temporary-file-directory)) 3733 (tmp-name1 (tramp--test-make-temp-name nil quoted)) 3734 (tmp-name2 (tramp--test-make-temp-name nil quoted)) 3735 (tmp-name3 (tramp--test-make-temp-name 'local quoted)) 3736 (tmp-name4 (tramp--test-make-temp-name nil quoted)) 3737 (tmp-name5 3738 (expand-file-name (file-name-nondirectory tmp-name1) tmp-name4)) 3739 (tmp-name6 (tramp--test-make-temp-name nil quoted))) 3740 ;; Check `make-symbolic-link'. 3741 (unwind-protect 3742 (tramp--test-ignore-make-symbolic-link-error 3743 (write-region "foo" nil tmp-name1) 3744 (should (file-exists-p tmp-name1)) 3745 (make-symbolic-link tmp-name1 tmp-name2) 3746 (should 3747 (string-equal 3748 (funcall 3749 (if quoted #'tramp-compat-file-name-unquote #'identity) 3750 (file-remote-p tmp-name1 'localname)) 3751 (file-symlink-p tmp-name2))) 3752 (when (tramp--test-expensive-test-p) 3753 (should-error 3754 (make-symbolic-link tmp-name1 tmp-name2) 3755 :type 'file-already-exists)) 3756 (when (tramp--test-expensive-test-p) 3757 ;; A number means interactive case. 3758 (cl-letf (((symbol-function #'yes-or-no-p) #'ignore)) 3759 (should-error 3760 (make-symbolic-link tmp-name1 tmp-name2 0) 3761 :type 'file-already-exists))) 3762 (cl-letf (((symbol-function #'yes-or-no-p) #'tramp--test-always)) 3763 (make-symbolic-link tmp-name1 tmp-name2 0) 3764 (should 3765 (string-equal 3766 (funcall 3767 (if quoted #'tramp-compat-file-name-unquote #'identity) 3768 (file-remote-p tmp-name1 'localname)) 3769 (file-symlink-p tmp-name2)))) 3770 (make-symbolic-link tmp-name1 tmp-name2 'ok-if-already-exists) 3771 (should 3772 (string-equal 3773 (funcall 3774 (if quoted #'tramp-compat-file-name-unquote #'identity) 3775 (file-remote-p tmp-name1 'localname)) 3776 (file-symlink-p tmp-name2))) 3777 ;; If we use the local part of `tmp-name1', it shall still work. 3778 (make-symbolic-link 3779 (file-remote-p tmp-name1 'localname) 3780 tmp-name2 'ok-if-already-exists) 3781 (should 3782 (string-equal 3783 (funcall 3784 (if quoted #'tramp-compat-file-name-unquote #'identity) 3785 (file-remote-p tmp-name1 'localname)) 3786 (file-symlink-p tmp-name2))) 3787 ;; `tmp-name3' is a local file name. Therefore, the link 3788 ;; target remains unchanged, even if quoted. 3789 ;; `make-symbolic-link' might not be permitted on w32 systems. 3790 (unless (tramp--test-windows-nt-p) 3791 (make-symbolic-link tmp-name1 tmp-name3) 3792 (should 3793 (string-equal tmp-name1 (file-symlink-p tmp-name3)))) 3794 ;; Check directory as newname. 3795 (make-directory tmp-name4) 3796 (when (tramp--test-expensive-test-p) 3797 (should-error 3798 (make-symbolic-link tmp-name1 tmp-name4) 3799 :type 'file-already-exists)) 3800 (make-symbolic-link tmp-name1 (file-name-as-directory tmp-name4)) 3801 (should 3802 (string-equal 3803 (funcall 3804 (if quoted #'tramp-compat-file-name-unquote #'identity) 3805 (file-remote-p tmp-name1 'localname)) 3806 (file-symlink-p tmp-name5))) 3807 ;; Check, that files in symlinked directories still work. 3808 (make-symbolic-link tmp-name4 tmp-name6) 3809 (write-region "foo" nil (expand-file-name "foo" tmp-name6)) 3810 (delete-file (expand-file-name "foo" tmp-name6)) 3811 (should-not (file-exists-p (expand-file-name "foo" tmp-name4))) 3812 (should-not (file-exists-p (expand-file-name "foo" tmp-name6)))) 3813 3814 ;; Cleanup. 3815 (ignore-errors (delete-file tmp-name1)) 3816 (ignore-errors (delete-file tmp-name2)) 3817 (ignore-errors (delete-file tmp-name3)) 3818 (ignore-errors (delete-file tmp-name5)) 3819 (ignore-errors (delete-file tmp-name6)) 3820 (ignore-errors (delete-directory tmp-name4 'recursive))) 3821 3822 ;; Check `add-name-to-file'. 3823 (unwind-protect 3824 (when (tramp--test-expensive-test-p) 3825 (tramp--test-ignore-add-name-to-file-error 3826 (write-region "foo" nil tmp-name1) 3827 (should (file-exists-p tmp-name1)) 3828 (add-name-to-file tmp-name1 tmp-name2) 3829 (should (file-regular-p tmp-name2)) 3830 (should-error 3831 (add-name-to-file tmp-name1 tmp-name2) 3832 :type 'file-already-exists) 3833 ;; A number means interactive case. 3834 (cl-letf (((symbol-function #'yes-or-no-p) #'ignore)) 3835 (should-error 3836 (add-name-to-file tmp-name1 tmp-name2 0) 3837 :type 'file-already-exists)) 3838 (cl-letf (((symbol-function #'yes-or-no-p) #'tramp--test-always)) 3839 (add-name-to-file tmp-name1 tmp-name2 0) 3840 (should (file-regular-p tmp-name2))) 3841 (add-name-to-file tmp-name1 tmp-name2 'ok-if-already-exists) 3842 (should-not (file-symlink-p tmp-name2)) 3843 (should (file-regular-p tmp-name2)) 3844 ;; `tmp-name3' is a local file name. 3845 (should-error 3846 (add-name-to-file tmp-name1 tmp-name3) 3847 :type 'file-error) 3848 ;; Check directory as newname. 3849 (make-directory tmp-name4) 3850 (should-error 3851 (add-name-to-file tmp-name1 tmp-name4) 3852 :type 'file-already-exists) 3853 (add-name-to-file tmp-name1 (file-name-as-directory tmp-name4)) 3854 (should 3855 (file-regular-p 3856 (expand-file-name 3857 (file-name-nondirectory tmp-name1) tmp-name4))))) 3858 3859 ;; Cleanup. 3860 (ignore-errors 3861 (delete-file tmp-name1) 3862 (delete-file tmp-name2) 3863 (delete-directory tmp-name4 'recursive))) 3864 3865 ;; Check `file-truename'. 3866 (unwind-protect 3867 (tramp--test-ignore-make-symbolic-link-error 3868 (write-region "foo" nil tmp-name1) 3869 (should (file-exists-p tmp-name1)) 3870 (should (string-equal tmp-name1 (file-truename tmp-name1))) 3871 (make-symbolic-link tmp-name1 tmp-name2) 3872 (should (file-symlink-p tmp-name2)) 3873 (should-not (string-equal tmp-name2 (file-truename tmp-name2))) 3874 (should 3875 (string-equal (file-truename tmp-name1) (file-truename tmp-name2))) 3876 (should (file-equal-p tmp-name1 tmp-name2)) 3877 ;; Check relative symlink file name. 3878 (delete-file tmp-name2) 3879 (let ((default-directory tramp-test-temporary-file-directory)) 3880 (make-symbolic-link (file-name-nondirectory tmp-name1) tmp-name2)) 3881 (should (file-symlink-p tmp-name2)) 3882 (should-not (string-equal tmp-name2 (file-truename tmp-name2))) 3883 (should 3884 (string-equal (file-truename tmp-name1) (file-truename tmp-name2))) 3885 (should (file-equal-p tmp-name1 tmp-name2)) 3886 ;; Symbolic links could look like a remote file name. 3887 ;; They must be quoted then. 3888 (let ((penguin 3889 (if (eq tramp-syntax 'separate) 3890 "/[penguin/motd]" "/penguin:motd:"))) 3891 (delete-file tmp-name2) 3892 (make-symbolic-link 3893 (funcall 3894 (if quoted #'tramp-compat-file-name-unquote #'identity) penguin) 3895 tmp-name2) 3896 (should (file-symlink-p tmp-name2)) 3897 (should 3898 (string-equal 3899 (file-truename tmp-name2) 3900 (tramp-compat-file-name-quote 3901 (concat (file-remote-p tmp-name2) penguin))))) 3902 ;; `tmp-name3' is a local file name. 3903 ;; `make-symbolic-link' might not be permitted on w32 systems. 3904 (unless (tramp--test-windows-nt-p) 3905 (make-symbolic-link tmp-name1 tmp-name3) 3906 (should (file-symlink-p tmp-name3)) 3907 (should-not (string-equal tmp-name3 (file-truename tmp-name3))) 3908 ;; `file-truename' returns a quoted file name for `tmp-name3'. 3909 ;; We must unquote it. 3910 (should 3911 (string-equal 3912 (file-truename tmp-name1) 3913 (tramp-compat-file-name-unquote (file-truename tmp-name3)))))) 3914 3915 ;; Cleanup. 3916 (ignore-errors 3917 (delete-file tmp-name1) 3918 (delete-file tmp-name2) 3919 (delete-file tmp-name3))) 3920 3921 ;; Symbolic links could be nested. 3922 (unwind-protect 3923 (tramp--test-ignore-make-symbolic-link-error 3924 (make-directory tmp-name1) 3925 (should (file-directory-p tmp-name1)) 3926 (let* ((tramp-test-temporary-file-directory 3927 (file-truename tmp-name1)) 3928 (tmp-name2 (tramp--test-make-temp-name nil quoted)) 3929 (tmp-name3 tmp-name2) 3930 (number-nesting 15)) 3931 (dotimes (_ number-nesting) 3932 (make-symbolic-link 3933 tmp-name3 3934 (setq tmp-name3 (tramp--test-make-temp-name nil quoted)))) 3935 (should 3936 (string-equal 3937 (file-truename tmp-name2) 3938 (file-truename tmp-name3))) 3939 (when (tramp--test-expensive-test-p) 3940 (should-error 3941 (with-temp-buffer (insert-file-contents tmp-name2)) 3942 :type 'file-missing)) 3943 (when (tramp--test-expensive-test-p) 3944 (should-error 3945 (with-temp-buffer (insert-file-contents tmp-name3)) 3946 :type 'file-missing)) 3947 ;; `directory-files' does not show symlinks to 3948 ;; non-existing targets in the "smb" case. So we remove 3949 ;; the symlinks manually. 3950 (while (stringp (setq tmp-name2 (file-symlink-p tmp-name3))) 3951 (delete-file tmp-name3) 3952 (setq tmp-name3 (concat (file-remote-p tmp-name3) tmp-name2))))) 3953 3954 ;; Cleanup. 3955 (ignore-errors 3956 (delete-file tmp-name3) 3957 (delete-directory tmp-name1 'recursive))) 3958 3959 ;; Detect cyclic symbolic links. 3960 (unwind-protect 3961 (when (tramp--test-expensive-test-p) 3962 (tramp--test-ignore-make-symbolic-link-error 3963 (make-symbolic-link tmp-name2 tmp-name1) 3964 (should (file-symlink-p tmp-name1)) 3965 (if (tramp--test-smb-p) 3966 ;; The symlink command of "smbclient" detects the 3967 ;; cycle already. 3968 (should-error 3969 (make-symbolic-link tmp-name1 tmp-name2) 3970 :type 'file-error) 3971 (make-symbolic-link tmp-name1 tmp-name2) 3972 (should (file-symlink-p tmp-name2)) 3973 (should-error 3974 (file-truename tmp-name1) 3975 :type 'file-error)))) 3976 3977 ;; Cleanup. 3978 (ignore-errors 3979 (delete-file tmp-name1) 3980 (delete-file tmp-name2))) 3981 3982 ;; `file-truename' shall preserve trailing slash of directories. 3983 (let* ((dir1 3984 (directory-file-name 3985 (funcall 3986 (if quoted #'tramp-compat-file-name-quote #'identity) 3987 tramp-test-temporary-file-directory))) 3988 (dir2 (file-name-as-directory dir1))) 3989 (should (string-equal (file-truename dir1) (expand-file-name dir1))) 3990 (should (string-equal (file-truename dir2) (expand-file-name dir2))))))) 3991 3992(ert-deftest tramp-test22-file-times () 3993 "Check `set-file-times' and `file-newer-than-file-p'." 3994 (skip-unless (tramp--test-enabled)) 3995 (skip-unless 3996 (or (tramp--test-adb-p) (tramp--test-gvfs-p) 3997 (tramp--test-sh-p) (tramp--test-sudoedit-p))) 3998 3999 (dolist (quoted (if (tramp--test-expensive-test-p) '(nil t) '(nil))) 4000 (let ((tmp-name1 (tramp--test-make-temp-name nil quoted)) 4001 (tmp-name2 (tramp--test-make-temp-name nil quoted)) 4002 (tmp-name3 (tramp--test-make-temp-name nil quoted))) 4003 (unwind-protect 4004 (progn 4005 (write-region "foo" nil tmp-name1) 4006 (should (file-exists-p tmp-name1)) 4007 (should (consp (file-attribute-modification-time 4008 (file-attributes tmp-name1)))) 4009 ;; Skip the test, if the remote handler is not able to set 4010 ;; the correct time. 4011 (skip-unless (set-file-times tmp-name1 (seconds-to-time 1))) 4012 ;; Dumb remote shells without perl(1) or stat(1) are not 4013 ;; able to return the date correctly. They say "don't know". 4014 (unless (tramp-compat-time-equal-p 4015 (file-attribute-modification-time 4016 (file-attributes tmp-name1)) 4017 tramp-time-dont-know) 4018 (should 4019 (tramp-compat-time-equal-p 4020 (file-attribute-modification-time (file-attributes tmp-name1)) 4021 (seconds-to-time 1))) 4022 (write-region "bla" nil tmp-name2) 4023 (should (file-exists-p tmp-name2)) 4024 (should (file-newer-than-file-p tmp-name2 tmp-name1)) 4025 ;; `tmp-name3' does not exist. 4026 (should (file-newer-than-file-p tmp-name2 tmp-name3)) 4027 (should-not (file-newer-than-file-p tmp-name3 tmp-name1)) 4028 ;; Check the NOFOLLOW arg. It exists since Emacs 28. For 4029 ;; regular files, there shouldn't be a difference. 4030 (when (tramp--test-emacs28-p) 4031 (with-no-warnings 4032 (set-file-times tmp-name1 (seconds-to-time 1) 'nofollow) 4033 (should 4034 (tramp-compat-time-equal-p 4035 (file-attribute-modification-time 4036 (file-attributes tmp-name1)) 4037 (seconds-to-time 1))))))) 4038 4039 ;; Cleanup. 4040 (ignore-errors 4041 (delete-file tmp-name1) 4042 (delete-file tmp-name2)))))) 4043 4044(ert-deftest tramp-test23-visited-file-modtime () 4045 "Check `set-visited-file-modtime' and `verify-visited-file-modtime'." 4046 (skip-unless (tramp--test-enabled)) 4047 4048 (dolist (quoted (if (tramp--test-expensive-test-p) '(nil t) '(nil))) 4049 (let ((tmp-name (tramp--test-make-temp-name nil quoted))) 4050 (unwind-protect 4051 (progn 4052 (write-region "foo" nil tmp-name) 4053 (should (file-exists-p tmp-name)) 4054 (with-temp-buffer 4055 (insert-file-contents tmp-name) 4056 (should (verify-visited-file-modtime)) 4057 (set-visited-file-modtime (seconds-to-time 1)) 4058 (should (verify-visited-file-modtime)) 4059 (should (= 1 (float-time (visited-file-modtime)))) 4060 4061 ;; Checks with deleted file. 4062 (delete-file tmp-name) 4063 (dired-uncache tmp-name) 4064 (should (verify-visited-file-modtime)) 4065 (set-visited-file-modtime (seconds-to-time 1)) 4066 (should (verify-visited-file-modtime)) 4067 (should (= 1 (float-time (visited-file-modtime)))))) 4068 4069 ;; Cleanup. 4070 (ignore-errors (delete-file tmp-name)))))) 4071 4072;; This test is inspired by Bug#29149. 4073(ert-deftest tramp-test24-file-acl () 4074 "Check that `file-acl' and `set-file-acl' work proper." 4075 (skip-unless (tramp--test-enabled)) 4076 ;; The following test checks also whether `set-file-modes' will work. 4077 (skip-unless (file-acl tramp-test-temporary-file-directory)) 4078 (skip-unless (not (tramp--test-crypt-p))) 4079 4080 ;; `filename-non-special' has been fixed in Emacs 27.1, see Bug#29579. 4081 (dolist (quoted 4082 (if (and (tramp--test-expensive-test-p) (tramp--test-emacs27-p)) 4083 '(nil t) '(nil))) 4084 (let ((tmp-name1 (tramp--test-make-temp-name nil quoted)) 4085 (tmp-name2 (tramp--test-make-temp-name nil quoted)) 4086 (tmp-name3 (tramp--test-make-temp-name 'local quoted))) 4087 ;; Both files are remote. 4088 (unwind-protect 4089 (progn 4090 ;; Two files with same ACLs. 4091 (write-region "foo" nil tmp-name1) 4092 (should (file-exists-p tmp-name1)) 4093 (should (file-acl tmp-name1)) 4094 (copy-file tmp-name1 tmp-name2 nil nil nil 'preserve-permissions) 4095 (should (file-acl tmp-name2)) 4096 (should (string-equal (file-acl tmp-name1) (file-acl tmp-name2))) 4097 ;; Different permissions mean different ACLs. 4098 (unless (tramp--test-windows-nt-or-smb-p) 4099 (set-file-modes tmp-name1 #o777) 4100 (set-file-modes tmp-name2 #o444) 4101 (should-not 4102 (string-equal (file-acl tmp-name1) (file-acl tmp-name2)))) 4103 ;; Copy ACL. Not all remote handlers support it, so we test. 4104 (when (set-file-acl tmp-name2 (file-acl tmp-name1)) 4105 (should (string-equal (file-acl tmp-name1) (file-acl tmp-name2)))) 4106 ;; An invalid ACL does not harm. 4107 (should-not (set-file-acl tmp-name2 "foo"))) 4108 4109 ;; Cleanup. 4110 (ignore-errors (delete-file tmp-name1)) 4111 (ignore-errors (delete-file tmp-name2))) 4112 4113 ;; Remote and local file. 4114 (unwind-protect 4115 (when (and (file-acl temporary-file-directory) 4116 (not (tramp--test-windows-nt-or-smb-p))) 4117 ;; Two files with same ACLs. 4118 (write-region "foo" nil tmp-name1) 4119 (should (file-exists-p tmp-name1)) 4120 (should (file-acl tmp-name1)) 4121 (copy-file tmp-name1 tmp-name3 nil nil nil 'preserve-permissions) 4122 (should (file-acl tmp-name3)) 4123 (should (string-equal (file-acl tmp-name1) (file-acl tmp-name3))) 4124 ;; Different permissions mean different ACLs. 4125 (set-file-modes tmp-name1 #o777) 4126 (set-file-modes tmp-name3 #o444) 4127 (should-not 4128 (string-equal (file-acl tmp-name1) (file-acl tmp-name3))) 4129 ;; Copy ACL. Since we don't know whether Emacs is built 4130 ;; with local ACL support, we must check it. 4131 (when (set-file-acl tmp-name3 (file-acl tmp-name1)) 4132 (should (string-equal (file-acl tmp-name1) (file-acl tmp-name3)))) 4133 4134 ;; Two files with same ACLs. 4135 (delete-file tmp-name1) 4136 (copy-file tmp-name3 tmp-name1 nil nil nil 'preserve-permissions) 4137 (should (file-acl tmp-name1)) 4138 (should (string-equal (file-acl tmp-name1) (file-acl tmp-name3))) 4139 ;; Different permissions mean different ACLs. 4140 (set-file-modes tmp-name1 #o777) 4141 (set-file-modes tmp-name3 #o444) 4142 (should-not 4143 (string-equal (file-acl tmp-name1) (file-acl tmp-name3))) 4144 ;; Copy ACL. 4145 (set-file-acl tmp-name1 (file-acl tmp-name3)) 4146 (should (string-equal (file-acl tmp-name1) (file-acl tmp-name3)))) 4147 4148 ;; Cleanup. 4149 (ignore-errors (delete-file tmp-name1)) 4150 (ignore-errors (delete-file tmp-name3)))))) 4151 4152(ert-deftest tramp-test25-file-selinux () 4153 "Check `file-selinux-context' and `set-file-selinux-context'." 4154 (skip-unless (tramp--test-enabled)) 4155 (skip-unless 4156 (not (equal (file-selinux-context tramp-test-temporary-file-directory) 4157 '(nil nil nil nil)))) 4158 (skip-unless (not (tramp--test-crypt-p))) 4159 4160 ;; `filename-non-special' has been fixed in Emacs 27.1, see Bug#29579. 4161 (dolist (quoted 4162 (if (and (tramp--test-expensive-test-p) (tramp--test-emacs27-p)) 4163 '(nil t) '(nil))) 4164 (let ((tmp-name1 (tramp--test-make-temp-name nil quoted)) 4165 (tmp-name2 (tramp--test-make-temp-name nil quoted)) 4166 (tmp-name3 (tramp--test-make-temp-name 'local quoted))) 4167 ;; Both files are remote. 4168 (unwind-protect 4169 (progn 4170 ;; Two files with same SELinux context. 4171 (write-region "foo" nil tmp-name1) 4172 (should (file-exists-p tmp-name1)) 4173 (should (file-selinux-context tmp-name1)) 4174 (copy-file tmp-name1 tmp-name2 nil nil nil 'preserve-permissions) 4175 (should (file-selinux-context tmp-name2)) 4176 (should 4177 (equal 4178 (file-selinux-context tmp-name1) 4179 (file-selinux-context tmp-name2))) 4180 ;; Check different SELinux context. We cannot support 4181 ;; different ranges in this test; let's assume the most 4182 ;; likely one. 4183 (let ((context (file-selinux-context tmp-name1))) 4184 (when (and (string-equal (nth 3 context) "s0") 4185 (setcar (nthcdr 3 context) "s0:c0") 4186 (set-file-selinux-context tmp-name1 context)) 4187 (should-not 4188 (equal 4189 (file-selinux-context tmp-name1) 4190 (file-selinux-context tmp-name2))))) 4191 ;; Copy SELinux context. 4192 (should 4193 (set-file-selinux-context 4194 tmp-name2 (file-selinux-context tmp-name1))) 4195 (should 4196 (equal 4197 (file-selinux-context tmp-name1) 4198 (file-selinux-context tmp-name2))) 4199 ;; An invalid SELinux context does not harm. 4200 (should-not (set-file-selinux-context tmp-name2 "foo"))) 4201 4202 ;; Cleanup. 4203 (ignore-errors (delete-file tmp-name1)) 4204 (ignore-errors (delete-file tmp-name2))) 4205 4206 ;; Remote and local file. 4207 (unwind-protect 4208 (when (and (not 4209 (or (equal (file-selinux-context temporary-file-directory) 4210 '(nil nil nil nil)) 4211 (tramp--test-windows-nt-or-smb-p))) 4212 ;; Both users shall use the same SELinux context. 4213 (string-equal 4214 (let ((default-directory temporary-file-directory)) 4215 (shell-command-to-string "id -Z")) 4216 (let ((default-directory 4217 tramp-test-temporary-file-directory)) 4218 (shell-command-to-string "id -Z")))) 4219 4220 ;; Two files with same SELinux context. 4221 (write-region "foo" nil tmp-name1) 4222 (should (file-exists-p tmp-name1)) 4223 (should (file-selinux-context tmp-name1)) 4224 (copy-file tmp-name1 tmp-name3) 4225 (should (file-selinux-context tmp-name3)) 4226 ;; We cannot expect that copying over file system 4227 ;; boundaries keeps SELinux context. So we copy it 4228 ;; explicitly. 4229 (should 4230 (set-file-selinux-context 4231 tmp-name3 (file-selinux-context tmp-name1))) 4232 (should 4233 (equal 4234 (file-selinux-context tmp-name1) 4235 (file-selinux-context tmp-name3))) 4236 ;; Check different SELinux context. We cannot support 4237 ;; different ranges in this test; let's assume the most 4238 ;; likely one. 4239 (let ((context (file-selinux-context tmp-name1))) 4240 (when (and (string-equal (nth 3 context) "s0") 4241 (setcar (nthcdr 3 context) "s0:c0") 4242 (set-file-selinux-context tmp-name1 context)) 4243 (should-not 4244 (equal 4245 (file-selinux-context tmp-name1) 4246 (file-selinux-context tmp-name3))))) 4247 ;; Copy SELinux context. 4248 (should 4249 (set-file-selinux-context 4250 tmp-name3 (file-selinux-context tmp-name1))) 4251 (should 4252 (equal 4253 (file-selinux-context tmp-name1) 4254 (file-selinux-context tmp-name3))) 4255 4256 ;; Two files with same SELinux context. 4257 (delete-file tmp-name1) 4258 (copy-file tmp-name3 tmp-name1) 4259 (should (file-selinux-context tmp-name1)) 4260 ;; We cannot expect that copying over file system 4261 ;; boundaries keeps SELinux context. So we copy it 4262 ;; explicitly. 4263 (should 4264 (set-file-selinux-context 4265 tmp-name1 (file-selinux-context tmp-name3))) 4266 (should 4267 (equal 4268 (file-selinux-context tmp-name1) 4269 (file-selinux-context tmp-name3))) 4270 ;; Check different SELinux context. We cannot support 4271 ;; different ranges in this test; let's assume the most 4272 ;; likely one. 4273 (let ((context (file-selinux-context tmp-name3))) 4274 (when (and (string-equal (nth 3 context) "s0") 4275 (setcar (nthcdr 3 context) "s0:c0") 4276 (set-file-selinux-context tmp-name3 context)) 4277 (should-not 4278 (equal 4279 (file-selinux-context tmp-name1) 4280 (file-selinux-context tmp-name3))))) 4281 ;; Copy SELinux context. 4282 (should 4283 (set-file-selinux-context 4284 tmp-name1 (file-selinux-context tmp-name3))) 4285 (should 4286 (equal 4287 (file-selinux-context tmp-name1) 4288 (file-selinux-context tmp-name3)))) 4289 4290 ;; Cleanup. 4291 (ignore-errors (delete-file tmp-name1)) 4292 (ignore-errors (delete-file tmp-name3)))))) 4293 4294(ert-deftest tramp-test26-file-name-completion () 4295 "Check `file-name-completion' and `file-name-all-completions'." 4296 (skip-unless (tramp--test-enabled)) 4297 4298 ;; Method and host name in completion mode. This kind of completion 4299 ;; does not work on MS Windows. 4300 (unless (memq system-type '(cygwin windows-nt)) 4301 (let ((method (file-remote-p tramp-test-temporary-file-directory 'method)) 4302 (host (file-remote-p tramp-test-temporary-file-directory 'host)) 4303 (orig-syntax tramp-syntax)) 4304 (when (and (stringp host) (string-match tramp-host-with-port-regexp host)) 4305 (setq host (match-string 1 host))) 4306 4307 (unwind-protect 4308 (dolist 4309 (syntax 4310 (if (tramp--test-expensive-test-p) 4311 (tramp-syntax-values) `(,orig-syntax))) 4312 (tramp-change-syntax syntax) 4313 ;; This has cleaned up all connection data, which are used 4314 ;; for completion. We must refill the cache. 4315 (tramp-set-connection-property tramp-test-vec "property" nil) 4316 4317 (let ;; This is needed for the `separate' syntax. 4318 ((prefix-format (substring tramp-prefix-format 1)) 4319 ;; This is needed for the IPv6 host name syntax. 4320 (ipv6-prefix 4321 (and (string-match-p tramp-ipv6-regexp host) 4322 tramp-prefix-ipv6-format)) 4323 (ipv6-postfix 4324 (and (string-match-p tramp-ipv6-regexp host) 4325 tramp-postfix-ipv6-format))) 4326 ;; Complete method name. 4327 (unless (or (zerop (length method)) 4328 (zerop (length tramp-method-regexp))) 4329 (should 4330 (member 4331 (concat prefix-format method tramp-postfix-method-format) 4332 (file-name-all-completions 4333 (concat prefix-format (substring method 0 1)) "/")))) 4334 ;; Complete host name. 4335 (unless (or (zerop (length method)) 4336 (zerop (length tramp-method-regexp)) 4337 (zerop (length host)) 4338 (tramp--test-gvfs-p method)) 4339 (should 4340 (member 4341 (concat 4342 prefix-format method tramp-postfix-method-format 4343 ipv6-prefix host ipv6-postfix tramp-postfix-host-format) 4344 (file-name-all-completions 4345 (concat prefix-format method tramp-postfix-method-format) 4346 "/")))))) 4347 4348 ;; Cleanup. 4349 (tramp-change-syntax orig-syntax)))) 4350 4351 (dolist (non-essential '(nil t)) 4352 (dolist (quoted (if (tramp--test-expensive-test-p) '(nil t) '(nil))) 4353 (let ((tmp-name (tramp--test-make-temp-name nil quoted))) 4354 4355 (unwind-protect 4356 (progn 4357 ;; Local files. 4358 (make-directory tmp-name) 4359 (should (file-directory-p tmp-name)) 4360 (write-region "foo" nil (expand-file-name "foo" tmp-name)) 4361 (should (file-exists-p (expand-file-name "foo" tmp-name))) 4362 (write-region "bar" nil (expand-file-name "bold" tmp-name)) 4363 (should (file-exists-p (expand-file-name "bold" tmp-name))) 4364 (make-directory (expand-file-name "boz" tmp-name)) 4365 (should (file-directory-p (expand-file-name "boz" tmp-name))) 4366 (should (equal (file-name-completion "fo" tmp-name) "foo")) 4367 (should (equal (file-name-completion "foo" tmp-name) t)) 4368 (should (equal (file-name-completion "b" tmp-name) "bo")) 4369 (should-not (file-name-completion "a" tmp-name)) 4370 ;; Ange-FTP does not support predicates. 4371 (unless (tramp--test-ange-ftp-p) 4372 (should 4373 (equal 4374 (file-name-completion "b" tmp-name #'file-directory-p) 4375 "boz/"))) 4376 (should 4377 (equal (file-name-all-completions "fo" tmp-name) '("foo"))) 4378 (should 4379 (equal 4380 (sort (file-name-all-completions "b" tmp-name) #'string-lessp) 4381 '("bold" "boz/"))) 4382 (should-not (file-name-all-completions "a" tmp-name)) 4383 ;; `completion-regexp-list' restricts the completion to 4384 ;; files which match all expressions in this list. 4385 ;; Ange-FTP does not complete "". 4386 (unless (tramp--test-ange-ftp-p) 4387 (let ((completion-regexp-list 4388 `(,directory-files-no-dot-files-regexp "b"))) 4389 (should 4390 (equal (file-name-completion "" tmp-name) "bo")) 4391 (should 4392 (equal 4393 (sort 4394 (file-name-all-completions "" tmp-name) #'string-lessp) 4395 '("bold" "boz/"))))) 4396 ;; `file-name-completion' ignores file names that end in 4397 ;; any string in `completion-ignored-extensions'. 4398 (let ((completion-ignored-extensions '(".ext"))) 4399 (write-region "foo" nil (expand-file-name "foo.ext" tmp-name)) 4400 (should (file-exists-p (expand-file-name "foo.ext" tmp-name))) 4401 (should (equal (file-name-completion "fo" tmp-name) "foo")) 4402 (should (equal (file-name-completion "foo" tmp-name) t)) 4403 (should 4404 (equal (file-name-completion "foo." tmp-name) "foo.ext")) 4405 (should (equal (file-name-completion "foo.ext" tmp-name) t)) 4406 ;; `file-name-all-completions' is not affected. 4407 (should 4408 (equal 4409 (sort (file-name-all-completions "" tmp-name) #'string-lessp) 4410 '("../" "./" "bold" "boz/" "foo" "foo.ext"))))) 4411 4412 ;; Cleanup. 4413 (ignore-errors (delete-directory tmp-name 'recursive))))))) 4414 4415(ert-deftest tramp-test27-load () 4416 "Check `load'." 4417 (skip-unless (tramp--test-enabled)) 4418 4419 (dolist (quoted (if (tramp--test-expensive-test-p) '(nil t) '(nil))) 4420 (let ((tmp-name (tramp--test-make-temp-name nil quoted))) 4421 (unwind-protect 4422 (progn 4423 (load tmp-name 'noerror 'nomessage) 4424 (should-not (featurep 'tramp-test-load)) 4425 (write-region "(provide 'tramp-test-load)" nil tmp-name) 4426 ;; `load' in lread.c does not pass `must-suffix'. Why? 4427 ;;(should-error 4428 ;; (load tmp-name nil 'nomessage 'nosuffix 'must-suffix) 4429 ;; :type 'file-error) 4430 (load tmp-name nil 'nomessage 'nosuffix) 4431 (should (featurep 'tramp-test-load))) 4432 4433 ;; Cleanup. 4434 (ignore-errors 4435 (and (featurep 'tramp-test-load) (unload-feature 'tramp-test-load)) 4436 (delete-file tmp-name)))))) 4437 4438(defun tramp--test-shell-file-name () 4439 "Return default remote shell." 4440 (if (tramp--test-adb-p) "/system/bin/sh" "/bin/sh")) 4441 4442(ert-deftest tramp-test28-process-file () 4443 "Check `process-file'." 4444 :tags '(:expensive-test) 4445 (skip-unless (tramp--test-enabled)) 4446 (skip-unless (tramp--test-supports-processes-p)) 4447 4448 (dolist (quoted (if (tramp--test-expensive-test-p) '(nil t) '(nil))) 4449 (let* ((tmp-name (tramp--test-make-temp-name nil quoted)) 4450 (fnnd (file-name-nondirectory tmp-name)) 4451 (default-directory tramp-test-temporary-file-directory) 4452 kill-buffer-query-functions) 4453 (unwind-protect 4454 (progn 4455 ;; We cannot use "/bin/true" and "/bin/false"; those paths 4456 ;; do not exist on hydra. 4457 (should (zerop (process-file "true"))) 4458 (should-not (zerop (process-file "false"))) 4459 (should-not (zerop (process-file "binary-does-not-exist"))) 4460 ;; Return exit code. 4461 (should (= 42 (process-file 4462 (tramp--test-shell-file-name) 4463 nil nil nil "-c" "exit 42"))) 4464 ;; Return exit code in case the process is interrupted, 4465 ;; and there's no indication for a signal describing string. 4466 (unless (tramp--test-sshfs-p) 4467 (let (process-file-return-signal-string) 4468 (should 4469 (= (+ 128 2) 4470 (process-file 4471 (tramp--test-shell-file-name) 4472 nil nil nil "-c" "kill -2 $$"))))) 4473 ;; Return string in case the process is interrupted and 4474 ;; there's an indication for a signal describing string. 4475 (unless (tramp--test-sshfs-p) 4476 (let ((process-file-return-signal-string t)) 4477 (should 4478 (string-match-p 4479 "Interrupt\\|Signal 2" 4480 (process-file 4481 (tramp--test-shell-file-name) 4482 nil nil nil "-c" "kill -2 $$"))))) 4483 4484 (with-temp-buffer 4485 (write-region "foo" nil tmp-name) 4486 (should (file-exists-p tmp-name)) 4487 (should (zerop (process-file "ls" nil t nil fnnd))) 4488 ;; "ls" could produce colorized output. 4489 (goto-char (point-min)) 4490 (while 4491 (re-search-forward tramp-display-escape-sequence-regexp nil t) 4492 (replace-match "" nil nil)) 4493 (should (string-equal (format "%s\n" fnnd) (buffer-string))) 4494 (should-not (get-buffer-window (current-buffer) t)) 4495 4496 ;; Second run. The output must be appended. 4497 (goto-char (point-max)) 4498 (should (zerop (process-file "ls" nil t t fnnd))) 4499 ;; "ls" could produce colorized output. 4500 (goto-char (point-min)) 4501 (while 4502 (re-search-forward tramp-display-escape-sequence-regexp nil t) 4503 (replace-match "" nil nil)) 4504 (should 4505 (string-equal (format "%s\n%s\n" fnnd fnnd) (buffer-string))) 4506 ;; A non-nil DISPLAY must not raise the buffer. 4507 (should-not (get-buffer-window (current-buffer) t)))) 4508 4509 ;; Cleanup. 4510 (ignore-errors (delete-file tmp-name)))))) 4511 4512;; Must be a command, because used as `sigusr1' handler. 4513(defun tramp--test-timeout-handler (&rest _ignore) 4514 "Timeout handler, reporting a failed test." 4515 (interactive) 4516 (let ((proc (get-buffer-process (current-buffer)))) 4517 (when (processp proc) 4518 (tramp--test-message 4519 "cmd: %s\nbuf:\n%s\n---" (process-command proc) (buffer-string)))) 4520 (ert-fail (format "`%s' timed out" (ert-test-name (ert-running-test))))) 4521 4522(ert-deftest tramp-test29-start-file-process () 4523 "Check `start-file-process'." 4524 :tags '(:expensive-test :tramp-asynchronous-processes) 4525 (skip-unless (tramp--test-enabled)) 4526 (skip-unless (tramp--test-supports-processes-p)) 4527 4528 (dolist (quoted (if (tramp--test-expensive-test-p) '(nil t) '(nil))) 4529 (let ((default-directory tramp-test-temporary-file-directory) 4530 (tmp-name (tramp--test-make-temp-name nil quoted)) 4531 kill-buffer-query-functions proc) 4532 4533 ;; Simple process. 4534 (unwind-protect 4535 (with-temp-buffer 4536 (setq proc (start-file-process "test1" (current-buffer) "cat")) 4537 (should (processp proc)) 4538 (should (equal (process-status proc) 'run)) 4539 (process-send-string proc "foo\n") 4540 (process-send-eof proc) 4541 ;; Read output. 4542 (with-timeout (10 (tramp--test-timeout-handler)) 4543 (while (< (- (point-max) (point-min)) (length "foo")) 4544 (while (accept-process-output proc 0 nil t)))) 4545 (should (string-match-p "foo" (buffer-string)))) 4546 4547 ;; Cleanup. 4548 (ignore-errors (delete-process proc))) 4549 4550 ;; Simple process using a file. 4551 (unwind-protect 4552 (with-temp-buffer 4553 (write-region "foo" nil tmp-name) 4554 (should (file-exists-p tmp-name)) 4555 (setq proc 4556 (start-file-process 4557 "test2" (current-buffer) 4558 "cat" (file-name-nondirectory tmp-name))) 4559 (should (processp proc)) 4560 ;; Read output. 4561 (with-timeout (10 (tramp--test-timeout-handler)) 4562 (while (< (- (point-max) (point-min)) (length "foo")) 4563 (while (accept-process-output proc 0 nil t)))) 4564 (should (string-match-p "foo" (buffer-string)))) 4565 4566 ;; Cleanup. 4567 (ignore-errors 4568 (delete-process proc) 4569 (delete-file tmp-name))) 4570 4571 ;; Process filter. 4572 (unwind-protect 4573 (with-temp-buffer 4574 (setq proc (start-file-process "test3" (current-buffer) "cat")) 4575 (should (processp proc)) 4576 (should (equal (process-status proc) 'run)) 4577 (set-process-filter 4578 proc 4579 (lambda (p s) (with-current-buffer (process-buffer p) (insert s)))) 4580 (process-send-string proc "foo\n") 4581 (process-send-eof proc) 4582 ;; Read output. 4583 (with-timeout (10 (tramp--test-timeout-handler)) 4584 (while (< (- (point-max) (point-min)) (length "foo")) 4585 (while (accept-process-output proc 0 nil t)))) 4586 (should (string-match-p "foo" (buffer-string)))) 4587 4588 ;; Cleanup. 4589 (ignore-errors (delete-process proc))) 4590 4591 ;; Disabled process filter. "sshfs" does not cooperate. 4592 (unless (tramp--test-sshfs-p) 4593 (unwind-protect 4594 (with-temp-buffer 4595 (setq proc (start-file-process "test3" (current-buffer) "cat")) 4596 (should (processp proc)) 4597 (should (equal (process-status proc) 'run)) 4598 (set-process-filter proc t) 4599 (process-send-string proc "foo\n") 4600 (process-send-eof proc) 4601 ;; Read output. There shouldn't be any. 4602 (with-timeout (10) 4603 (while (process-live-p proc) 4604 (while (accept-process-output proc 0 nil t)))) 4605 ;; No output due to process filter. 4606 (should (= (point-min) (point-max)))) 4607 4608 ;; Cleanup. 4609 (ignore-errors (delete-process proc)))) 4610 4611 ;; Process connection type. 4612 (when (and (tramp--test-sh-p) 4613 (not (tramp-direct-async-process-p)) 4614 ;; `executable-find' has changed the number of 4615 ;; parameters in Emacs 27.1, so we use `apply' for 4616 ;; older Emacsen. 4617 (ignore-errors 4618 (with-no-warnings 4619 (apply #'executable-find '("hexdump" remote))))) 4620 (dolist (process-connection-type '(nil pipe t pty)) 4621 (unwind-protect 4622 (with-temp-buffer 4623 (setq proc 4624 (start-file-process 4625 (format "test4-%s" process-connection-type) 4626 (current-buffer) "hexdump" "-v" "-e" "/1 \"%02X\n\"")) 4627 (should (processp proc)) 4628 (should (equal (process-status proc) 'run)) 4629 (process-send-string proc "foo\r\n") 4630 (process-send-eof proc) 4631 ;; Read output. 4632 (with-timeout (10 (tramp--test-timeout-handler)) 4633 (while (< (- (point-max) (point-min)) 4634 (length "66\n6F\n6F\n0D\n0A\n")) 4635 (while (accept-process-output proc 0 nil t)))) 4636 (should 4637 (string-match-p 4638 (if (and (memq process-connection-type '(nil pipe)) 4639 (not (tramp--test-macos-p))) 4640 ;; On macOS, there is always newline conversion. 4641 ;; "telnet" converts \r to <CR><NUL> if `crlf' 4642 ;; flag is FALSE. See telnet(1) man page. 4643 "66\n6F\n6F\n0D\\(\n00\\)?\n0A\n" 4644 "66\n6F\n6F\n0A\\(\n00\\)?\n0A\n") 4645 (buffer-string)))) 4646 4647 ;; Cleanup. 4648 (ignore-errors (delete-process proc))))) 4649 4650 ;; PTY. 4651 (unwind-protect 4652 (with-temp-buffer 4653 ;; It works only for tramp-sh.el, and not direct async processes. 4654 (if (or (not (tramp--test-sh-p)) (tramp-direct-async-process-p)) 4655 (should-error 4656 (start-file-process "test5" (current-buffer) nil) 4657 :type 'wrong-type-argument) 4658 4659 (setq proc (start-file-process "test5" (current-buffer) nil)) 4660 (should (processp proc)) 4661 (should (equal (process-status proc) 'run)) 4662 ;; On MS Windows, `process-tty-name' returns nil. 4663 (unless (tramp--test-windows-nt-p) 4664 (should (stringp (process-tty-name proc)))))) 4665 4666 ;; Cleanup. 4667 (ignore-errors (delete-process proc)))))) 4668 4669(defmacro tramp--test--deftest-direct-async-process 4670 (test docstring &optional unstable) 4671 "Define ert test `TEST-direct-async' for direct async processes. 4672If UNSTABLE is non-nil, the test is tagged as `:unstable'." 4673 (declare (indent 1)) 4674 ;; `make-process' supports file name handlers since Emacs 27. We 4675 ;; cannot use `tramp--test-always' during compilation of the macro. 4676 (when (let ((file-name-handler-alist '(("" . (lambda (&rest _) t))))) 4677 (ignore-errors (make-process :file-handler t))) 4678 `(ert-deftest ,(intern (concat (symbol-name test) "-direct-async")) () 4679 ,docstring 4680 :tags (append '(:expensive-test :tramp-asynchronous-processes) 4681 (and ,unstable '(:unstable))) 4682 (skip-unless (tramp--test-enabled)) 4683 (let ((default-directory tramp-test-temporary-file-directory) 4684 (ert-test (ert-get-test ',test)) 4685 (tramp-connection-properties 4686 (cons '(nil "direct-async-process" t) 4687 tramp-connection-properties))) 4688 (skip-unless (tramp-direct-async-process-p)) 4689 ;; We do expect an established connection already, 4690 ;; `file-truename' does it by side-effect. Suppress 4691 ;; `tramp--test-enabled', in order to keep the connection. 4692 ;; Suppress "Process ... finished" messages. 4693 (cl-letf (((symbol-function #'tramp--test-enabled) #'tramp--test-always) 4694 ((symbol-function #'internal-default-process-sentinel) 4695 #'ignore)) 4696 (file-truename tramp-test-temporary-file-directory) 4697 (funcall (ert-test-body ert-test))))))) 4698 4699(tramp--test--deftest-direct-async-process tramp-test29-start-file-process 4700 "Check direct async `start-file-process'.") 4701 4702(ert-deftest tramp-test30-make-process () 4703 "Check `make-process'." 4704 :tags '(:expensive-test :tramp-asynchronous-processes) 4705 (skip-unless (tramp--test-enabled)) 4706 (skip-unless (tramp--test-supports-processes-p)) 4707 ;; `make-process' supports file name handlers since Emacs 27. 4708 (skip-unless (tramp--test-emacs27-p)) 4709 4710 (dolist (quoted (if (tramp--test-expensive-test-p) '(nil t) '(nil))) 4711 (let ((default-directory tramp-test-temporary-file-directory) 4712 (tmp-name (tramp--test-make-temp-name nil quoted)) 4713 kill-buffer-query-functions proc) 4714 (with-no-warnings (should-not (make-process))) 4715 4716 ;; Simple process. 4717 (unwind-protect 4718 (with-temp-buffer 4719 (setq proc 4720 (with-no-warnings 4721 (make-process 4722 :name "test1" :buffer (current-buffer) :command '("cat") 4723 :file-handler t))) 4724 (should (processp proc)) 4725 (should (equal (process-status proc) 'run)) 4726 (process-send-string proc "foo\n") 4727 (process-send-eof proc) 4728 ;; Read output. 4729 (with-timeout (10 (tramp--test-timeout-handler)) 4730 (while (< (- (point-max) (point-min)) (length "foo")) 4731 (while (accept-process-output proc 0 nil t)))) 4732 (should (string-match-p "foo" (buffer-string)))) 4733 4734 ;; Cleanup. 4735 (ignore-errors (delete-process proc))) 4736 4737 ;; Simple process using a file. 4738 (unwind-protect 4739 (with-temp-buffer 4740 (write-region "foo" nil tmp-name) 4741 (should (file-exists-p tmp-name)) 4742 (setq proc 4743 (with-no-warnings 4744 (make-process 4745 :name "test2" :buffer (current-buffer) 4746 :command `("cat" ,(file-name-nondirectory tmp-name)) 4747 :file-handler t))) 4748 (should (processp proc)) 4749 ;; Read output. 4750 (with-timeout (10 (tramp--test-timeout-handler)) 4751 (while (< (- (point-max) (point-min)) (length "foo")) 4752 (while (accept-process-output proc 0 nil t)))) 4753 (should (string-match-p "foo" (buffer-string)))) 4754 4755 ;; Cleanup. 4756 (ignore-errors 4757 (delete-process proc) 4758 (delete-file tmp-name))) 4759 4760 ;; Process filter. 4761 (unwind-protect 4762 (with-temp-buffer 4763 (setq proc 4764 (with-no-warnings 4765 (make-process 4766 :name "test3" :buffer (current-buffer) :command '("cat") 4767 :filter 4768 (lambda (p s) 4769 (with-current-buffer (process-buffer p) (insert s))) 4770 :file-handler t))) 4771 (should (processp proc)) 4772 (should (equal (process-status proc) 'run)) 4773 (process-send-string proc "foo\n") 4774 (process-send-eof proc) 4775 ;; Read output. 4776 (with-timeout (10 (tramp--test-timeout-handler)) 4777 (while (not (string-match-p "foo" (buffer-string))) 4778 (while (accept-process-output proc 0 nil t)))) 4779 (should (string-match-p "foo" (buffer-string)))) 4780 4781 ;; Cleanup. 4782 (ignore-errors (delete-process proc))) 4783 4784 ;; Disabled process filter. "sshfs" does not cooperate. 4785 (unless (tramp--test-sshfs-p) 4786 (unwind-protect 4787 (with-temp-buffer 4788 (setq proc 4789 (with-no-warnings 4790 (make-process 4791 :name "test3" :buffer (current-buffer) :command '("cat") 4792 :filter t 4793 :file-handler t))) 4794 (should (processp proc)) 4795 (should (equal (process-status proc) 'run)) 4796 (process-send-string proc "foo\n") 4797 (process-send-eof proc) 4798 ;; Read output. There shouldn't be any. 4799 (with-timeout (10) 4800 (while (process-live-p proc) 4801 (while (accept-process-output proc 0 nil t)))) 4802 ;; No output due to process filter. 4803 (should (= (point-min) (point-max)))) 4804 4805 ;; Cleanup. 4806 (ignore-errors (delete-process proc)))) 4807 4808 ;; Process sentinel. 4809 (unwind-protect 4810 (with-temp-buffer 4811 (setq proc 4812 (with-no-warnings 4813 (make-process 4814 :name "test4" :buffer (current-buffer) :command '("cat") 4815 :sentinel 4816 (lambda (p s) 4817 (with-current-buffer (process-buffer p) (insert s))) 4818 :file-handler t))) 4819 (should (processp proc)) 4820 (should (equal (process-status proc) 'run)) 4821 (process-send-string proc "foo\n") 4822 (process-send-eof proc) 4823 (delete-process proc) 4824 ;; Read output. 4825 (with-timeout (10 (tramp--test-timeout-handler)) 4826 (while (accept-process-output proc 0 nil t))) 4827 ;; On some MS Windows systems, it returns "unknown signal". 4828 (should (string-match-p "unknown signal\\|killed" (buffer-string)))) 4829 4830 ;; Cleanup. 4831 (ignore-errors (delete-process proc))) 4832 4833 ;; Process with stderr buffer. "telnet" does not cooperate with 4834 ;; three processes. 4835 (unless (or (tramp--test-telnet-p) (tramp-direct-async-process-p)) 4836 (let ((stderr (generate-new-buffer "*stderr*"))) 4837 (unwind-protect 4838 (with-temp-buffer 4839 (setq proc 4840 (with-no-warnings 4841 (make-process 4842 :name "test5" :buffer (current-buffer) 4843 :command '("cat" "/does-not-exist") 4844 :stderr stderr 4845 :file-handler t))) 4846 (should (processp proc)) 4847 ;; Read output. 4848 (with-timeout (10 (tramp--test-timeout-handler)) 4849 (while (accept-process-output proc 0 nil t))) 4850 ;; Read stderr. 4851 (with-current-buffer stderr 4852 (with-timeout (10 (tramp--test-timeout-handler)) 4853 (while (not (string-match-p 4854 "No such file or directory" (buffer-string))) 4855 (while (accept-process-output 4856 (get-buffer-process stderr) 0 nil t)))) 4857 (delete-process proc) 4858 (should 4859 (string-match-p 4860 "cat:.* No such file or directory" (buffer-string))))) 4861 4862 ;; Cleanup. 4863 (ignore-errors (delete-process proc)) 4864 (ignore-errors (kill-buffer stderr))))) 4865 4866 ;; Process with stderr file. 4867 (unless (tramp-direct-async-process-p) 4868 (unwind-protect 4869 (with-temp-buffer 4870 (setq proc 4871 (with-no-warnings 4872 (make-process 4873 :name "test6" :buffer (current-buffer) 4874 :command '("cat" "/does-not-exist") 4875 :stderr tmp-name 4876 :file-handler t))) 4877 (should (processp proc)) 4878 ;; Read stderr. 4879 (with-timeout (10 (tramp--test-timeout-handler)) 4880 (while (accept-process-output proc nil nil t))) 4881 (delete-process proc) 4882 (with-temp-buffer 4883 (insert-file-contents tmp-name) 4884 (should 4885 (string-match-p 4886 "cat:.* No such file or directory" (buffer-string))))) 4887 4888 ;; Cleanup. 4889 (ignore-errors (delete-process proc)) 4890 (ignore-errors (delete-file tmp-name)))) 4891 4892 ;; Process connection type. 4893 (when (and (tramp--test-sh-p) 4894 (not (tramp-direct-async-process-p)) 4895 ;; `executable-find' has changed the number of 4896 ;; parameters in Emacs 27.1, so we use `apply' for 4897 ;; older Emacsen. 4898 (ignore-errors 4899 (with-no-warnings 4900 (apply #'executable-find '("hexdump" remote))))) 4901 (dolist (connection-type '(nil pipe t pty)) 4902 ;; `process-connection-type' is taken when 4903 ;; `:connection-type' is nil. 4904 (dolist (process-connection-type 4905 (unless connection-type '(nil pipe t pty))) 4906 (unwind-protect 4907 (with-temp-buffer 4908 (setq proc 4909 (with-no-warnings 4910 (make-process 4911 :name 4912 (format "test7-%s-%s" 4913 connection-type process-connection-type) 4914 :buffer (current-buffer) 4915 :connection-type connection-type 4916 :command '("hexdump" "-v" "-e" "/1 \"%02X\n\"") 4917 :file-handler t))) 4918 (should (processp proc)) 4919 (should (equal (process-status proc) 'run)) 4920 (process-send-string proc "foo\r\n") 4921 (process-send-eof proc) 4922 ;; Read output. 4923 (with-timeout (10 (tramp--test-timeout-handler)) 4924 (while (< (- (point-max) (point-min)) 4925 (length "66\n6F\n6F\n0D\n0A\n")) 4926 (while (accept-process-output proc 0 nil t)))) 4927 (should 4928 (string-match-p 4929 (if (and (memq (or connection-type process-connection-type) 4930 '(nil pipe)) 4931 (not (tramp--test-macos-p))) 4932 ;; On macOS, there is always newline conversion. 4933 ;; "telnet" converts \r to <CR><NUL> if `crlf' 4934 ;; flag is FALSE. See telnet(1) man page. 4935 "66\n6F\n6F\n0D\\(\n00\\)?\n0A\n" 4936 "66\n6F\n6F\n0A\\(\n00\\)?\n0A\n") 4937 (buffer-string)))) 4938 4939 ;; Cleanup. 4940 (ignore-errors (delete-process proc))))))))) 4941 4942(tramp--test--deftest-direct-async-process tramp-test30-make-process 4943 "Check direct async `make-process'.") 4944 4945(ert-deftest tramp-test31-interrupt-process () 4946 "Check `interrupt-process'." 4947 :tags (append '(:expensive-test :tramp-asynchronous-processes) 4948 (and (or (getenv "EMACS_HYDRA_CI") (getenv "EMACS_EMBA_CI")) 4949 '(:unstable))) 4950 (skip-unless (tramp--test-enabled)) 4951 (skip-unless (tramp--test-sh-p)) 4952 (skip-unless (not (tramp--test-crypt-p))) 4953 4954 ;; We must use `file-truename' for the temporary directory, in 4955 ;; order to establish the connection prior running an asynchronous 4956 ;; process. 4957 (let ((default-directory (file-truename tramp-test-temporary-file-directory)) 4958 (delete-exited-processes t) 4959 kill-buffer-query-functions proc) 4960 (unwind-protect 4961 (with-temp-buffer 4962 (setq proc (start-file-process-shell-command 4963 "test" (current-buffer) 4964 "trap 'echo boom; exit 1' 2; sleep 100")) 4965 (should (processp proc)) 4966 (should (process-live-p proc)) 4967 (should (equal (process-status proc) 'run)) 4968 (should (numberp (process-get proc 'remote-pid))) 4969 (should (interrupt-process proc)) 4970 ;; Let the process accept the interrupt. 4971 (with-timeout (10 (tramp--test-timeout-handler)) 4972 (while (process-live-p proc) 4973 (while (accept-process-output proc 0 nil t)))) 4974 (should-not (process-live-p proc)) 4975 ;; An interrupted process cannot be interrupted, again. 4976 (should-error 4977 (interrupt-process proc) 4978 :type 'error)) 4979 4980 ;; Cleanup. 4981 (ignore-errors (delete-process proc))))) 4982 4983(defun tramp--test-async-shell-command 4984 (command output-buffer &optional error-buffer input) 4985 "Like `async-shell-command', reading the output. 4986INPUT, if non-nil, is a string sent to the process." 4987 (let ((proc (async-shell-command command output-buffer error-buffer)) 4988 (delete-exited-processes t)) 4989 (cl-letf (((symbol-function #'shell-command-sentinel) #'ignore)) 4990 (when (stringp input) 4991 (process-send-string proc input)) 4992 (with-timeout 4993 ((if (getenv "EMACS_EMBA_CI") 30 10) (tramp--test-timeout-handler)) 4994 (while 4995 (or (accept-process-output proc nil nil t) (process-live-p proc)))) 4996 (accept-process-output proc nil nil t)))) 4997 4998(defun tramp--test-shell-command-to-string-asynchronously (command) 4999 "Like `shell-command-to-string', but for asynchronous processes." 5000 (with-temp-buffer 5001 (tramp--test-async-shell-command command (current-buffer)) 5002 (buffer-substring-no-properties (point-min) (point-max)))) 5003 5004(ert-deftest tramp-test32-shell-command () 5005 "Check `shell-command'." 5006 :tags '(:expensive-test) 5007 (skip-unless (tramp--test-enabled)) 5008 (skip-unless (tramp--test-supports-processes-p)) 5009 ;; Prior Emacs 27, `shell-file-name' was hard coded as "/bin/sh" for 5010 ;; remote processes in Emacs. That doesn't work for tramp-adb.el. 5011 (when (tramp--test-adb-p) 5012 (skip-unless (tramp--test-emacs27-p))) 5013 5014 (dolist (quoted (if (tramp--test-expensive-test-p) '(nil t) '(nil))) 5015 (let ((tmp-name (tramp--test-make-temp-name nil quoted)) 5016 (default-directory tramp-test-temporary-file-directory) 5017 ;; Suppress nasty messages. 5018 (inhibit-message t) 5019 kill-buffer-query-functions) 5020 5021 (dolist (this-shell-command 5022 (append 5023 ;; Synchronously. 5024 '(shell-command) 5025 ;; Asynchronously. 5026 (and (tramp--test-asynchronous-processes-p) 5027 '(tramp--test-async-shell-command)))) 5028 5029 ;; Test ordinary `{async-}shell-command'. 5030 (unwind-protect 5031 (with-temp-buffer 5032 (write-region "foo" nil tmp-name) 5033 (should (file-exists-p tmp-name)) 5034 (funcall 5035 this-shell-command 5036 (format "ls %s" (file-name-nondirectory tmp-name)) 5037 (current-buffer)) 5038 ;; "ls" could produce colorized output. 5039 (goto-char (point-min)) 5040 (while 5041 (re-search-forward tramp-display-escape-sequence-regexp nil t) 5042 (replace-match "" nil nil)) 5043 (should 5044 (string-equal 5045 (format "%s\n" (file-name-nondirectory tmp-name)) 5046 (buffer-string)))) 5047 5048 ;; Cleanup. 5049 (ignore-errors (delete-file tmp-name))) 5050 5051 ;; Test `{async-}shell-command' with error buffer. 5052 (unless (tramp-direct-async-process-p) 5053 (let ((stderr (generate-new-buffer "*stderr*"))) 5054 (unwind-protect 5055 (with-temp-buffer 5056 (funcall 5057 this-shell-command 5058 "echo foo >&2; echo bar" (current-buffer) stderr) 5059 (should (string-equal "bar\n" (buffer-string))) 5060 ;; Check stderr. 5061 (should 5062 (string-equal "foo\n" (tramp-get-buffer-string stderr)))) 5063 5064 ;; Cleanup. 5065 (ignore-errors (kill-buffer stderr)))))) 5066 5067 ;; Test sending string to `async-shell-command'. 5068 (when (tramp--test-asynchronous-processes-p) 5069 (unwind-protect 5070 (with-temp-buffer 5071 (write-region "foo" nil tmp-name) 5072 (should (file-exists-p tmp-name)) 5073 (tramp--test-async-shell-command 5074 "read line; ls $line" (current-buffer) nil 5075 ;; String to be sent. 5076 (format "%s\n" (file-name-nondirectory tmp-name))) 5077 (should 5078 (string-equal 5079 ;; tramp-adb.el echoes, so we must add the string. 5080 (if (and (tramp--test-adb-p) 5081 (not (tramp-direct-async-process-p))) 5082 (format 5083 "%s\n%s\n" 5084 (file-name-nondirectory tmp-name) 5085 (file-name-nondirectory tmp-name)) 5086 (format "%s\n" (file-name-nondirectory tmp-name))) 5087 (buffer-string)))) 5088 5089 ;; Cleanup. 5090 (ignore-errors (delete-file tmp-name)))))) 5091 5092 ;; Test `async-shell-command-width'. It exists since Emacs 26.1, 5093 ;; but seems to work since Emacs 27.1 only. 5094 (when (and (tramp--test-asynchronous-processes-p) 5095 (tramp--test-sh-p) (tramp--test-emacs27-p)) 5096 (let* ((async-shell-command-width 1024) 5097 (default-directory tramp-test-temporary-file-directory) 5098 (cols (ignore-errors 5099 (read (tramp--test-shell-command-to-string-asynchronously 5100 "tput cols"))))) 5101 (when (natnump cols) 5102 (should (= cols async-shell-command-width)))))) 5103 5104(tramp--test--deftest-direct-async-process tramp-test32-shell-command 5105 "Check direct async `shell-command'." 'unstable) 5106 5107;; This test is inspired by Bug#39067. 5108(ert-deftest tramp-test32-shell-command-dont-erase-buffer () 5109 "Check `shell-command-dont-erase-buffer'." 5110 ;; As long as Bug#40896 is not solved both in simple.el and Tramp, 5111 ;; this test cannot run properly. 5112 :tags '(:expensive-test :unstable) 5113 (skip-unless (tramp--test-enabled)) 5114 (skip-unless nil) 5115 (skip-unless (tramp--test-supports-processes-p)) 5116 ;; Prior Emacs 27, `shell-command-dont-erase-buffer' wasn't working properly. 5117 (skip-unless (tramp--test-emacs27-p)) 5118 5119 ;; (message " s-c-d-e-b current-buffer buffer-string point") 5120 ;; (message "===============================================") 5121 5122 ;; s-c-d-e-b current-buffer buffer-string point 5123 ;; =============================================== 5124 ;; nil t foobazzbar 4 x 5125 ;; nil nil bazz 5 5126 ;; ----------------------------------------------- 5127 ;; erase t bazz 1 x 5128 ;; erase nil bazz 5 5129 ;; ----------------------------------------------- 5130 ;; beg-last-out t foobazzbar 4 x 5131 ;; beg-last-out nil foobarbazz 7 5132 ;; ----------------------------------------------- 5133 ;; end-last-out t foobazzbar 4 5134 ;; end-last-out nil foobazzbar 11 5135 ;; ----------------------------------------------- 5136 ;; save-point t foobazzbar 4 x 5137 ;; save-point nil foobarbazz 4 x 5138 ;; ----------------------------------------------- 5139 ;; random t foobazzbar 4 5140 ;; random nil foobazzbar 11 5141 ;; ----------------------------------------------- 5142 5143 (let (;; Suppress nasty messages. 5144 (inhibit-message t) 5145 buffer kill-buffer-query-functions) 5146 ;; We check both the local and remote case, in order to guarantee 5147 ;; that they behave similar. 5148 (dolist (default-directory 5149 `(,temporary-file-directory ,tramp-test-temporary-file-directory)) 5150 ;; These are the possible values of `shell-command-dont-erase-buffer'. 5151 ;; `random' is taken as non-nil value without special meaning. 5152 (dolist (shell-command-dont-erase-buffer 5153 '(nil erase beg-last-out end-last-out save-point random)) 5154 ;; `shell-command' might work over the current buffer, or not. 5155 (dolist (current '(t nil)) 5156 (with-temp-buffer 5157 ;; We insert the string "foobar" into an empty buffer. 5158 ;; Point is set between "foo" and "bar". 5159 (setq buffer (current-buffer)) 5160 (insert "foobar") 5161 (goto-char (- (point) 3)) 5162 (should (string-equal "foobar" (buffer-string))) 5163 (should (string-equal "foo" (buffer-substring (point-min) (point)))) 5164 (should (string-equal "bar" (buffer-substring (point) (point-max)))) 5165 5166 ;; Apply `shell-command'. It shall output the string 5167 ;; "bazz". Messages in the *Messages* buffer are 5168 ;; suppressed. 5169 (let (message-log-max) 5170 (if current 5171 (shell-command "echo -n bazz" (current-buffer)) 5172 (with-temp-buffer (shell-command "echo -n bazz" buffer)))) 5173 5174 ;; (message 5175 ;; "%12s %14s %13s %5d" 5176 ;; shell-command-dont-erase-buffer current (buffer-string) (point)))) 5177 ;; (message "-----------------------------------------------"))))) 5178 5179 ;; Check result. 5180 (cond 5181 (current 5182 ;; String is inserted at point, and point is preserved 5183 ;; unless dictated otherwise. 5184 (cond 5185 ((null shell-command-dont-erase-buffer) 5186 (should (string-equal "foobazzbar" (buffer-string))) 5187 (should (= 4 (point)))) 5188 ((eq shell-command-dont-erase-buffer 'erase) 5189 (should (string-equal "bazz" (buffer-string))) 5190 (should (= 1 (point)))) 5191 ((eq shell-command-dont-erase-buffer 'beg-last-out) 5192 (should (string-equal "foobazzbar" (buffer-string))) 5193 (should (= 4 (point)))) 5194 ;; Bug#40896 5195 ;; ((eq shell-command-dont-erase-buffer 'end-last-out) 5196 ;; (should (string-equal "foobazzbar" (buffer-string))) 5197 ;; (should (= 7 (point)))) 5198 ((eq shell-command-dont-erase-buffer 'save-point) 5199 (should (string-equal "foobazzbar" (buffer-string))) 5200 (should (= 4 (point)))) 5201 ;; Bug#40896 5202 ;; ((eq shell-command-dont-erase-buffer 'random) 5203 ;; (should (string-equal "foobazzbar" (buffer-string))) 5204 ;; (should (= 7 (point)))))) 5205 )) 5206 5207 (t ;; not current buffer 5208 ;; String is appended, and point is at point-max unless 5209 ;; dictated otherwise. 5210 (cond 5211 ((null shell-command-dont-erase-buffer) 5212 (should (string-equal "bazz" (buffer-string))) 5213 (should (= 5 (point)))) 5214 ((eq shell-command-dont-erase-buffer 'erase) 5215 (should (string-equal "bazz" (buffer-string))) 5216 (should (= 5 (point)))) 5217 ((eq shell-command-dont-erase-buffer 'beg-last-out) 5218 (should (string-equal "foobarbazz" (buffer-string))) 5219 (should (= 7 (point)))) 5220 ;; ;; Bug#40896 5221 ;; ((eq shell-command-dont-erase-buffer 'end-last-out) 5222 ;; (should (string-equal "foobarbazz" (buffer-string))) 5223 ;; (should (= 11 (point)))) 5224 ((eq shell-command-dont-erase-buffer 'save-point) 5225 (should (string-equal "foobarbazz" (buffer-string))) 5226 (should (= 4 (point)))) 5227 ;; ;; Bug#40896 5228 ;; ((eq shell-command-dont-erase-buffer 'random) 5229 ;; (should (string-equal "foobarbazz" (buffer-string))) 5230 ;; (should (= 11 (point))))))))))))) 5231 ))))))))) 5232 5233;; This test is inspired by Bug#23952. 5234(ert-deftest tramp-test33-environment-variables () 5235 "Check that remote processes set / unset environment variables properly." 5236 :tags '(:expensive-test) 5237 (skip-unless (tramp--test-enabled)) 5238 (skip-unless (tramp--test-sh-p)) 5239 (skip-unless (not (tramp--test-crypt-p))) 5240 5241 (dolist (this-shell-command-to-string 5242 (append 5243 ;; Synchronously. 5244 '(shell-command-to-string) 5245 ;; Asynchronously. 5246 (and (tramp--test-asynchronous-processes-p) 5247 '(tramp--test-shell-command-to-string-asynchronously)))) 5248 5249 (let ((default-directory tramp-test-temporary-file-directory) 5250 (shell-file-name "/bin/sh") 5251 (envvar (concat "VAR_" (upcase (md5 (current-time-string))))) 5252 kill-buffer-query-functions) 5253 5254 ;; Check INSIDE_EMACS. 5255 (setenv "INSIDE_EMACS") 5256 (should 5257 (string-equal 5258 (format "%s,tramp:%s\n" emacs-version tramp-version) 5259 (funcall this-shell-command-to-string "echo \"${INSIDE_EMACS:-bla}\""))) 5260 (let ((process-environment 5261 (cons (format "INSIDE_EMACS=%s,foo" emacs-version) 5262 process-environment))) 5263 (should 5264 (string-equal 5265 (format "%s,foo,tramp:%s\n" emacs-version tramp-version) 5266 (funcall 5267 this-shell-command-to-string "echo \"${INSIDE_EMACS:-bla}\"")))) 5268 5269 ;; Set a value. 5270 (let ((process-environment 5271 (cons (concat envvar "=foo") process-environment))) 5272 ;; Default value. 5273 (should 5274 (string-match-p 5275 "foo" 5276 (funcall 5277 this-shell-command-to-string 5278 (format "echo \"${%s:-bla}\"" envvar))))) 5279 5280 ;; Set the empty value. 5281 (let ((process-environment 5282 (cons (concat envvar "=") process-environment))) 5283 ;; Value is null. 5284 (should 5285 (string-match-p 5286 "bla" 5287 (funcall 5288 this-shell-command-to-string (format "echo \"${%s:-bla}\"" envvar)))) 5289 ;; Variable is set. 5290 (should 5291 (string-match-p 5292 (regexp-quote envvar) 5293 (funcall this-shell-command-to-string "set")))) 5294 5295 (unless (tramp-direct-async-process-p) 5296 ;; We force a reconnect, in order to have a clean environment. 5297 (tramp-cleanup-connection tramp-test-vec 'keep-debug 'keep-password) 5298 ;; Unset the variable. 5299 (let ((tramp-remote-process-environment 5300 (cons (concat envvar "=foo") tramp-remote-process-environment))) 5301 ;; Set the initial value, we want to unset below. 5302 (should 5303 (string-match-p 5304 "foo" 5305 (funcall 5306 this-shell-command-to-string 5307 (format "echo \"${%s:-bla}\"" envvar)))) 5308 (let ((process-environment (cons envvar process-environment))) 5309 ;; Variable is unset. 5310 (should 5311 (string-match-p 5312 "bla" 5313 (funcall 5314 this-shell-command-to-string 5315 (format "echo \"${%s:-bla}\"" envvar)))) 5316 ;; Variable is unset. 5317 (should-not 5318 (string-match-p 5319 (regexp-quote envvar) 5320 ;; We must remove PS1, the output is truncated otherwise. 5321 ;; We must suppress "_=VAR...". 5322 (funcall 5323 this-shell-command-to-string 5324 "printenv | grep -v PS1 | grep -v _="))))))))) 5325 5326(tramp--test--deftest-direct-async-process tramp-test33-environment-variables 5327 "Check that remote processes set / unset environment variables properly. 5328Use direct async.") 5329 5330;; This test is inspired by Bug#27009. 5331(ert-deftest tramp-test33-environment-variables-and-port-numbers () 5332 "Check that two connections with separate ports are different." 5333 (skip-unless (tramp--test-enabled)) 5334 ;; We test it only for the mock-up connection; otherwise there might 5335 ;; be problems with the used ports. 5336 (skip-unless (and (eq tramp-syntax 'default) (tramp--test-mock-p))) 5337 (skip-unless (not (tramp--test-crypt-p))) 5338 5339 ;; We force a reconnect, in order to have a clean environment. 5340 (dolist (dir `(,tramp-test-temporary-file-directory 5341 "/mock:localhost#11111:" "/mock:localhost#22222:")) 5342 (tramp-cleanup-connection 5343 (tramp-dissect-file-name dir) 'keep-debug 'keep-password)) 5344 5345 (unwind-protect 5346 (dolist (port '(11111 22222)) 5347 (let* ((default-directory 5348 (format "/mock:localhost#%d:%s" port temporary-file-directory)) 5349 (shell-file-name "/bin/sh") 5350 (envvar (concat "VAR_" (upcase (md5 (current-time-string))))) 5351 ;; We cannot use `process-environment', because this 5352 ;; would be applied in `process-file'. 5353 (tramp-remote-process-environment 5354 (cons 5355 (format "%s=%d" envvar port) 5356 tramp-remote-process-environment))) 5357 (should 5358 (string-match-p 5359 (number-to-string port) 5360 (shell-command-to-string (format "echo $%s" envvar)))))) 5361 5362 ;; Cleanup. 5363 (dolist (dir '("/mock:localhost#11111:" "/mock:localhost#22222:")) 5364 (tramp-cleanup-connection (tramp-dissect-file-name dir))))) 5365 5366;; Connection-local variables are enabled per default since Emacs 27.1. 5367(ert-deftest tramp-test34-connection-local-variables () 5368 "Check that connection-local variables are enabled." 5369 :tags '(:expensive-test) 5370 (skip-unless (tramp--test-enabled)) 5371 ;; Since Emacs 27.1. 5372 (skip-unless (fboundp 'with-connection-local-variables)) 5373 5374 (let* ((default-directory tramp-test-temporary-file-directory) 5375 (tmp-name1 (tramp--test-make-temp-name)) 5376 (tmp-name2 (expand-file-name "foo" tmp-name1)) 5377 (enable-local-variables :all) 5378 (enable-remote-dir-locals t) 5379 (inhibit-message t) 5380 kill-buffer-query-functions 5381 connection-local-profile-alist connection-local-criteria-alist) 5382 (unwind-protect 5383 (progn 5384 (make-directory tmp-name1) 5385 (should (file-directory-p tmp-name1)) 5386 5387 ;; `local-variable' is buffer-local due to explicit setting. 5388 (with-no-warnings 5389 (defvar-local local-variable 'buffer)) 5390 (with-temp-buffer 5391 (should (eq local-variable 'buffer))) 5392 5393 ;; `local-variable' is connection-local due to Tramp. 5394 (write-region "foo" nil tmp-name2) 5395 (should (file-exists-p tmp-name2)) 5396 (connection-local-set-profile-variables 5397 'local-variable-profile 5398 '((local-variable . connect))) 5399 (connection-local-set-profiles 5400 `(:application tramp 5401 :protocol ,(file-remote-p default-directory 'method) 5402 :user ,(file-remote-p default-directory 'user) 5403 :machine ,(file-remote-p default-directory 'host)) 5404 'local-variable-profile) 5405 (with-current-buffer (find-file-noselect tmp-name2) 5406 (should (eq local-variable 'connect)) 5407 (kill-buffer (current-buffer))) 5408 5409 ;; `local-variable' is dir-local due to existence of .dir-locals.el. 5410 (write-region 5411 "((nil . ((local-variable . dir))))" nil 5412 (expand-file-name ".dir-locals.el" tmp-name1)) 5413 (should (file-exists-p (expand-file-name ".dir-locals.el" tmp-name1))) 5414 (with-current-buffer (find-file-noselect tmp-name2) 5415 (should (eq local-variable 'dir)) 5416 (kill-buffer (current-buffer))) 5417 5418 ;; `local-variable' is file-local due to specifying as file variable. 5419 (write-region 5420 "-*- mode: comint; local-variable: file; -*-" nil tmp-name2) 5421 (should (file-exists-p tmp-name2)) 5422 (with-current-buffer (find-file-noselect tmp-name2) 5423 (should (eq local-variable 'file)) 5424 (kill-buffer (current-buffer)))) 5425 5426 ;; Cleanup. 5427 (ignore-errors (delete-directory tmp-name1 'recursive))))) 5428 5429(ert-deftest tramp-test34-explicit-shell-file-name () 5430 "Check that connection-local `explicit-shell-file-name' is set." 5431 :tags '(:expensive-test :tramp-asynchronous-processes) 5432 (skip-unless (tramp--test-enabled)) 5433 (skip-unless (tramp--test-supports-processes-p)) 5434 ;; Prior Emacs 27, `shell-file-name' was hard coded as "/bin/sh" for 5435 ;; remote processes in Emacs. That doesn't work for tramp-adb.el. 5436 (when (tramp--test-adb-p) 5437 (skip-unless (tramp--test-emacs27-p))) 5438 5439 (let ((default-directory tramp-test-temporary-file-directory) 5440 explicit-shell-file-name kill-buffer-query-functions 5441 connection-local-profile-alist connection-local-criteria-alist) 5442 (unwind-protect 5443 (progn 5444 ;; `shell-mode' would ruin our test, because it deletes all 5445 ;; buffer local variables. Not needed in Emacs 27.1. 5446 (put 'explicit-shell-file-name 'permanent-local t) 5447 (connection-local-set-profile-variables 5448 'remote-sh 5449 `((explicit-shell-file-name . ,(tramp--test-shell-file-name)) 5450 (explicit-sh-args . ("-c" "echo foo")))) 5451 (connection-local-set-profiles 5452 `(:application tramp 5453 :protocol ,(file-remote-p default-directory 'method) 5454 :user ,(file-remote-p default-directory 'user) 5455 :machine ,(file-remote-p default-directory 'host)) 5456 'remote-sh) 5457 (put 'explicit-shell-file-name 'safe-local-variable #'identity) 5458 (put 'explicit-sh-args 'safe-local-variable #'identity) 5459 5460 ;; Run `shell' interactively. Since the default directory 5461 ;; is remote, `explicit-shell-file-name' shall be set in 5462 ;; order to avoid a question. `explicit-sh-args' echoes the 5463 ;; test data. 5464 (with-current-buffer (get-buffer-create "*shell*") 5465 (ignore-errors (kill-process (get-buffer-process (current-buffer)))) 5466 (should-not explicit-shell-file-name) 5467 (call-interactively #'shell) 5468 (with-timeout (10) 5469 (while (accept-process-output 5470 (get-buffer-process (current-buffer)) nil nil t))) 5471 (should (string-match-p "^foo$" (buffer-string))))) 5472 5473 ;; Cleanup. 5474 (put 'explicit-shell-file-name 'permanent-local nil) 5475 (kill-buffer "*shell*")))) 5476 5477;; `exec-path' was introduced in Emacs 27.1. `executable-find' has 5478;; changed the number of parameters, so we use `apply' for older 5479;; Emacsen. 5480(ert-deftest tramp-test35-exec-path () 5481 "Check `exec-path' and `executable-find'." 5482 (skip-unless (tramp--test-enabled)) 5483 (skip-unless (tramp--test-supports-processes-p)) 5484 (skip-unless (tramp--test-supports-set-file-modes-p)) 5485 ;; Since Emacs 27.1. 5486 (skip-unless (fboundp 'exec-path)) 5487 5488 (let ((tmp-name (tramp--test-make-temp-name)) 5489 (default-directory tramp-test-temporary-file-directory)) 5490 (unwind-protect 5491 (progn 5492 (should (consp (with-no-warnings (exec-path)))) 5493 ;; Last element is the `exec-directory'. 5494 (should 5495 (string-equal 5496 (car (last (with-no-warnings (exec-path)))) 5497 (file-remote-p default-directory 'localname))) 5498 ;; The shell "sh" shall always exist. 5499 (should (apply #'executable-find '("sh" remote))) 5500 ;; Since the last element in `exec-path' is the current 5501 ;; directory, an executable file in that directory will be 5502 ;; found. 5503 (write-region "foo" nil tmp-name) 5504 (should (file-exists-p tmp-name)) 5505 5506 (set-file-modes tmp-name #o777) 5507 (should (file-executable-p tmp-name)) 5508 (should 5509 (string-equal 5510 (apply 5511 #'executable-find `(,(file-name-nondirectory tmp-name) remote)) 5512 (file-remote-p tmp-name 'localname))) 5513 (should-not 5514 (apply 5515 #'executable-find 5516 `(,(concat (file-name-nondirectory tmp-name) "foo") remote)))) 5517 5518 ;; Cleanup. 5519 (ignore-errors (delete-file tmp-name))))) 5520 5521;; This test is inspired by Bug#33781. 5522;; `exec-path' was introduced in Emacs 27.1. `executable-find' has 5523;; changed the number of parameters, so we use `apply' for older 5524;; Emacsen. 5525(ert-deftest tramp-test35-remote-path () 5526 "Check loooong `tramp-remote-path'." 5527 (skip-unless (tramp--test-enabled)) 5528 (skip-unless (tramp--test-sh-p)) 5529 (skip-unless (not (tramp--test-crypt-p))) 5530 ;; Since Emacs 27.1. 5531 (skip-unless (fboundp 'exec-path)) 5532 5533 (let* ((tmp-name (tramp--test-make-temp-name)) 5534 (default-directory tramp-test-temporary-file-directory) 5535 (orig-exec-path (with-no-warnings (exec-path))) 5536 (tramp-remote-path tramp-remote-path) 5537 (orig-tramp-remote-path tramp-remote-path) 5538 path) 5539 (unwind-protect 5540 (progn 5541 ;; Non existing directories are removed. 5542 (setq tramp-remote-path 5543 (cons (file-remote-p tmp-name 'localname) tramp-remote-path)) 5544 (tramp-cleanup-connection tramp-test-vec 'keep-debug 'keep-password) 5545 (should (equal (with-no-warnings (exec-path)) orig-exec-path)) 5546 (setq tramp-remote-path orig-tramp-remote-path) 5547 5548 ;; Double entries are removed. 5549 (setq tramp-remote-path (append '("/" "/") tramp-remote-path)) 5550 (tramp-cleanup-connection tramp-test-vec 'keep-debug 'keep-password) 5551 (should 5552 (equal (with-no-warnings (exec-path)) (cons "/" orig-exec-path))) 5553 (setq tramp-remote-path orig-tramp-remote-path) 5554 5555 ;; We make a super long `tramp-remote-path'. 5556 (make-directory tmp-name) 5557 (should (file-directory-p tmp-name)) 5558 (while (< (length (mapconcat #'identity orig-exec-path ":")) 5000) 5559 (let ((dir (make-temp-file (file-name-as-directory tmp-name) 'dir))) 5560 (should (file-directory-p dir)) 5561 (setq tramp-remote-path 5562 (append 5563 tramp-remote-path `(,(file-remote-p dir 'localname))) 5564 orig-exec-path 5565 (append 5566 (butlast orig-exec-path) 5567 `(,(file-remote-p dir 'localname)) 5568 (last orig-exec-path))))) 5569 (tramp-cleanup-connection tramp-test-vec 'keep-debug 'keep-password) 5570 (should (equal (with-no-warnings (exec-path)) orig-exec-path)) 5571 ;; Ignore trailing newline. 5572 (setq path (substring (shell-command-to-string "echo $PATH") nil -1)) 5573 ;; The shell doesn't handle such long strings. 5574 (when (<= (length path) 5575 (tramp-get-connection-property 5576 tramp-test-vec "pipe-buf" 4096)) 5577 ;; The last element of `exec-path' is `exec-directory'. 5578 (should 5579 (string-equal 5580 path (mapconcat #'identity (butlast orig-exec-path) ":")))) 5581 ;; The shell "sh" shall always exist. 5582 (should (apply #'executable-find '("sh" remote)))) 5583 5584 ;; Cleanup. 5585 (tramp-cleanup-connection tramp-test-vec 'keep-debug 'keep-password) 5586 (setq tramp-remote-path orig-tramp-remote-path) 5587 (ignore-errors (delete-directory tmp-name 'recursive))))) 5588 5589(ert-deftest tramp-test36-vc-registered () 5590 "Check `vc-registered'." 5591 :tags '(:expensive-test) 5592 (skip-unless (tramp--test-enabled)) 5593 (skip-unless (tramp--test-sh-p)) 5594 (skip-unless (not (tramp--test-crypt-p))) 5595 5596 (dolist (quoted (if (tramp--test-expensive-test-p) '(nil t) '(nil))) 5597 ;; We must use `file-truename' for the temporary directory, in 5598 ;; order to establish the connection prior running an asynchronous 5599 ;; process. 5600 (let* ((default-directory 5601 (file-truename tramp-test-temporary-file-directory)) 5602 (tmp-name1 (tramp--test-make-temp-name nil quoted)) 5603 (tmp-name2 (expand-file-name "foo" tmp-name1)) 5604 (tramp-remote-process-environment tramp-remote-process-environment) 5605 (inhibit-message t) 5606 (vc-handled-backends 5607 (cond 5608 ((tramp-find-executable 5609 tramp-test-vec vc-git-program 5610 (tramp-get-remote-path tramp-test-vec)) 5611 '(Git)) 5612 ((tramp-find-executable 5613 tramp-test-vec vc-hg-program 5614 (tramp-get-remote-path tramp-test-vec)) 5615 '(Hg)) 5616 ((tramp-find-executable 5617 tramp-test-vec vc-bzr-program 5618 (tramp-get-remote-path tramp-test-vec)) 5619 (setq tramp-remote-process-environment 5620 (cons (format "BZR_HOME=%s" 5621 (file-remote-p tmp-name1 'localname)) 5622 tramp-remote-process-environment)) 5623 ;; We must force a reconnect, in order to activate $BZR_HOME. 5624 (tramp-cleanup-connection 5625 tramp-test-vec 'keep-debug 'keep-password) 5626 '(Bzr)) 5627 (t nil))) 5628 ;; Suppress nasty messages. 5629 (inhibit-message t)) 5630 (skip-unless vc-handled-backends) 5631 (unless quoted (tramp--test-message "%s" vc-handled-backends)) 5632 5633 (unwind-protect 5634 (progn 5635 (make-directory tmp-name1) 5636 (write-region "foo" nil tmp-name2) 5637 (should (file-directory-p tmp-name1)) 5638 (should (file-exists-p tmp-name2)) 5639 (should-not (vc-registered tmp-name1)) 5640 (should-not (vc-registered tmp-name2)) 5641 5642 (let ((default-directory tmp-name1)) 5643 ;; Create empty repository, and register the file. 5644 ;; Sometimes, creation of repository fails (bzr!); we 5645 ;; skip the test then. 5646 (condition-case nil 5647 (vc-create-repo (car vc-handled-backends)) 5648 (error (ert-skip "`vc-create-repo' not supported"))) 5649 ;; The structure of VC-FILESET is not documented. Let's 5650 ;; hope it won't change. 5651 (vc-register 5652 (list (car vc-handled-backends) 5653 (list (file-name-nondirectory tmp-name2)))) 5654 ;; vc-git uses an own process sentinel, Tramp's sentinel 5655 ;; for flushing the cache isn't used. 5656 (dired-uncache (concat (file-remote-p default-directory) "/")) 5657 (should (vc-registered (file-name-nondirectory tmp-name2))))) 5658 5659 ;; Cleanup. 5660 (ignore-errors (delete-directory tmp-name1 'recursive)))))) 5661 5662(ert-deftest tramp-test37-make-auto-save-file-name () 5663 "Check `make-auto-save-file-name'." 5664 (skip-unless (tramp--test-enabled)) 5665 5666 (dolist (quoted (if (tramp--test-expensive-test-p) '(nil t) '(nil))) 5667 (let ((tmp-name1 (tramp--test-make-temp-name nil quoted)) 5668 (tmp-name2 (tramp--test-make-temp-name nil quoted)) 5669 tramp-allow-unsafe-temporary-files) 5670 5671 (unwind-protect 5672 (progn 5673 ;; Use default `auto-save-file-name-transforms' mechanism. 5674 ;; It isn't prepared for `separate' syntax. 5675 (unless (eq tramp-syntax 'separate) 5676 (let (tramp-auto-save-directory) 5677 (with-temp-buffer 5678 (setq buffer-file-name tmp-name1) 5679 (should 5680 (string-equal 5681 (make-auto-save-file-name) 5682 ;; This is taken from original `make-auto-save-file-name'. 5683 ;; We call `convert-standard-filename', because on 5684 ;; MS Windows the (local) colons must be replaced by 5685 ;; exclamation marks. 5686 (convert-standard-filename 5687 (expand-file-name 5688 (format 5689 "#%s#" 5690 (subst-char-in-string 5691 ?/ ?! (replace-regexp-in-string "!" "!!" tmp-name1))) 5692 temporary-file-directory))))))) 5693 5694 ;; No mapping. 5695 (let (tramp-auto-save-directory auto-save-file-name-transforms) 5696 (with-temp-buffer 5697 (setq buffer-file-name tmp-name1) 5698 (should 5699 (string-equal 5700 (make-auto-save-file-name) 5701 (funcall 5702 (if quoted #'tramp-compat-file-name-quote #'identity) 5703 (expand-file-name 5704 (format "#%s#" (file-name-nondirectory tmp-name1)) 5705 tramp-test-temporary-file-directory)))))) 5706 5707 ;; Use default `tramp-auto-save-directory' mechanism. 5708 ;; Ange-FTP doesn't care. 5709 (unless (tramp--test-ange-ftp-p) 5710 (let ((tramp-auto-save-directory tmp-name2)) 5711 (with-temp-buffer 5712 (setq buffer-file-name tmp-name1) 5713 (should 5714 (string-equal 5715 (make-auto-save-file-name) 5716 ;; This is taken from Tramp. 5717 (expand-file-name 5718 (format 5719 "#%s#" 5720 (tramp-subst-strs-in-string 5721 '(("_" . "|") 5722 ("/" . "_a") 5723 (":" . "_b") 5724 ("|" . "__") 5725 ("[" . "_l") 5726 ("]" . "_r")) 5727 (tramp-compat-file-name-unquote tmp-name1))) 5728 tmp-name2))) 5729 (should (file-directory-p tmp-name2))))) 5730 5731 ;; Relative file names shall work, too. Ange-FTP doesn't care. 5732 (unless (tramp--test-ange-ftp-p) 5733 (let ((tramp-auto-save-directory ".")) 5734 (with-temp-buffer 5735 (setq buffer-file-name tmp-name1 5736 default-directory tmp-name2) 5737 (should 5738 (string-equal 5739 (make-auto-save-file-name) 5740 ;; This is taken from Tramp. 5741 (expand-file-name 5742 (format 5743 "#%s#" 5744 (tramp-subst-strs-in-string 5745 '(("_" . "|") 5746 ("/" . "_a") 5747 (":" . "_b") 5748 ("|" . "__") 5749 ("[" . "_l") 5750 ("]" . "_r")) 5751 (tramp-compat-file-name-unquote tmp-name1))) 5752 tmp-name2))) 5753 (should (file-directory-p tmp-name2))))) 5754 5755 ;; Create temporary file. This shall check for sensible 5756 ;; files, owned by root. 5757 (let ((tramp-auto-save-directory temporary-file-directory)) 5758 (write-region "foo" nil tmp-name1) 5759 (when (zerop (or (file-attribute-user-id 5760 (file-attributes tmp-name1)) 5761 tramp-unknown-id-integer)) 5762 (with-temp-buffer 5763 (setq buffer-file-name tmp-name1) 5764 (tramp-cleanup-connection 5765 tramp-test-vec 'keep-debug 'keep-password) 5766 (let ((tramp-allow-unsafe-temporary-files t)) 5767 (should (stringp (make-auto-save-file-name)))) 5768 (tramp-cleanup-connection 5769 tramp-test-vec 'keep-debug 'keep-password) 5770 (cl-letf (((symbol-function #'yes-or-no-p) #'ignore)) 5771 (should-error 5772 (make-auto-save-file-name) 5773 :type 'file-error)) 5774 (tramp-cleanup-connection 5775 tramp-test-vec 'keep-debug 'keep-password) 5776 (cl-letf (((symbol-function #'yes-or-no-p) 5777 #'tramp--test-always)) 5778 (should (stringp (make-auto-save-file-name)))))))) 5779 5780 ;; Cleanup. 5781 (ignore-errors (delete-file tmp-name1)) 5782 (ignore-errors (delete-directory tmp-name2 'recursive)) 5783 (tramp-cleanup-connection tramp-test-vec 'keep-debug 'keep-password))))) 5784 5785(ert-deftest tramp-test38-find-backup-file-name () 5786 "Check `find-backup-file-name'." 5787 (skip-unless (tramp--test-enabled)) 5788 5789 (dolist (quoted (if (tramp--test-expensive-test-p) '(nil t) '(nil))) 5790 (let ((tmp-name1 (tramp--test-make-temp-name nil quoted)) 5791 (tmp-name2 (tramp--test-make-temp-name nil quoted)) 5792 (ange-ftp-make-backup-files t) 5793 tramp-allow-unsafe-temporary-files 5794 ;; These settings are not used by Tramp, so we ignore them. 5795 version-control delete-old-versions 5796 (kept-old-versions (default-toplevel-value 'kept-old-versions)) 5797 (kept-new-versions (default-toplevel-value 'kept-new-versions))) 5798 5799 (unwind-protect 5800 ;; Use default `backup-directory-alist' mechanism. 5801 (let (backup-directory-alist tramp-backup-directory-alist) 5802 (should 5803 (equal 5804 (find-backup-file-name tmp-name1) 5805 (list 5806 (funcall 5807 (if quoted #'tramp-compat-file-name-quote #'identity) 5808 (expand-file-name 5809 (format "%s~" (file-name-nondirectory tmp-name1)) 5810 tramp-test-temporary-file-directory))))))) 5811 5812 (unwind-protect 5813 ;; Map `backup-directory-alist'. 5814 (let ((backup-directory-alist `(("." . ,tmp-name2))) 5815 tramp-backup-directory-alist) 5816 (should 5817 (equal 5818 (find-backup-file-name tmp-name1) 5819 (list 5820 (funcall 5821 (if quoted #'tramp-compat-file-name-quote #'identity) 5822 (expand-file-name 5823 (format 5824 "%s~" 5825 ;; This is taken from `make-backup-file-name-1'. We 5826 ;; call `convert-standard-filename', because on MS 5827 ;; Windows the (local) colons must be replaced by 5828 ;; exclamation marks. 5829 (subst-char-in-string 5830 ?/ ?! 5831 (replace-regexp-in-string 5832 "!" "!!" (convert-standard-filename tmp-name1)))) 5833 tmp-name2))))) 5834 ;; The backup directory is created. 5835 (should (file-directory-p tmp-name2))) 5836 5837 ;; Cleanup. 5838 (ignore-errors (delete-directory tmp-name2 'recursive))) 5839 5840 (unwind-protect 5841 ;; Map `tramp-backup-directory-alist'. Ange-FTP doesn't care. 5842 (unless (tramp--test-ange-ftp-p) 5843 (let ((tramp-backup-directory-alist `(("." . ,tmp-name2))) 5844 backup-directory-alist) 5845 (should 5846 (equal 5847 (find-backup-file-name tmp-name1) 5848 (list 5849 (funcall 5850 (if quoted #'tramp-compat-file-name-quote #'identity) 5851 (expand-file-name 5852 (format 5853 "%s~" 5854 ;; This is taken from `make-backup-file-name-1'. 5855 ;; We call `convert-standard-filename', because on 5856 ;; MS Windows the (local) colons must be replaced 5857 ;; by exclamation marks. 5858 (subst-char-in-string 5859 ?/ ?! 5860 (replace-regexp-in-string 5861 "!" "!!" (convert-standard-filename tmp-name1)))) 5862 tmp-name2))))) 5863 ;; The backup directory is created. 5864 (should (file-directory-p tmp-name2)))) 5865 5866 ;; Cleanup. 5867 (ignore-errors (delete-directory tmp-name2 'recursive))) 5868 5869 (unwind-protect 5870 ;; Map `tramp-backup-directory-alist' with local file name. 5871 ;; Ange-FTP doesn't care. 5872 (unless (tramp--test-ange-ftp-p) 5873 (let ((tramp-backup-directory-alist 5874 `(("." . ,(file-remote-p tmp-name2 'localname)))) 5875 backup-directory-alist) 5876 (should 5877 (equal 5878 (find-backup-file-name tmp-name1) 5879 (list 5880 (funcall 5881 (if quoted #'tramp-compat-file-name-quote #'identity) 5882 (expand-file-name 5883 (format 5884 "%s~" 5885 ;; This is taken from `make-backup-file-name-1'. 5886 ;; We call `convert-standard-filename', because on 5887 ;; MS Windows the (local) colons must be replaced 5888 ;; by exclamation marks. 5889 (subst-char-in-string 5890 ?/ ?! 5891 (replace-regexp-in-string 5892 "!" "!!" (convert-standard-filename tmp-name1)))) 5893 tmp-name2))))) 5894 ;; The backup directory is created. 5895 (should (file-directory-p tmp-name2)))) 5896 5897 ;; Cleanup. 5898 (ignore-errors (delete-directory tmp-name2 'recursive))) 5899 5900 (unwind-protect 5901 ;; Create temporary file. This shall check for sensible 5902 ;; files, owned by root. 5903 (let ((backup-directory-alist `(("." . ,temporary-file-directory))) 5904 tramp-backup-directory-alist) 5905 (write-region "foo" nil tmp-name1) 5906 (when (zerop (or (file-attribute-user-id (file-attributes tmp-name1)) 5907 tramp-unknown-id-integer)) 5908 (tramp-cleanup-connection 5909 tramp-test-vec 'keep-debug 'keep-password) 5910 (let ((tramp-allow-unsafe-temporary-files t)) 5911 (should (stringp (car (find-backup-file-name tmp-name1))))) 5912 (tramp-cleanup-connection 5913 tramp-test-vec 'keep-debug 'keep-password) 5914 (cl-letf (((symbol-function #'yes-or-no-p) #'ignore)) 5915 (should-error 5916 (find-backup-file-name tmp-name1) 5917 :type 'file-error)) 5918 (tramp-cleanup-connection 5919 tramp-test-vec 'keep-debug 'keep-password) 5920 (cl-letf (((symbol-function #'yes-or-no-p) 5921 #'tramp--test-always)) 5922 (should (stringp (car (find-backup-file-name tmp-name1))))))) 5923 5924 ;; Cleanup. 5925 (ignore-errors (delete-file tmp-name1)) 5926 (tramp-cleanup-connection tramp-test-vec 'keep-debug 'keep-password))))) 5927 5928;; The functions were introduced in Emacs 28.1. 5929(ert-deftest tramp-test39-make-lock-file-name () 5930 "Check `make-lock-file-name', `lock-file', `unlock-file' and `file-locked-p'." 5931 (skip-unless (tramp--test-enabled)) 5932 (skip-unless (not (tramp--test-ange-ftp-p))) 5933 ;; Since Emacs 28.1. 5934 (skip-unless (and (fboundp 'lock-file) (fboundp 'unlock-file))) 5935 (skip-unless (and (fboundp 'file-locked-p) (fboundp 'make-lock-file-name))) 5936 5937 ;; `lock-file', `unlock-file', `file-locked-p' and 5938 ;; `make-lock-file-name' exists since Emacs 28.1. We don't want to 5939 ;; see compiler warnings for older Emacsen. 5940 (dolist (quoted (if (tramp--test-expensive-test-p) '(nil t) '(nil))) 5941 (let ((tmp-name1 (tramp--test-make-temp-name nil quoted)) 5942 (tmp-name2 (tramp--test-make-temp-name nil quoted)) 5943 (remote-file-name-inhibit-cache t) 5944 (remote-file-name-inhibit-locks nil) 5945 (create-lockfiles t) 5946 tramp-allow-unsafe-temporary-files 5947 (inhibit-message t) 5948 ;; tramp-rclone.el and tramp-sshfs.el cache the mounted files. 5949 (tramp-fuse-unmount-on-cleanup t) 5950 auto-save-default 5951 noninteractive) 5952 5953 (unwind-protect 5954 (progn 5955 ;; A simple file lock. 5956 (should-not (with-no-warnings (file-locked-p tmp-name1))) 5957 (with-no-warnings (lock-file tmp-name1)) 5958 (should (eq (with-no-warnings (file-locked-p tmp-name1)) t)) 5959 5960 ;; If it is locked already, nothing changes. 5961 (with-no-warnings (lock-file tmp-name1)) 5962 (should (eq (with-no-warnings (file-locked-p tmp-name1)) t)) 5963 5964 ;; `save-buffer' removes the lock. 5965 (with-temp-buffer 5966 (set-visited-file-name tmp-name1) 5967 (insert "foo") 5968 (save-buffer)) 5969 (should-not (with-no-warnings (file-locked-p tmp-name1))) 5970 (with-no-warnings (lock-file tmp-name1)) 5971 (should (eq (with-no-warnings (file-locked-p tmp-name1)) t)) 5972 5973 ;; A new connection changes process id, and also the 5974 ;; lockname contents. 5975 (tramp-cleanup-connection tramp-test-vec 'keep-debug 'keep-password) 5976 (should (stringp (with-no-warnings (file-locked-p tmp-name1)))) 5977 5978 ;; When `remote-file-name-inhibit-locks' is set, nothing happens. 5979 (tramp-cleanup-connection tramp-test-vec 'keep-debug 'keep-password) 5980 (let ((remote-file-name-inhibit-locks t)) 5981 (with-no-warnings (lock-file tmp-name1)) 5982 (should-not (with-no-warnings (file-locked-p tmp-name1)))) 5983 5984 ;; When `lock-file-name-transforms' is set, another lock 5985 ;; file is used. 5986 (tramp-cleanup-connection tramp-test-vec 'keep-debug 'keep-password) 5987 (let ((lock-file-name-transforms `((".*" ,tmp-name2)))) 5988 (should 5989 (string-equal 5990 (with-no-warnings (make-lock-file-name tmp-name1)) 5991 (with-no-warnings (make-lock-file-name tmp-name2)))) 5992 (with-no-warnings (lock-file tmp-name1)) 5993 (should (eq (with-no-warnings (file-locked-p tmp-name1)) t)) 5994 (with-no-warnings (unlock-file tmp-name1)) 5995 (should-not (with-no-warnings (file-locked-p tmp-name1)))) 5996 5997 ;; Steal the file lock. 5998 (tramp-cleanup-connection tramp-test-vec 'keep-debug 'keep-password) 5999 (cl-letf (((symbol-function #'read-char) (lambda (&rest _args) ?s))) 6000 (with-no-warnings (lock-file tmp-name1))) 6001 (should (eq (with-no-warnings (file-locked-p tmp-name1)) t)) 6002 6003 ;; Ignore the file lock. 6004 (tramp-cleanup-connection tramp-test-vec 'keep-debug 'keep-password) 6005 (cl-letf (((symbol-function #'read-char) (lambda (&rest _args) ?p))) 6006 (with-no-warnings (lock-file tmp-name1))) 6007 (should (stringp (with-no-warnings (file-locked-p tmp-name1)))) 6008 6009 ;; Quit the file lock machinery. 6010 (tramp-cleanup-connection tramp-test-vec 'keep-debug 'keep-password) 6011 (cl-letf (((symbol-function #'read-char) (lambda (&rest _args) ?q))) 6012 (with-no-warnings 6013 (should-error 6014 (lock-file tmp-name1) 6015 :type 'file-locked)) 6016 ;; The same for `write-region'. 6017 (should-error 6018 (write-region "foo" nil tmp-name1) 6019 :type 'file-locked) 6020 (should-error 6021 (write-region "foo" nil tmp-name1 nil nil tmp-name1) 6022 :type 'file-locked) 6023 ;; The same for `set-visited-file-name'. 6024 (with-temp-buffer 6025 (should-error 6026 (set-visited-file-name tmp-name1) 6027 :type 'file-locked))) 6028 (should (stringp (with-no-warnings (file-locked-p tmp-name1))))) 6029 6030 ;; Cleanup. 6031 (ignore-errors (delete-file tmp-name1)) 6032 (with-no-warnings (unlock-file tmp-name1)) 6033 (with-no-warnings (unlock-file tmp-name2)) 6034 (should-not (with-no-warnings (file-locked-p tmp-name1))) 6035 (should-not (with-no-warnings (file-locked-p tmp-name2)))) 6036 6037 (unwind-protect 6038 ;; Create temporary file. This shall check for sensible 6039 ;; files, owned by root. 6040 (let ((lock-file-name-transforms auto-save-file-name-transforms)) 6041 (write-region "foo" nil tmp-name1) 6042 (when (zerop (or (file-attribute-user-id (file-attributes tmp-name1)) 6043 tramp-unknown-id-integer)) 6044 (tramp-cleanup-connection 6045 tramp-test-vec 'keep-debug 'keep-password) 6046 (cl-letf (((symbol-function #'yes-or-no-p) #'ignore)) 6047 (should-error 6048 (write-region "foo" nil tmp-name1) 6049 :type 'file-error)) 6050 (tramp-cleanup-connection 6051 tramp-test-vec 'keep-debug 'keep-password) 6052 (cl-letf (((symbol-function #'yes-or-no-p) 6053 #'tramp--test-always)) 6054 (write-region "foo" nil tmp-name1)))) 6055 6056 ;; Cleanup. 6057 (ignore-errors (delete-file tmp-name1)) 6058 (tramp-cleanup-connection tramp-test-vec 'keep-debug 'keep-password))))) 6059 6060(ert-deftest tramp-test40-make-nearby-temp-file () 6061 "Check `make-nearby-temp-file' and `temporary-file-directory'." 6062 (skip-unless (tramp--test-enabled)) 6063 (skip-unless (not (tramp--test-ange-ftp-p))) 6064 6065 (let ((default-directory tramp-test-temporary-file-directory) 6066 tmp-file) 6067 ;; The remote host shall know a temporary file directory. 6068 (should (stringp (temporary-file-directory))) 6069 (should 6070 (string-equal 6071 (file-remote-p default-directory) 6072 (file-remote-p (temporary-file-directory)))) 6073 6074 ;; The temporary file shall be located on the remote host. 6075 (setq tmp-file (make-nearby-temp-file "tramp-test")) 6076 (should (file-exists-p tmp-file)) 6077 (should (file-regular-p tmp-file)) 6078 (should 6079 (string-equal 6080 (file-remote-p default-directory) 6081 (file-remote-p tmp-file))) 6082 (delete-file tmp-file) 6083 (should-not (file-exists-p tmp-file)) 6084 6085 (setq tmp-file (make-nearby-temp-file "tramp-test" 'dir)) 6086 (should (file-exists-p tmp-file)) 6087 (should (file-directory-p tmp-file)) 6088 (delete-directory tmp-file) 6089 (should-not (file-exists-p tmp-file)))) 6090 6091(defun tramp--test-emacs27-p () 6092 "Check for Emacs version >= 27.1. 6093Some semantics has been changed for there, w/o new functions or 6094variables, so we check the Emacs version directly." 6095 (>= emacs-major-version 27)) 6096 6097(defun tramp--test-emacs28-p () 6098 "Check for Emacs version >= 28.1. 6099Some semantics has been changed for there, w/o new functions or 6100variables, so we check the Emacs version directly." 6101 (>= emacs-major-version 28)) 6102 6103(defun tramp--test-emacs29-p () 6104 "Check for Emacs version >= 29.1. 6105Some semantics has been changed for there, w/o new functions or 6106variables, so we check the Emacs version directly." 6107 (>= emacs-major-version 29)) 6108 6109(defun tramp--test-adb-p () 6110 "Check, whether the remote host runs Android. 6111This requires restrictions of file name syntax." 6112 (tramp-adb-file-name-p tramp-test-temporary-file-directory)) 6113 6114(defun tramp--test-ange-ftp-p () 6115 "Check, whether Ange-FTP is used." 6116 (eq 6117 (tramp-find-foreign-file-name-handler tramp-test-temporary-file-directory) 6118 'tramp-ftp-file-name-handler)) 6119 6120(defun tramp--test-asynchronous-processes-p () 6121 "Whether asynchronous processes tests are run. 6122This is used in tests which we dont't want to tag 6123`:tramp-asynchronous-processes' completely." 6124 (ert-select-tests 6125 (ert--stats-selector ert--current-run-stats) 6126 (list (make-ert-test :name (ert-test-name (ert-running-test)) 6127 :body nil :tags '(:tramp-asynchronous-processes))))) 6128 6129(defun tramp--test-crypt-p () 6130 "Check, whether the remote directory is crypted." 6131 (tramp-crypt-file-name-p tramp-test-temporary-file-directory)) 6132 6133(defun tramp--test-docker-p () 6134 "Check, whether the docker method is used. 6135This does not support some special file names." 6136 (string-equal 6137 "docker" (file-remote-p tramp-test-temporary-file-directory 'method))) 6138 6139(defun tramp--test-expensive-test-p () 6140 "Whether expensive tests are run. 6141This is used in tests which we dont't want to tag `:expensive' 6142completely." 6143 (ert-select-tests 6144 (ert--stats-selector ert--current-run-stats) 6145 (list (make-ert-test :name (ert-test-name (ert-running-test)) 6146 :body nil :tags '(:expensive-test))))) 6147 6148(defun tramp--test-ftp-p () 6149 "Check, whether an FTP-like method is used. 6150This does not support globbing characters in file names (yet)." 6151 ;; Globbing characters are ??, ?* and ?\[. 6152 (string-match-p 6153 "ftp$" (file-remote-p tramp-test-temporary-file-directory 'method))) 6154 6155(defun tramp--test-fuse-p () 6156 "Check, whether an FUSE file system isused." 6157 (or (tramp--test-rclone-p) (tramp--test-sshfs-p))) 6158 6159(defun tramp--test-gdrive-p () 6160 "Check, whether the gdrive method is used." 6161 (string-equal 6162 "gdrive" (file-remote-p tramp-test-temporary-file-directory 'method))) 6163 6164(defun tramp--test-gvfs-p (&optional method) 6165 "Check, whether the remote host runs a GVFS based method. 6166This requires restrictions of file name syntax. 6167If optional METHOD is given, it is checked first." 6168 (or (member method tramp-gvfs-methods) 6169 (tramp-gvfs-file-name-p tramp-test-temporary-file-directory))) 6170 6171(defun tramp--test-hpux-p () 6172 "Check, whether the remote host runs HP-UX. 6173Several special characters do not work properly there." 6174 ;; We must refill the cache. `file-truename' does it. 6175 (file-truename tramp-test-temporary-file-directory) 6176 (tramp-check-remote-uname tramp-test-vec "^HP-UX")) 6177 6178(defun tramp--test-ksh-p () 6179 "Check, whether the remote shell is ksh. 6180ksh93 makes some strange conversions of non-latin characters into 6181a $'' syntax." 6182 ;; We must refill the cache. `file-truename' does it. 6183 (file-truename tramp-test-temporary-file-directory) 6184 (string-match-p 6185 "ksh$" (tramp-get-connection-property tramp-test-vec "remote-shell" ""))) 6186 6187(defun tramp--test-macos-p () 6188 "Check, whether the remote host runs macOS." 6189 ;; We must refill the cache. `file-truename' does it. 6190 (file-truename tramp-test-temporary-file-directory) 6191 (tramp-check-remote-uname tramp-test-vec "Darwin")) 6192 6193(defun tramp--test-mock-p () 6194 "Check, whether the mock method is used. 6195This does not support external Emacs calls." 6196 (string-equal 6197 "mock" (file-remote-p tramp-test-temporary-file-directory 'method))) 6198 6199(defun tramp--test-out-of-band-p () 6200 "Check, whether an out-of-band method is used." 6201 (tramp-method-out-of-band-p tramp-test-vec 1)) 6202 6203(defun tramp--test-rclone-p () 6204 "Check, whether the remote host is offered by rclone. 6205This requires restrictions of file name syntax." 6206 (tramp-rclone-file-name-p tramp-test-temporary-file-directory)) 6207 6208(defun tramp--test-rsync-p () 6209 "Check, whether the rsync method is used. 6210This does not support special file names." 6211 (string-equal 6212 "rsync" (file-remote-p tramp-test-temporary-file-directory 'method))) 6213 6214(defun tramp--test-sh-p () 6215 "Check, whether the remote host runs a based method from tramp-sh.el." 6216 (tramp-sh-file-name-handler-p tramp-test-vec)) 6217 6218(defun tramp--test-sh-no-ls--dired-p () 6219 "Check, whether the remote host runs a based method from tramp-sh.el. 6220Additionally, ls does not support \"--dired\"." 6221 (and (tramp--test-sh-p) 6222 (with-temp-buffer 6223 ;; We must refill the cache. `insert-directory' does it. 6224 ;; This fails for tramp-crypt.el, so we ignore that. 6225 (ignore-errors 6226 (insert-directory tramp-test-temporary-file-directory "-al")) 6227 (not (tramp-get-connection-property tramp-test-vec "ls--dired" nil))))) 6228 6229(defun tramp--test-share-p () 6230 "Check, whether the method needs a share." 6231 (and (tramp--test-gvfs-p) 6232 (string-match-p 6233 "^\\(afp\\|davs?\\|smb\\)$" 6234 (file-remote-p tramp-test-temporary-file-directory 'method)))) 6235 6236(defun tramp--test-sshfs-p () 6237 "Check, whether the remote host is offered by sshfs. 6238This requires restrictions of file name syntax." 6239 (tramp-sshfs-file-name-p tramp-test-temporary-file-directory)) 6240 6241(defun tramp--test-sudoedit-p () 6242 "Check, whether the sudoedit method is used." 6243 (tramp-sudoedit-file-name-p tramp-test-temporary-file-directory)) 6244 6245(defun tramp--test-telnet-p () 6246 "Check, whether the telnet method is used. 6247This does not support special file names." 6248 (string-equal 6249 "telnet" (file-remote-p tramp-test-temporary-file-directory 'method))) 6250 6251(defun tramp--test-windows-nt-p () 6252 "Check, whether the locale host runs MS Windows." 6253 (eq system-type 'windows-nt)) 6254 6255(defun tramp--test-windows-nt-and-out-of-band-p () 6256 "Check, whether the locale host runs MS Windows and an out-of-band method. 6257This does not support utf8 based file transfer." 6258 (and (tramp--test-windows-nt-p) 6259 (tramp--test-out-of-band-p))) 6260 6261(defun tramp--test-windows-nt-or-smb-p () 6262 "Check, whether the locale or remote host runs MS Windows. 6263This requires restrictions of file name syntax." 6264 (or (tramp--test-windows-nt-p) 6265 (tramp--test-smb-p))) 6266 6267(defun tramp--test-smb-p () 6268 "Check, whether the locale or remote host runs MS Windows. 6269This requires restrictions of file name syntax." 6270 (tramp-smb-file-name-p tramp-test-temporary-file-directory)) 6271 6272(defun tramp--test-supports-processes-p () 6273 "Return whether the method under test supports external processes." 6274 (and (or (tramp--test-adb-p) (tramp--test-sh-p) (tramp--test-sshfs-p)) 6275 (not (tramp--test-crypt-p)))) 6276 6277(defun tramp--test-supports-set-file-modes-p () 6278 "Return whether the method under test supports setting file modes." 6279 ;; "smb" does not unless the SMB server supports "posix" extensions. 6280 ;; "adb" does not unless the Android device is rooted. 6281 (or (tramp--test-sh-p) (tramp--test-sshfs-p) (tramp--test-sudoedit-p) 6282 ;; Not all tramp-gvfs.el methods support changing the file mode. 6283 (and 6284 (tramp--test-gvfs-p) 6285 (string-match-p 6286 "ftp" (file-remote-p tramp-test-temporary-file-directory 'method))))) 6287 6288(defun tramp--test-check-files (&rest files) 6289 "Run a simple but comprehensive test over every file in FILES." 6290 ;; `filename-non-special' has been fixed in Emacs 27.1, see Bug#29579. 6291 (dolist (quoted 6292 (if (and (tramp--test-expensive-test-p) (tramp--test-emacs27-p)) 6293 '(nil t) '(nil))) 6294 ;; We must use `file-truename' for the temporary directory, 6295 ;; because it could be located on a symlinked directory. This 6296 ;; would let the test fail. 6297 (let* ((tramp-test-temporary-file-directory 6298 (file-truename tramp-test-temporary-file-directory)) 6299 (tmp-name1 (tramp--test-make-temp-name nil quoted)) 6300 (tmp-name2 (tramp--test-make-temp-name 'local quoted)) 6301 (files 6302 (delq 6303 nil (mapcar (lambda (x) (unless (string-empty-p x) x)) files))) 6304 (process-environment process-environment) 6305 (sorted-files (sort (copy-sequence files) #'string-lessp)) 6306 buffer) 6307 (unwind-protect 6308 (progn 6309 (make-directory tmp-name1) 6310 (make-directory tmp-name2) 6311 6312 (dolist (elt files) 6313 ;(tramp--test-message "'%s'" elt) 6314 (let* ((file1 (expand-file-name elt tmp-name1)) 6315 (file2 (expand-file-name elt tmp-name2)) 6316 (file3 (expand-file-name (concat elt "foo") tmp-name1))) 6317 (write-region elt nil file1) 6318 (should (file-exists-p file1)) 6319 6320 ;; Check file contents. 6321 (with-temp-buffer 6322 (insert-file-contents file1) 6323 (should (string-equal (buffer-string) elt))) 6324 6325 ;; Copy file both directions. 6326 (copy-file file1 (file-name-as-directory tmp-name2)) 6327 (should (file-exists-p file2)) 6328 (delete-file file1) 6329 (should-not (file-exists-p file1)) 6330 (copy-file file2 (file-name-as-directory tmp-name1)) 6331 (should (file-exists-p file1)) 6332 6333 (tramp--test-ignore-make-symbolic-link-error 6334 (make-symbolic-link file1 file3) 6335 (should (file-symlink-p file3)) 6336 (should 6337 (string-equal 6338 (expand-file-name file1) (file-truename file3))) 6339 (should 6340 (string-equal 6341 (funcall 6342 (if quoted #'tramp-compat-file-name-quote #'identity) 6343 (file-attribute-type (file-attributes file3))) 6344 (file-remote-p (file-truename file1) 'localname))) 6345 ;; Check file contents. 6346 (with-temp-buffer 6347 (insert-file-contents file3) 6348 (should (string-equal (buffer-string) elt))) 6349 (delete-file file3)))) 6350 6351 ;; Check file names. 6352 (should (equal (directory-files 6353 tmp-name1 nil directory-files-no-dot-files-regexp) 6354 sorted-files)) 6355 (should (equal (directory-files 6356 tmp-name2 nil directory-files-no-dot-files-regexp) 6357 sorted-files)) 6358 (should (equal (mapcar 6359 #'car 6360 (directory-files-and-attributes 6361 tmp-name1 nil directory-files-no-dot-files-regexp)) 6362 sorted-files)) 6363 (should (equal (mapcar 6364 #'car 6365 (directory-files-and-attributes 6366 tmp-name2 nil directory-files-no-dot-files-regexp)) 6367 sorted-files)) 6368 6369 ;; Check, that `insert-directory' works properly. 6370 (with-current-buffer 6371 (setq buffer (dired-noselect tmp-name1 "--dired -al")) 6372 (goto-char (point-min)) 6373 (while (not (eobp)) 6374 (when-let ((name (dired-get-filename 'no-dir 'no-error))) 6375 (unless 6376 (string-match-p name directory-files-no-dot-files-regexp) 6377 (should (member name files)))) 6378 (forward-line 1))) 6379 (kill-buffer buffer) 6380 6381 ;; `substitute-in-file-name' could return different 6382 ;; values. For "adb", there could be strange file 6383 ;; permissions preventing overwriting a file. We don't 6384 ;; care in this test case. 6385 (dolist (elt files) 6386 (let ((file1 6387 (substitute-in-file-name (expand-file-name elt tmp-name1))) 6388 (file2 6389 (substitute-in-file-name 6390 (expand-file-name elt tmp-name2)))) 6391 (ignore-errors (write-region elt nil file1)) 6392 (should (file-exists-p file1)) 6393 (ignore-errors (write-region elt nil file2 nil 'nomessage)) 6394 (should (file-exists-p file2)))) 6395 6396 (should (equal (directory-files 6397 tmp-name1 nil directory-files-no-dot-files-regexp) 6398 (directory-files 6399 tmp-name2 nil directory-files-no-dot-files-regexp))) 6400 6401 ;; Check directory creation. We use a subdirectory "foo" 6402 ;; in order to avoid conflicts with previous file name tests. 6403 (dolist (elt files) 6404 (let* ((elt1 (concat elt "foo")) 6405 (file1 (expand-file-name (concat "foo/" elt) tmp-name1)) 6406 (file2 (expand-file-name elt file1)) 6407 (file3 (expand-file-name elt1 file1))) 6408 (make-directory file1 'parents) 6409 (should (file-directory-p file1)) 6410 (write-region elt nil file2) 6411 (should (file-exists-p file2)) 6412 (should 6413 (equal 6414 (directory-files 6415 file1 nil directory-files-no-dot-files-regexp) 6416 `(,elt))) 6417 (should 6418 (equal 6419 (caar (directory-files-and-attributes 6420 file1 nil directory-files-no-dot-files-regexp)) 6421 elt)) 6422 6423 ;; Check symlink in `directory-files-and-attributes'. 6424 ;; It does not work in the "smb" case, only relative 6425 ;; symlinks to existing files are shown there. 6426 (tramp--test-ignore-make-symbolic-link-error 6427 (unless (tramp--test-smb-p) 6428 (make-symbolic-link file2 file3) 6429 (should (file-symlink-p file3)) 6430 (should 6431 (string-equal 6432 (caar (directory-files-and-attributes 6433 file1 nil (regexp-quote elt1))) 6434 elt1)) 6435 (should 6436 (string-equal 6437 (funcall 6438 (if quoted #'tramp-compat-file-name-quote #'identity) 6439 (cadr (car (directory-files-and-attributes 6440 file1 nil (regexp-quote elt1))))) 6441 (file-remote-p (file-truename file2) 'localname))) 6442 (delete-file file3) 6443 (should-not (file-exists-p file3)))) 6444 6445 (delete-file file2) 6446 (should-not (file-exists-p file2)) 6447 (delete-directory file1) 6448 (should-not (file-exists-p file1)))) 6449 6450 ;; Check, that environment variables are set correctly. 6451 ;; We do not run on macOS due to encoding problems. See 6452 ;; Bug#36940. 6453 (when (and (tramp--test-expensive-test-p) (tramp--test-sh-p) 6454 (not (tramp--test-crypt-p)) 6455 (not (eq system-type 'darwin))) 6456 (dolist (elt files) 6457 (let ((envvar (concat "VAR_" (upcase (md5 elt)))) 6458 (elt (encode-coding-string elt coding-system-for-read)) 6459 (default-directory tramp-test-temporary-file-directory) 6460 (process-environment process-environment)) 6461 (setenv envvar elt) 6462 ;; The value of PS1 could confuse Tramp's detection 6463 ;; of process output. So we unset it temporarily. 6464 (setenv "PS1") 6465 (with-temp-buffer 6466 (should (zerop (process-file "printenv" nil t nil))) 6467 (goto-char (point-min)) 6468 (should 6469 (re-search-forward 6470 (format 6471 "^%s=%s$" 6472 (regexp-quote envvar) 6473 (regexp-quote (getenv envvar)))))))))) 6474 6475 ;; Cleanup. 6476 (ignore-errors (kill-buffer buffer)) 6477 (ignore-errors (delete-directory tmp-name1 'recursive)) 6478 (ignore-errors (delete-directory tmp-name2 'recursive)))))) 6479 6480(defun tramp--test-special-characters () 6481 "Perform the test in `tramp-test41-special-characters*'." 6482 ;; Newlines, slashes and backslashes in file names are not 6483 ;; supported. So we don't test. And we don't test the tab 6484 ;; character on Windows or Cygwin, because the backslash is 6485 ;; interpreted as a path separator, preventing "\t" from being 6486 ;; expanded to <TAB>. 6487 (let ((files 6488 (list 6489 (cond ((or (tramp--test-ange-ftp-p) 6490 (tramp--test-docker-p) 6491 (tramp--test-gvfs-p) 6492 (tramp--test-rclone-p) 6493 (tramp--test-sudoedit-p) 6494 (tramp--test-windows-nt-or-smb-p)) 6495 "foo bar baz") 6496 ((or (tramp--test-adb-p) 6497 (eq system-type 'cygwin)) 6498 " foo bar baz ") 6499 ((tramp--test-sh-no-ls--dired-p) 6500 "\tfoo bar baz\t") 6501 (t " foo\tbar baz\t")) 6502 "@foo@bar@baz@" 6503 (unless (tramp--test-windows-nt-and-out-of-band-p) "$foo$bar$$baz$") 6504 "-foo-bar-baz-" 6505 (unless (tramp--test-windows-nt-and-out-of-band-p) "%foo%bar%baz%") 6506 "&foo&bar&baz&" 6507 (unless (or (tramp--test-ftp-p) 6508 (tramp--test-gvfs-p) 6509 (tramp--test-windows-nt-or-smb-p)) 6510 "?foo?bar?baz?") 6511 (unless (or (tramp--test-ftp-p) 6512 (tramp--test-gvfs-p) 6513 (tramp--test-windows-nt-or-smb-p)) 6514 "*foo*bar*baz*") 6515 (if (or (tramp--test-gvfs-p) (tramp--test-windows-nt-or-smb-p)) 6516 "'foo'bar'baz'" 6517 "'foo\"bar'baz\"") 6518 "#foo~bar#baz~" 6519 (unless (tramp--test-windows-nt-and-out-of-band-p) 6520 (if (or (tramp--test-gvfs-p) (tramp--test-windows-nt-or-smb-p)) 6521 "!foo!bar!baz!" 6522 "!foo|bar!baz|")) 6523 (if (or (tramp--test-gvfs-p) 6524 (tramp--test-rclone-p) 6525 (tramp--test-windows-nt-or-smb-p)) 6526 ";foo;bar;baz;" 6527 ":foo;bar:baz;") 6528 (unless (or (tramp--test-gvfs-p) (tramp--test-windows-nt-or-smb-p)) 6529 "<foo>bar<baz>") 6530 "(foo)bar(baz)" 6531 (unless (or (tramp--test-ftp-p) (tramp--test-gvfs-p)) "[foo]bar[baz]") 6532 "{foo}bar{baz}"))) 6533 ;; Simplify test in order to speed up. 6534 (apply #'tramp--test-check-files 6535 (if (tramp--test-expensive-test-p) 6536 files (list (mapconcat #'identity files "")))))) 6537 6538;; These tests are inspired by Bug#17238. 6539(ert-deftest tramp-test41-special-characters () 6540 "Check special characters in file names." 6541 (skip-unless (not (getenv "EMACS_HYDRA_CI"))) ; SLOW ~ 245s 6542 (skip-unless (tramp--test-enabled)) 6543 (skip-unless (not (tramp--test-rsync-p))) 6544 (skip-unless (not (tramp--test-rclone-p))) 6545 6546 (tramp--test-special-characters)) 6547 6548(ert-deftest tramp-test41-special-characters-with-stat () 6549 "Check special characters in file names. 6550Use the \"stat\" command." 6551 :tags '(:expensive-test) 6552 (skip-unless (not (getenv "EMACS_HYDRA_CI"))) ; SLOW ~ 287s 6553 (skip-unless (tramp--test-enabled)) 6554 (skip-unless (tramp--test-sh-p)) 6555 (skip-unless (not (tramp--test-rsync-p))) 6556 ;; We cannot use `tramp-test-vec', because this fails during compilation. 6557 (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil 6558 (skip-unless (tramp-get-remote-stat v))) 6559 6560 (let ((tramp-connection-properties 6561 (append 6562 `((,(regexp-quote (file-remote-p tramp-test-temporary-file-directory)) 6563 "perl" nil)) 6564 tramp-connection-properties))) 6565 (tramp--test-special-characters))) 6566 6567(ert-deftest tramp-test41-special-characters-with-perl () 6568 "Check special characters in file names. 6569Use the \"perl\" command." 6570 :tags '(:expensive-test) 6571 (skip-unless (not (getenv "EMACS_HYDRA_CI"))) ; SLOW ~ 266s 6572 (skip-unless (tramp--test-enabled)) 6573 (skip-unless (tramp--test-sh-p)) 6574 (skip-unless (not (tramp--test-rsync-p))) 6575 ;; We cannot use `tramp-test-vec', because this fails during compilation. 6576 (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil 6577 (skip-unless (tramp-get-remote-perl v))) 6578 6579 (let ((tramp-connection-properties 6580 (append 6581 `((,(regexp-quote (file-remote-p tramp-test-temporary-file-directory)) 6582 "stat" nil) 6583 ;; See `tramp-sh-handle-file-truename'. 6584 (,(regexp-quote (file-remote-p tramp-test-temporary-file-directory)) 6585 "readlink" nil)) 6586 tramp-connection-properties))) 6587 (tramp--test-special-characters))) 6588 6589(ert-deftest tramp-test41-special-characters-with-ls () 6590 "Check special characters in file names. 6591Use the \"ls\" command." 6592 :tags '(:expensive-test) 6593 (skip-unless (not (getenv "EMACS_HYDRA_CI"))) ; SLOW ~ 287s 6594 (skip-unless (tramp--test-enabled)) 6595 (skip-unless (tramp--test-sh-p)) 6596 (skip-unless (not (tramp--test-rsync-p))) 6597 6598 (let ((tramp-connection-properties 6599 (append 6600 `((,(regexp-quote (file-remote-p tramp-test-temporary-file-directory)) 6601 "perl" nil) 6602 (,(regexp-quote (file-remote-p tramp-test-temporary-file-directory)) 6603 "stat" nil) 6604 ;; See `tramp-sh-handle-file-truename'. 6605 (,(regexp-quote (file-remote-p tramp-test-temporary-file-directory)) 6606 "readlink" nil)) 6607 tramp-connection-properties))) 6608 (tramp--test-special-characters))) 6609 6610(defun tramp--test-utf8 () 6611 "Perform the test in `tramp-test42-utf8*'." 6612 (let* ((utf8 (if (and (eq system-type 'darwin) 6613 (memq 'utf-8-hfs (coding-system-list))) 6614 'utf-8-hfs 'utf-8)) 6615 (coding-system-for-read utf8) 6616 (coding-system-for-write utf8) 6617 (file-name-coding-system 6618 (coding-system-change-eol-conversion utf8 'unix))) 6619 (apply 6620 #'tramp--test-check-files 6621 (append 6622 (list 6623 (unless (tramp--test-hpux-p) "Γυρίστε το Γαλαξία με Ώτο Στοπ") 6624 (unless (tramp--test-hpux-p) 6625 "أصبح بوسعك الآن تنزيل نسخة كاملة من موسوعة ويكيبيديا العربية لتصفحها بلا اتصال بالإنترنت") 6626 "银河系漫游指南系列" 6627 "Автостопом по гала́ктике" 6628 ;; Use codepoints without a name. See Bug#31272. 6629 "™›šbung" 6630 ;; Use codepoints from Supplementary Multilingual Plane (U+10000 6631 ;; to U+1FFFF). 6632 "������") 6633 6634 (when (tramp--test-expensive-test-p) 6635 (delete-dups 6636 (mapcar 6637 ;; Use all available language specific snippets. 6638 (lambda (x) 6639 (and 6640 (stringp (setq x (eval (get-language-info (car x) 'sample-text) t))) 6641 ;; Filter out strings which use unencodable characters. 6642 (not (and (or (tramp--test-gvfs-p) (tramp--test-smb-p)) 6643 (unencodable-char-position 6644 0 (length x) file-name-coding-system nil x))) 6645 ;; Filter out not displayable characters. 6646 (setq x (mapconcat 6647 (lambda (y) 6648 (and (char-displayable-p y) (char-to-string y))) 6649 x "")) 6650 (not (string-empty-p x)) 6651 ;; ?\n and ?/ shouldn't be part of any file name. ?\t, 6652 ;; ?. and ?? do not work for "smb" method. " " does not 6653 ;; work at begin or end of the string for MS Windows. 6654 (replace-regexp-in-string "[ \t\n/.?]" "" x))) 6655 language-info-alist))))))) 6656 6657(ert-deftest tramp-test42-utf8 () 6658 "Check UTF8 encoding in file names and file contents." 6659 (skip-unless (not (getenv "EMACS_HYDRA_CI"))) ; SLOW ~ 620s 6660 (skip-unless (tramp--test-enabled)) 6661 (skip-unless (not (tramp--test-docker-p))) 6662 (skip-unless (not (tramp--test-rsync-p))) 6663 (skip-unless (not (tramp--test-windows-nt-and-out-of-band-p))) 6664 (skip-unless (not (tramp--test-ksh-p))) 6665 (skip-unless (not (tramp--test-gdrive-p))) 6666 (skip-unless (not (tramp--test-crypt-p))) 6667 (skip-unless (not (tramp--test-rclone-p))) 6668 6669 (tramp--test-utf8)) 6670 6671(ert-deftest tramp-test42-utf8-with-stat () 6672 "Check UTF8 encoding in file names and file contents. 6673Use the \"stat\" command." 6674 :tags '(:expensive-test) 6675 (skip-unless (not (getenv "EMACS_HYDRA_CI"))) ; SLOW ~ 595s 6676 (skip-unless (tramp--test-enabled)) 6677 (skip-unless (tramp--test-sh-p)) 6678 (skip-unless (not (tramp--test-docker-p))) 6679 (skip-unless (not (tramp--test-rsync-p))) 6680 (skip-unless (not (tramp--test-out-of-band-p))) ; SLOW 6681 (skip-unless (not (tramp--test-ksh-p))) 6682 (skip-unless (not (tramp--test-crypt-p))) 6683 ;; We cannot use `tramp-test-vec', because this fails during compilation. 6684 (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil 6685 (skip-unless (tramp-get-remote-stat v))) 6686 6687 (let ((tramp-connection-properties 6688 (append 6689 `((,(regexp-quote (file-remote-p tramp-test-temporary-file-directory)) 6690 "perl" nil)) 6691 tramp-connection-properties))) 6692 (tramp--test-utf8))) 6693 6694(ert-deftest tramp-test42-utf8-with-perl () 6695 "Check UTF8 encoding in file names and file contents. 6696Use the \"perl\" command." 6697 :tags '(:expensive-test) 6698 (skip-unless (not (getenv "EMACS_HYDRA_CI"))) ; SLOW ~ 620s 6699 (skip-unless (tramp--test-enabled)) 6700 (skip-unless (tramp--test-sh-p)) 6701 (skip-unless (not (tramp--test-docker-p))) 6702 (skip-unless (not (tramp--test-rsync-p))) 6703 (skip-unless (not (tramp--test-out-of-band-p))) ; SLOW 6704 (skip-unless (not (tramp--test-ksh-p))) 6705 (skip-unless (not (tramp--test-crypt-p))) 6706 ;; We cannot use `tramp-test-vec', because this fails during compilation. 6707 (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil 6708 (skip-unless (tramp-get-remote-perl v))) 6709 6710 (let ((tramp-connection-properties 6711 (append 6712 `((,(regexp-quote (file-remote-p tramp-test-temporary-file-directory)) 6713 "stat" nil) 6714 ;; See `tramp-sh-handle-file-truename'. 6715 (,(regexp-quote (file-remote-p tramp-test-temporary-file-directory)) 6716 "readlink" nil)) 6717 tramp-connection-properties))) 6718 (tramp--test-utf8))) 6719 6720(ert-deftest tramp-test42-utf8-with-ls () 6721 "Check UTF8 encoding in file names and file contents. 6722Use the \"ls\" command." 6723 :tags '(:expensive-test) 6724 (skip-unless (not (getenv "EMACS_HYDRA_CI"))) ; SLOW ~ 690s 6725 (skip-unless (tramp--test-enabled)) 6726 (skip-unless (tramp--test-sh-p)) 6727 (skip-unless (not (tramp--test-docker-p))) 6728 (skip-unless (not (tramp--test-rsync-p))) 6729 (skip-unless (not (tramp--test-out-of-band-p))) ; SLOW 6730 (skip-unless (not (tramp--test-ksh-p))) 6731 (skip-unless (not (tramp--test-crypt-p))) 6732 6733 (let ((tramp-connection-properties 6734 (append 6735 `((,(regexp-quote (file-remote-p tramp-test-temporary-file-directory)) 6736 "perl" nil) 6737 (,(regexp-quote (file-remote-p tramp-test-temporary-file-directory)) 6738 "stat" nil) 6739 ;; See `tramp-sh-handle-file-truename'. 6740 (,(regexp-quote (file-remote-p tramp-test-temporary-file-directory)) 6741 "readlink" nil)) 6742 tramp-connection-properties))) 6743 (tramp--test-utf8))) 6744 6745(ert-deftest tramp-test43-file-system-info () 6746 "Check that `file-system-info' returns proper values." 6747 (skip-unless (tramp--test-enabled)) 6748 ;; Since Emacs 27.1. 6749 (skip-unless (fboundp 'file-system-info)) 6750 6751 ;; `file-system-info' exists since Emacs 27.1. We don't want to see 6752 ;; compiler warnings for older Emacsen. 6753 (let ((fsi (with-no-warnings 6754 (file-system-info tramp-test-temporary-file-directory)))) 6755 (skip-unless fsi) 6756 (should (and (consp fsi) 6757 (= (length fsi) 3) 6758 (numberp (nth 0 fsi)) 6759 (numberp (nth 1 fsi)) 6760 (numberp (nth 2 fsi)))))) 6761 6762;; `tramp-test44-asynchronous-requests' could be blocked. So we set a 6763;; timeout of 300 seconds, and we send a SIGUSR1 signal after 300 6764;; seconds. Similar check is performed in the timer function. 6765(defconst tramp--test-asynchronous-requests-timeout 300 6766 "Timeout for `tramp-test44-asynchronous-requests'.") 6767 6768(defmacro tramp--test-with-proper-process-name-and-buffer (proc &rest body) 6769 "Set \"process-name\" and \"process-buffer\" connection properties. 6770The values are derived from PROC. Run BODY. 6771This is needed in timer functions as well as process filters and sentinels." 6772 ;; FIXME: For tramp-sshfs.el, `processp' does not work. 6773 (declare (indent 1) (debug (processp body))) 6774 `(let* ((v (tramp-get-connection-property ,proc "vector" nil)) 6775 (pname (tramp-get-connection-property v "process-name" nil)) 6776 (pbuffer (tramp-get-connection-property v "process-buffer" nil))) 6777 (tramp--test-message 6778 "tramp--test-with-proper-process-name-and-buffer before %s %s" 6779 (tramp-get-connection-property v "process-name" nil) 6780 (tramp-get-connection-property v "process-buffer" nil)) 6781 (if (process-name ,proc) 6782 (tramp-set-connection-property v "process-name" (process-name ,proc)) 6783 (tramp-flush-connection-property v "process-name")) 6784 (if (process-buffer ,proc) 6785 (tramp-set-connection-property 6786 v "process-buffer" (process-buffer ,proc)) 6787 (tramp-flush-connection-property v "process-buffer")) 6788 (tramp--test-message 6789 "tramp--test-with-proper-process-name-and-buffer changed %s %s" 6790 (tramp-get-connection-property v "process-name" nil) 6791 (tramp-get-connection-property v "process-buffer" nil)) 6792 (unwind-protect 6793 (progn ,@body) 6794 (if pname 6795 (tramp-set-connection-property v "process-name" pname) 6796 (tramp-flush-connection-property v "process-name")) 6797 (if pbuffer 6798 (tramp-set-connection-property v "process-buffer" pbuffer) 6799 (tramp-flush-connection-property v "process-buffer"))))) 6800 6801;; This test is inspired by Bug#16928. 6802(ert-deftest tramp-test44-asynchronous-requests () 6803 "Check parallel asynchronous requests. 6804Such requests could arrive from timers, process filters and 6805process sentinels. They shall not disturb each other." 6806 :tags (append '(:expensive-test :tramp-asynchronous-processes) 6807 (and (getenv "EMACS_HYDRA_CI") '(:unstable))) 6808 (skip-unless (tramp--test-enabled)) 6809 (skip-unless (tramp--test-supports-processes-p)) 6810 ;; Prior Emacs 27, `shell-file-name' was hard coded as "/bin/sh" for 6811 ;; remote processes in Emacs. That doesn't work for tramp-adb.el. 6812 (when (tramp--test-adb-p) 6813 (skip-unless (tramp--test-emacs27-p))) 6814 (skip-unless (not (tramp--test-docker-p))) 6815 (skip-unless (not (tramp--test-telnet-p))) 6816 (skip-unless (not (tramp--test-sshfs-p))) 6817 (skip-unless (not (tramp--test-windows-nt-p))) 6818 6819 (with-timeout 6820 (tramp--test-asynchronous-requests-timeout (tramp--test-timeout-handler)) 6821 (define-key special-event-map [sigusr1] #'tramp--test-timeout-handler) 6822 (let* (;; For the watchdog. 6823 (default-directory (expand-file-name temporary-file-directory)) 6824 (shell-file-name (tramp--test-shell-file-name)) 6825 ;; It doesn't work on w32 systems. 6826 (watchdog 6827 (start-process-shell-command 6828 "*watchdog*" nil 6829 (format 6830 "sleep %d; kill -USR1 %d" 6831 tramp--test-asynchronous-requests-timeout (emacs-pid)))) 6832 (tmp-name (tramp--test-make-temp-name)) 6833 (default-directory tmp-name) 6834 ;; Do not cache Tramp properties. 6835 (remote-file-name-inhibit-cache t) 6836 (process-file-side-effects t) 6837 ;; Suppress nasty messages. 6838 (inhibit-message t) 6839 ;; Do not run delayed timers. 6840 (timer-max-repeats 0) 6841 ;; Number of asynchronous processes for test. Tests on 6842 ;; some machines handle less parallel processes. 6843 (number-proc 6844 (cond 6845 ((ignore-errors 6846 (string-to-number (getenv "REMOTE_PARALLEL_PROCESSES")))) 6847 ((getenv "EMACS_HYDRA_CI") 5) 6848 (t 10))) 6849 ;; On hydra, timings are bad. 6850 (timer-repeat 6851 (cond 6852 ((getenv "EMACS_HYDRA_CI") 10) 6853 (t 1))) 6854 ;; This is when all timers start. We check inside the 6855 ;; timer function, that we don't exceed timeout. 6856 (timer-start (current-time)) 6857 timer buffers kill-buffer-query-functions) 6858 6859 (unwind-protect 6860 (progn 6861 (make-directory tmp-name) 6862 6863 ;; Setup a timer in order to raise an ordinary command 6864 ;; again and again. `vc-registered' is well suited, 6865 ;; because there are many checks. 6866 (setq 6867 timer 6868 (run-at-time 6869 0 timer-repeat 6870 (lambda () 6871 (tramp--test-with-proper-process-name-and-buffer 6872 (get-buffer-process (tramp-get-buffer tramp-test-vec)) 6873 (when (> (- (time-to-seconds) (time-to-seconds timer-start)) 6874 tramp--test-asynchronous-requests-timeout) 6875 (tramp--test-timeout-handler)) 6876 (when buffers 6877 (let ((time (float-time)) 6878 (default-directory tmp-name) 6879 (file (buffer-name (seq-random-elt buffers))) 6880 ;; A remote operation in a timer could 6881 ;; confuse Tramp heavily. So we ignore this 6882 ;; error here. 6883 (debug-ignored-errors 6884 (cons 'remote-file-error debug-ignored-errors))) 6885 (tramp--test-message 6886 "Start timer %s %s" file (current-time-string)) 6887 (vc-registered file) 6888 (tramp--test-message 6889 "Stop timer %s %s" file (current-time-string)) 6890 ;; Adjust timer if it takes too much time. 6891 (when (> (- (float-time) time) timer-repeat) 6892 (setq timer-repeat (* 1.1 timer-repeat)) 6893 (setf (timer--repeat-delay timer) timer-repeat) 6894 (tramp--test-message 6895 "Increase timer %s" timer-repeat)))))))) 6896 6897 ;; Create temporary buffers. The number of buffers 6898 ;; corresponds to the number of processes; it could be 6899 ;; increased in order to make pressure on Tramp. 6900 (dotimes (_ number-proc) 6901 (setq buffers (cons (generate-new-buffer "foo") buffers))) 6902 6903 ;; Open asynchronous processes. Set process filter and sentinel. 6904 (dolist (buf buffers) 6905 ;; Activate timer. 6906 (sit-for 0.01 'nodisp) 6907 (let ((proc 6908 (start-file-process-shell-command 6909 (buffer-name buf) buf 6910 (concat 6911 "(read line && echo $line >$line && echo $line);" 6912 "(read line && cat $line);" 6913 "(read line && rm -f $line)"))) 6914 (file (expand-file-name (buffer-name buf)))) 6915 ;; Remember the file name. Add counter. 6916 (process-put proc 'foo file) 6917 (process-put proc 'bar 0) 6918 ;; Add process filter. 6919 (set-process-filter 6920 proc 6921 (lambda (proc string) 6922 (tramp--test-with-proper-process-name-and-buffer proc 6923 (tramp--test-message 6924 "Process filter %s %s %s" 6925 proc string (current-time-string)) 6926 (with-current-buffer (process-buffer proc) 6927 (insert string)) 6928 (when (< (process-get proc 'bar) 2) 6929 (dired-uncache (process-get proc 'foo)) 6930 (should (file-attributes (process-get proc 'foo))))))) 6931 ;; Add process sentinel. It shall not perform remote 6932 ;; operations, triggering Tramp processes. This blocks. 6933 (set-process-sentinel 6934 proc 6935 (lambda (proc _state) 6936 (tramp--test-with-proper-process-name-and-buffer proc 6937 (tramp--test-message 6938 "Process sentinel %s %s" proc (current-time-string))))))) 6939 6940 ;; Send a string to the processes. Use a random order of 6941 ;; the buffers. Mix with regular operation. 6942 (let ((buffers (copy-sequence buffers))) 6943 (while buffers 6944 (let* ((buf (seq-random-elt buffers)) 6945 (proc (get-buffer-process buf)) 6946 (file (process-get proc 'foo)) 6947 (count (process-get proc 'bar))) 6948 (tramp--test-message 6949 "Start action %d %s %s" count buf (current-time-string)) 6950 ;; Regular operation prior process action. 6951 (dired-uncache file) 6952 (if (= count 0) 6953 (should-not (file-attributes file)) 6954 (should (file-attributes file))) 6955 ;; Send string to process. 6956 (process-send-string proc (format "%s\n" (buffer-name buf))) 6957 (while (accept-process-output nil 0)) 6958 (tramp--test-message 6959 "Continue action %d %s %s" count buf (current-time-string)) 6960 ;; Regular operation post process action. 6961 (dired-uncache file) 6962 (if (= count 2) 6963 (should-not (file-attributes file)) 6964 (should (file-attributes file))) 6965 (tramp--test-message 6966 "Stop action %d %s %s" count buf (current-time-string)) 6967 (process-put proc 'bar (1+ count)) 6968 (unless (process-live-p proc) 6969 (setq buffers (delq buf buffers)))))) 6970 6971 ;; Checks. All process output shall exists in the 6972 ;; respective buffers. All created files shall be 6973 ;; deleted. 6974 (tramp--test-message "Check %s" (current-time-string)) 6975 (dolist (buf buffers) 6976 (with-current-buffer buf 6977 (should 6978 (string-equal 6979 ;; tramp-adb.el echoes, so we must add the three strings. 6980 (if (tramp--test-adb-p) 6981 (format "%s\n%s\n%s\n%s\n%s\n" buf buf buf buf buf) 6982 (format "%s\n%s\n" buf buf)) 6983 (buffer-string))))) 6984 (should-not 6985 (directory-files 6986 tmp-name nil directory-files-no-dot-files-regexp))) 6987 6988 ;; Cleanup. 6989 (define-key special-event-map [sigusr1] #'ignore) 6990 (ignore-errors (quit-process watchdog)) 6991 (dolist (buf buffers) 6992 (ignore-errors (delete-process (get-buffer-process buf))) 6993 (ignore-errors (kill-buffer buf))) 6994 (ignore-errors (cancel-timer timer)) 6995 (ignore-errors (delete-directory tmp-name 'recursive)))))) 6996 6997;; (tramp--test--deftest-direct-async-process tramp-test44-asynchronous-requests 6998;; "Check parallel direct asynchronous requests." 'unstable) 6999 7000(ert-deftest tramp-test45-dired-compress-file () 7001 "Check that Tramp (un)compresses normal files." 7002 (skip-unless (tramp--test-enabled)) 7003 (skip-unless (tramp--test-sh-p)) 7004 (skip-unless (not (tramp--test-crypt-p))) 7005 ;; Starting with Emacs 29.1, `dired-compress-file' is performed by 7006 ;; default handler. 7007 (skip-unless (not (tramp--test-emacs29-p))) 7008 7009 (let ((default-directory tramp-test-temporary-file-directory) 7010 (tmp-name (tramp--test-make-temp-name))) 7011 (write-region "foo" nil tmp-name) 7012 (dired default-directory) 7013 (dired-revert) 7014 (dired-goto-file tmp-name) 7015 (should-not (dired-compress)) 7016 (should (string= (concat tmp-name ".gz") (dired-get-filename))) 7017 (should-not (dired-compress)) 7018 (should (string= tmp-name (dired-get-filename))) 7019 (delete-file tmp-name))) 7020 7021(ert-deftest tramp-test45-dired-compress-dir () 7022 "Check that Tramp (un)compresses directories." 7023 (skip-unless (tramp--test-enabled)) 7024 (skip-unless (tramp--test-sh-p)) 7025 (skip-unless (not (tramp--test-crypt-p))) 7026 ;; Starting with Emacs 29.1, `dired-compress-file' is performed by 7027 ;; default handler. 7028 (skip-unless (not (tramp--test-emacs29-p))) 7029 7030 (let ((default-directory tramp-test-temporary-file-directory) 7031 (tmp-name (tramp--test-make-temp-name))) 7032 (make-directory tmp-name) 7033 (dired default-directory) 7034 (dired-revert) 7035 (dired-goto-file tmp-name) 7036 (should-not (dired-compress)) 7037 (should (string= (concat tmp-name ".tar.gz") (dired-get-filename))) 7038 (should-not (dired-compress)) 7039 (should (string= tmp-name (dired-get-filename))) 7040 (delete-directory tmp-name) 7041 (delete-file (concat tmp-name ".tar.gz")))) 7042 7043;; This test is inspired by Bug#29163. 7044(ert-deftest tramp-test46-auto-load () 7045 "Check that Tramp autoloads properly." 7046 ;; If we use another syntax but `default', Tramp is already loaded 7047 ;; due to the `tramp-change-syntax' call. 7048 (skip-unless (eq tramp-syntax 'default)) 7049 (skip-unless (tramp--test-enabled)) 7050 7051 (let ((default-directory (expand-file-name temporary-file-directory)) 7052 (code 7053 (format 7054 ;; Suppress method name check. 7055 "(let ((non-essential t)) \ 7056 (message \"Tramp loaded: %%s\" (and (file-remote-p %S) t)))" 7057 tramp-test-temporary-file-directory))) 7058 (should 7059 (string-match-p 7060 "Tramp loaded: t[\n\r]+" 7061 (shell-command-to-string 7062 (format 7063 "%s -batch -Q -L %s --eval %s" 7064 (shell-quote-argument 7065 (expand-file-name invocation-name invocation-directory)) 7066 (mapconcat #'shell-quote-argument load-path " -L ") 7067 (shell-quote-argument code))))))) 7068 7069(ert-deftest tramp-test46-delay-load () 7070 "Check that Tramp is loaded lazily, only when needed." 7071 ;; Tramp is neither loaded at Emacs startup, nor when completing a 7072 ;; non-Tramp file name like "/foo". Completing a Tramp-alike file 7073 ;; name like "/foo:" autoloads Tramp, when `tramp-mode' is t. 7074 (let ((default-directory (expand-file-name temporary-file-directory)) 7075 (code 7076 "(progn \ 7077 (setq tramp-mode %s) \ 7078 (message \"Tramp loaded: %%s\" (featurep 'tramp)) \ 7079 (file-name-all-completions \"/foo\" \"/\") \ 7080 (message \"Tramp loaded: %%s\" (featurep 'tramp)) \ 7081 (file-name-all-completions \"/foo:\" \"/\") \ 7082 (message \"Tramp loaded: %%s\" (featurep 'tramp)))")) 7083 ;; Tramp doesn't load when `tramp-mode' is nil. 7084 (dolist (tm '(t nil)) 7085 (should 7086 (string-match-p 7087 (format 7088 "Tramp loaded: nil[\n\r]+Tramp loaded: nil[\n\r]+Tramp loaded: %s[\n\r]+" 7089 tm) 7090 (shell-command-to-string 7091 (format 7092 "%s -batch -Q -L %s --eval %s" 7093 (shell-quote-argument 7094 (expand-file-name invocation-name invocation-directory)) 7095 (mapconcat #'shell-quote-argument load-path " -L ") 7096 (shell-quote-argument (format code tm))))))))) 7097 7098(ert-deftest tramp-test46-recursive-load () 7099 "Check that Tramp does not fail due to recursive load." 7100 (skip-unless (tramp--test-enabled)) 7101 7102 (let ((default-directory (expand-file-name temporary-file-directory))) 7103 (dolist (code 7104 (list 7105 (format 7106 "(expand-file-name %S)" tramp-test-temporary-file-directory) 7107 (format 7108 "(let ((default-directory %S)) (expand-file-name %S))" 7109 tramp-test-temporary-file-directory 7110 temporary-file-directory))) 7111 (should-not 7112 (string-match-p 7113 "Recursive load" 7114 (shell-command-to-string 7115 (format 7116 "%s -batch -Q -L %s --eval %s" 7117 (shell-quote-argument 7118 (expand-file-name invocation-name invocation-directory)) 7119 (mapconcat #'shell-quote-argument load-path " -L ") 7120 (shell-quote-argument code)))))))) 7121 7122(ert-deftest tramp-test46-remote-load-path () 7123 "Check that Tramp autoloads its packages with remote `load-path'." 7124 ;; `tramp-cleanup-all-connections' is autoloaded from tramp-cmds.el. 7125 ;; It shall still work, when a remote file name is in the 7126 ;; `load-path'. 7127 (let ((default-directory (expand-file-name temporary-file-directory)) 7128 (code 7129 "(let ((force-load-messages t) \ 7130 (load-path (cons \"/foo:bar:\" load-path))) \ 7131 (tramp-cleanup-all-connections))")) 7132 (should 7133 (string-match-p 7134 (format 7135 "Loading %s" 7136 (regexp-quote 7137 (expand-file-name 7138 "tramp-cmds" (file-name-directory (locate-library "tramp"))))) 7139 (shell-command-to-string 7140 (format 7141 "%s -batch -Q -L %s -l tramp-sh --eval %s" 7142 (shell-quote-argument 7143 (expand-file-name invocation-name invocation-directory)) 7144 (mapconcat #'shell-quote-argument load-path " -L ") 7145 (shell-quote-argument code))))))) 7146 7147(ert-deftest tramp-test47-unload () 7148 "Check that Tramp and its subpackages unload completely. 7149Since it unloads Tramp, it shall be the last test to run." 7150 :tags '(:expensive-test) 7151 (skip-unless noninteractive) 7152 ;; We have autoloaded objects from tramp.el and tramp-archive.el. 7153 ;; In order to remove them, we first need to load both packages. 7154 (require 'tramp) 7155 (require 'tramp-archive) 7156 (should (featurep 'tramp)) 7157 (should (featurep 'tramp-archive)) 7158 ;; This unloads also tramp-archive.el and tramp-theme.el if needed. 7159 (unload-feature 'tramp 'force) 7160 ;; No Tramp feature must be left. 7161 (should-not (featurep 'tramp)) 7162 (should-not (featurep 'tramp-archive)) 7163 (should-not (featurep 'tramp-theme)) 7164 (should-not 7165 (all-completions 7166 "tramp" (delq 'tramp-tests (delq 'tramp-archive-tests features)))) 7167 ;; `file-name-handler-alist' must be clean. 7168 (should-not (all-completions "tramp" (mapcar #'cdr file-name-handler-alist))) 7169 ;; There shouldn't be left a bound symbol, except buffer-local 7170 ;; variables, and autoload functions. We do not regard our test 7171 ;; symbols, and the Tramp unload hooks. 7172 (mapatoms 7173 (lambda (x) 7174 (and (or (and (boundp x) (null (local-variable-if-set-p x))) 7175 (and (functionp x) (null (autoloadp (symbol-function x))))) 7176 (string-match-p "^tramp" (symbol-name x)) 7177 ;; `tramp-completion-mode' is autoloaded in Emacs < 28.1. 7178 (not (eq 'tramp-completion-mode x)) 7179 (not (string-match-p "^tramp\\(-archive\\)?--?test" (symbol-name x))) 7180 (not (string-match-p "unload-hook$" (symbol-name x))) 7181 (ert-fail (format "`%s' still bound" x))))) 7182 ;; The defstruct `tramp-file-name' and all its internal functions 7183 ;; shall be purged. 7184 (should-not (cl--find-class 'tramp-file-name)) 7185 (mapatoms 7186 (lambda (x) 7187 (and (functionp x) 7188 (string-match-p "tramp-file-name" (symbol-name x)) 7189 (ert-fail (format "Structure function `%s' still exists" x))))) 7190 ;; There shouldn't be left a hook function containing a Tramp 7191 ;; function. We do not regard the Tramp unload hooks. 7192 (mapatoms 7193 (lambda (x) 7194 (and (boundp x) 7195 (string-match-p "-\\(hook\\|function\\)s?$" (symbol-name x)) 7196 (not (string-match-p "unload-hook$" (symbol-name x))) 7197 (consp (symbol-value x)) 7198 (ignore-errors (all-completions "tramp" (symbol-value x))) 7199 (ert-fail (format "Hook `%s' still contains Tramp function" x)))))) 7200 7201(defun tramp-test-all (&optional interactive) 7202 "Run all tests for \\[tramp]. 7203If INTERACTIVE is non-nil, the tests are run interactively." 7204 (interactive "p") 7205 (funcall 7206 (if interactive #'ert-run-tests-interactively #'ert-run-tests-batch) 7207 "^tramp")) 7208 7209;; TODO: 7210 7211;; * dired-uncache (partly done in other test functions) 7212;; * file-equal-p (partly done in `tramp-test21-file-links') 7213;; * file-in-directory-p 7214;; * file-name-case-insensitive-p 7215;; * tramp-get-remote-gid 7216;; * tramp-get-remote-uid 7217;; * tramp-set-file-uid-gid 7218 7219;; * Work on skipped tests. Make a comment, when it is impossible. 7220;; * Revisit expensive tests, once problems in `tramp-error' are solved. 7221;; * Fix `tramp-test06-directory-file-name' for "ftp". 7222;; * Implement `tramp-test31-interrupt-process' for "adb", "sshfs" and 7223;; for direct async processes. 7224;; * Check, why direct async processes do not work for 7225;; `tramp-test44-asynchronous-requests'. 7226 7227(provide 'tramp-tests) 7228 7229;;; tramp-tests.el ends here 7230