diff options
Diffstat (limited to 'test')
| -rw-r--r-- | test/lisp/shadowfile-tests.el | 876 |
1 files changed, 876 insertions, 0 deletions
diff --git a/test/lisp/shadowfile-tests.el b/test/lisp/shadowfile-tests.el new file mode 100644 index 00000000000..5ded94480ec --- /dev/null +++ b/test/lisp/shadowfile-tests.el | |||
| @@ -0,0 +1,876 @@ | |||
| 1 | ;;; shadowfile-tests.el --- Tests of shadowfile | ||
| 2 | |||
| 3 | ;; Copyright (C) 2018 Free Software Foundation, Inc. | ||
| 4 | |||
| 5 | ;; Author: Michael Albinus <michael.albinus@gmx.de> | ||
| 6 | |||
| 7 | ;; This program is free software: you can redistribute it and/or | ||
| 8 | ;; modify it under the terms of the GNU General Public License as | ||
| 9 | ;; published by the Free Software Foundation, either version 3 of the | ||
| 10 | ;; License, or (at your option) any later version. | ||
| 11 | ;; | ||
| 12 | ;; This program is distributed in the hope that it will be useful, but | ||
| 13 | ;; WITHOUT ANY WARRANTY; without even the implied warranty of | ||
| 14 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU | ||
| 15 | ;; General Public License for more details. | ||
| 16 | ;; | ||
| 17 | ;; You should have received a copy of the GNU General Public License | ||
| 18 | ;; along with this program. If not, see `http://www.gnu.org/licenses/'. | ||
| 19 | |||
| 20 | ;;; Commentary: | ||
| 21 | |||
| 22 | ;; A whole test run can be performed calling the command `shadowfile-test-all'. | ||
| 23 | |||
| 24 | ;;; Code: | ||
| 25 | |||
| 26 | (require 'ert) | ||
| 27 | (require 'shadowfile) | ||
| 28 | (require 'tramp) | ||
| 29 | |||
| 30 | ;; There is no default value on w32 systems, which could work out of the box. | ||
| 31 | (defconst shadow-test-remote-temporary-file-directory | ||
| 32 | (cond | ||
| 33 | ((getenv "REMOTE_TEMPORARY_FILE_DIRECTORY")) | ||
| 34 | ((eq system-type 'windows-nt) null-device) | ||
| 35 | (t (add-to-list | ||
| 36 | 'tramp-methods | ||
| 37 | '("mock" | ||
| 38 | (tramp-login-program "sh") | ||
| 39 | (tramp-login-args (("-i"))) | ||
| 40 | (tramp-remote-shell "/bin/sh") | ||
| 41 | (tramp-remote-shell-args ("-c")) | ||
| 42 | (tramp-connection-timeout 10))) | ||
| 43 | (add-to-list | ||
| 44 | 'tramp-default-host-alist | ||
| 45 | `("\\`mock\\'" nil ,(system-name))) | ||
| 46 | ;; Emacs' Makefile sets $HOME to a nonexistent value. Needed in | ||
| 47 | ;; batch mode only, therefore. It cannot be | ||
| 48 | ;; `temporary-directory', because the tests with "~" would fail. | ||
| 49 | (unless (and (null noninteractive) (file-directory-p "~/")) | ||
| 50 | (setenv "HOME" invocation-directory)) | ||
| 51 | (format "/mock::%s" temporary-file-directory))) | ||
| 52 | "Temporary directory for Tramp tests.") | ||
| 53 | |||
| 54 | (defconst shadow-test-info-file | ||
| 55 | (expand-file-name "shadows_test" temporary-file-directory) | ||
| 56 | "File to keep shadow information in during tests.") | ||
| 57 | |||
| 58 | (defconst shadow-test-todo-file | ||
| 59 | (expand-file-name "shadow_todo_test" temporary-file-directory) | ||
| 60 | "File to store the list of uncopied shadows in during tests.") | ||
| 61 | |||
| 62 | (ert-deftest shadow-test00-clusters () | ||
| 63 | "Check cluster definitions. | ||
| 64 | Per definition, all files are identical on the different hosts of | ||
| 65 | a cluster (or site). This is not tested here; it must be | ||
| 66 | guaranteed by the originator of a cluster definition." | ||
| 67 | (skip-unless (file-remote-p shadow-test-remote-temporary-file-directory)) | ||
| 68 | |||
| 69 | (let ((text-quoting-style 'grave) ;; We inspect the *Messages* buffer! | ||
| 70 | (inhibit-message t) | ||
| 71 | (shadow-info-file shadow-test-info-file) | ||
| 72 | (shadow-todo-file shadow-test-todo-file) | ||
| 73 | shadow-clusters | ||
| 74 | cluster primary regexp mocked-input) | ||
| 75 | (unwind-protect | ||
| 76 | ;; We must mock `read-from-minibuffer' and `read-string', in | ||
| 77 | ;; order to avoid interactive arguments. | ||
| 78 | (cl-letf* (((symbol-function 'read-from-minibuffer) | ||
| 79 | (lambda (&rest args) (pop mocked-input))) | ||
| 80 | ((symbol-function 'read-string) | ||
| 81 | (lambda (&rest args) (pop mocked-input)))) | ||
| 82 | |||
| 83 | ;; Cleanup. | ||
| 84 | (when (file-exists-p shadow-info-file) | ||
| 85 | (delete-file shadow-info-file)) | ||
| 86 | (when (file-exists-p shadow-todo-file) | ||
| 87 | (delete-file shadow-todo-file)) | ||
| 88 | |||
| 89 | ;; Define a cluster. | ||
| 90 | (setq cluster "cluster" | ||
| 91 | primary shadow-system-name | ||
| 92 | regexp (shadow-regexp-superquote primary) | ||
| 93 | mocked-input `(,cluster ,primary ,regexp)) | ||
| 94 | (call-interactively 'shadow-define-cluster) | ||
| 95 | (should | ||
| 96 | (string-equal | ||
| 97 | (shadow-cluster-name (shadow-get-cluster cluster)) cluster)) | ||
| 98 | (should | ||
| 99 | (string-equal | ||
| 100 | (shadow-cluster-primary (shadow-get-cluster cluster)) primary)) | ||
| 101 | (should | ||
| 102 | (string-equal | ||
| 103 | (shadow-cluster-regexp (shadow-get-cluster cluster)) regexp)) | ||
| 104 | (should-not (shadow-get-cluster "non-existent-cluster-name")) | ||
| 105 | |||
| 106 | ;; Test `shadow-set-cluster' and `make-shadow-cluster'. | ||
| 107 | (shadow-set-cluster cluster primary regexp) | ||
| 108 | (should | ||
| 109 | (equal (shadow-get-cluster cluster) | ||
| 110 | (make-shadow-cluster | ||
| 111 | :name cluster :primary primary :regexp regexp))) | ||
| 112 | |||
| 113 | ;; The primary must be either `shadow-system-name', or a remote file. | ||
| 114 | (setq ;; The second "cluster" is wrong. | ||
| 115 | mocked-input `(,cluster ,cluster ,primary ,regexp)) | ||
| 116 | (with-current-buffer (messages-buffer) | ||
| 117 | (narrow-to-region (point-max) (point-max))) | ||
| 118 | (call-interactively 'shadow-define-cluster) | ||
| 119 | (should | ||
| 120 | (string-match | ||
| 121 | (regexp-quote "Not a valid primary!") | ||
| 122 | (with-current-buffer (messages-buffer) (buffer-string)))) | ||
| 123 | ;; The first cluster definition is still valid. | ||
| 124 | (should | ||
| 125 | (string-equal | ||
| 126 | (shadow-cluster-name (shadow-get-cluster cluster)) cluster)) | ||
| 127 | (should | ||
| 128 | (string-equal | ||
| 129 | (shadow-cluster-primary (shadow-get-cluster cluster)) primary)) | ||
| 130 | (should | ||
| 131 | (string-equal | ||
| 132 | (shadow-cluster-regexp (shadow-get-cluster cluster)) regexp)) | ||
| 133 | |||
| 134 | ;; The regexp must match the primary name. | ||
| 135 | (setq ;; The second "cluster" is wrong. | ||
| 136 | mocked-input `(,cluster ,primary ,cluster ,regexp)) | ||
| 137 | (with-current-buffer (messages-buffer) | ||
| 138 | (narrow-to-region (point-max) (point-max))) | ||
| 139 | (call-interactively 'shadow-define-cluster) | ||
| 140 | (should | ||
| 141 | (string-match | ||
| 142 | (regexp-quote "Regexp doesn't include the primary host!") | ||
| 143 | (with-current-buffer (messages-buffer) (buffer-string)))) | ||
| 144 | ;; The first cluster definition is still valid. | ||
| 145 | (should | ||
| 146 | (string-equal | ||
| 147 | (shadow-cluster-name (shadow-get-cluster cluster)) cluster)) | ||
| 148 | (should | ||
| 149 | (string-equal | ||
| 150 | (shadow-cluster-primary (shadow-get-cluster cluster)) primary)) | ||
| 151 | (should | ||
| 152 | (string-equal | ||
| 153 | (shadow-cluster-regexp (shadow-get-cluster cluster)) regexp)) | ||
| 154 | |||
| 155 | ;; Redefine the cluster. | ||
| 156 | (setq primary | ||
| 157 | (file-remote-p shadow-test-remote-temporary-file-directory) | ||
| 158 | regexp (shadow-regexp-superquote primary) | ||
| 159 | mocked-input `(,cluster ,primary ,regexp)) | ||
| 160 | (call-interactively 'shadow-define-cluster) | ||
| 161 | (should | ||
| 162 | (string-equal | ||
| 163 | (shadow-cluster-name (shadow-get-cluster cluster)) cluster)) | ||
| 164 | (should | ||
| 165 | (string-equal | ||
| 166 | (shadow-cluster-primary (shadow-get-cluster cluster)) primary)) | ||
| 167 | (should | ||
| 168 | (string-equal | ||
| 169 | (shadow-cluster-regexp (shadow-get-cluster cluster)) regexp)) | ||
| 170 | |||
| 171 | ;; Test `shadow-set-cluster' and `make-shadow-cluster'. | ||
| 172 | (shadow-set-cluster cluster primary regexp) | ||
| 173 | (should | ||
| 174 | (equal (shadow-get-cluster cluster) | ||
| 175 | (make-shadow-cluster | ||
| 176 | :name cluster :primary primary :regexp regexp)))) | ||
| 177 | |||
| 178 | ;; Cleanup. | ||
| 179 | (with-current-buffer (messages-buffer) (widen)) | ||
| 180 | (when (file-exists-p shadow-info-file) | ||
| 181 | (delete-file shadow-info-file)) | ||
| 182 | (when (file-exists-p shadow-todo-file) | ||
| 183 | (delete-file shadow-todo-file))))) | ||
| 184 | |||
| 185 | (ert-deftest shadow-test01-sites () | ||
| 186 | "Check site definitions. | ||
| 187 | Per definition, all files are identical on the different hosts of | ||
| 188 | a cluster (or site). This is not tested here; it must be | ||
| 189 | guaranteed by the originator of a cluster definition." | ||
| 190 | (skip-unless (file-remote-p shadow-test-remote-temporary-file-directory)) | ||
| 191 | |||
| 192 | (let ((shadow-info-file shadow-test-info-file) | ||
| 193 | (shadow-todo-file shadow-test-todo-file) | ||
| 194 | shadow-clusters | ||
| 195 | cluster1 cluster2 primary1 primary2 regexp1 regexp2 mocked-input) | ||
| 196 | (unwind-protect | ||
| 197 | ;; We must mock `read-from-minibuffer' and `read-string', in | ||
| 198 | ;; order to avoid interactive arguments. | ||
| 199 | (cl-letf* (((symbol-function 'read-from-minibuffer) | ||
| 200 | (lambda (&rest args) (pop mocked-input))) | ||
| 201 | ((symbol-function 'read-string) | ||
| 202 | (lambda (&rest args) (pop mocked-input)))) | ||
| 203 | |||
| 204 | ;; Cleanup. | ||
| 205 | (when (file-exists-p shadow-info-file) | ||
| 206 | (delete-file shadow-info-file)) | ||
| 207 | (when (file-exists-p shadow-todo-file) | ||
| 208 | (delete-file shadow-todo-file)) | ||
| 209 | |||
| 210 | ;; Define a cluster. | ||
| 211 | (setq cluster1 "cluster1" | ||
| 212 | primary1 shadow-system-name | ||
| 213 | regexp1 (shadow-regexp-superquote primary1)) | ||
| 214 | (shadow-set-cluster cluster1 primary1 regexp1) | ||
| 215 | |||
| 216 | ;; A site is either a cluster identification, or a primary host. | ||
| 217 | (should (string-equal cluster1 (shadow-site-name cluster1))) | ||
| 218 | (should (string-equal primary1 (shadow-name-site primary1))) | ||
| 219 | (should | ||
| 220 | (string-equal (format "/%s:" cluster1) (shadow-name-site cluster1))) | ||
| 221 | (should (string-equal (system-name) (shadow-site-name primary1))) | ||
| 222 | (should | ||
| 223 | (string-equal | ||
| 224 | (file-remote-p shadow-test-remote-temporary-file-directory) | ||
| 225 | (shadow-name-site | ||
| 226 | (file-remote-p shadow-test-remote-temporary-file-directory)))) | ||
| 227 | (should | ||
| 228 | (string-equal | ||
| 229 | (file-remote-p shadow-test-remote-temporary-file-directory) | ||
| 230 | (shadow-site-name | ||
| 231 | (file-remote-p shadow-test-remote-temporary-file-directory)))) | ||
| 232 | |||
| 233 | (should (equal (shadow-site-cluster cluster1) | ||
| 234 | (shadow-get-cluster cluster1))) | ||
| 235 | (should (equal (shadow-site-cluster (shadow-name-site cluster1)) | ||
| 236 | (shadow-get-cluster cluster1))) | ||
| 237 | (should (equal (shadow-site-cluster primary1) | ||
| 238 | (shadow-get-cluster cluster1))) | ||
| 239 | (should (equal (shadow-site-cluster (shadow-site-name primary1)) | ||
| 240 | (shadow-get-cluster cluster1))) | ||
| 241 | (should (string-equal (shadow-site-primary cluster1) primary1)) | ||
| 242 | (should (string-equal (shadow-site-primary primary1) primary1)) | ||
| 243 | |||
| 244 | ;; `shadow-read-site' accepts "cluster", "/cluster:", | ||
| 245 | ;; "system", "/system:". It shall reject bad site names. | ||
| 246 | (setq mocked-input | ||
| 247 | `(,cluster1 ,(shadow-name-site cluster1) | ||
| 248 | ,primary1 ,(shadow-site-name primary1) | ||
| 249 | ,shadow-system-name "" "bad" "/bad:")) | ||
| 250 | (should (string-equal (shadow-read-site) cluster1)) | ||
| 251 | (should (string-equal (shadow-read-site) (shadow-name-site cluster1))) | ||
| 252 | (should (string-equal (shadow-read-site) primary1)) | ||
| 253 | (should (string-equal (shadow-read-site) (shadow-site-name primary1))) | ||
| 254 | (should (string-equal (shadow-read-site) shadow-system-name)) | ||
| 255 | (should-not (shadow-read-site)) ; "" | ||
| 256 | (should-not (shadow-read-site)) ; "bad" | ||
| 257 | (should-not (shadow-read-site)) ; "/bad:" | ||
| 258 | (should-error (shadow-read-site)) ; no input at all | ||
| 259 | |||
| 260 | ;; Define a second cluster. | ||
| 261 | (setq cluster2 "cluster2" | ||
| 262 | primary2 | ||
| 263 | (file-remote-p shadow-test-remote-temporary-file-directory) | ||
| 264 | regexp2 (format "^\\(%s\\|%s\\)$" shadow-system-name primary2)) | ||
| 265 | (shadow-set-cluster cluster2 primary2 regexp2) | ||
| 266 | |||
| 267 | ;; `shadow-site-match' shall know all different kind of site names. | ||
| 268 | (should (shadow-site-match cluster1 cluster1)) | ||
| 269 | (should (shadow-site-match primary1 primary1)) | ||
| 270 | (should (shadow-site-match cluster1 primary1)) | ||
| 271 | (should (shadow-site-match primary1 cluster1)) | ||
| 272 | (should (shadow-site-match cluster2 cluster2)) | ||
| 273 | (should (shadow-site-match primary2 primary2)) | ||
| 274 | (should (shadow-site-match cluster2 primary2)) | ||
| 275 | (should (shadow-site-match primary2 cluster2)) | ||
| 276 | |||
| 277 | ;; The regexp of `cluster2' matches the primary of | ||
| 278 | ;; `cluster1'. Not vice versa. | ||
| 279 | (should (shadow-site-match cluster2 cluster1)) | ||
| 280 | (should-not (shadow-site-match cluster1 cluster2)) | ||
| 281 | |||
| 282 | ;; If we use the primaries of a cluster, it doesn't match. | ||
| 283 | (should-not | ||
| 284 | (shadow-site-match (shadow-site-primary cluster2) cluster1)) | ||
| 285 | (should-not | ||
| 286 | (shadow-site-match (shadow-site-primary cluster1) cluster2))) | ||
| 287 | |||
| 288 | ;; Cleanup. | ||
| 289 | (when (file-exists-p shadow-info-file) | ||
| 290 | (delete-file shadow-info-file)) | ||
| 291 | (when (file-exists-p shadow-todo-file) | ||
| 292 | (delete-file shadow-todo-file))))) | ||
| 293 | |||
| 294 | (ert-deftest shadow-test02-files () | ||
| 295 | "Check file manipulation functions." | ||
| 296 | (skip-unless (file-remote-p shadow-test-remote-temporary-file-directory)) | ||
| 297 | |||
| 298 | (let ((shadow-info-file shadow-test-info-file) | ||
| 299 | (shadow-todo-file shadow-test-todo-file) | ||
| 300 | shadow-clusters | ||
| 301 | cluster primary regexp file hup) | ||
| 302 | (unwind-protect | ||
| 303 | (progn | ||
| 304 | ;; Cleanup. | ||
| 305 | (when (file-exists-p shadow-info-file) | ||
| 306 | (delete-file shadow-info-file)) | ||
| 307 | (when (file-exists-p shadow-todo-file) | ||
| 308 | (delete-file shadow-todo-file)) | ||
| 309 | |||
| 310 | ;; Define a cluster. | ||
| 311 | (setq cluster "cluster" | ||
| 312 | primary shadow-system-name | ||
| 313 | regexp (shadow-regexp-superquote primary) | ||
| 314 | file (make-temp-name | ||
| 315 | (expand-file-name | ||
| 316 | "shadowfile-tests" temporary-file-directory))) | ||
| 317 | (shadow-set-cluster cluster primary regexp) | ||
| 318 | |||
| 319 | ;; The constant structure to compare with. | ||
| 320 | (setq hup (make-tramp-file-name :host (system-name) :localname file)) | ||
| 321 | |||
| 322 | ;; The structure a local file is transformed in. | ||
| 323 | (should (equal (shadow-parse-name file) hup)) | ||
| 324 | (should (equal (shadow-parse-name (concat "/" cluster ":" file)) hup)) | ||
| 325 | (should (equal (shadow-parse-name (concat primary file)) hup)) | ||
| 326 | |||
| 327 | ;; A local file name is kept. | ||
| 328 | (should | ||
| 329 | (string-equal (shadow-local-file file) file)) | ||
| 330 | ;; A file on this cluster is also local. | ||
| 331 | (should | ||
| 332 | (string-equal | ||
| 333 | (shadow-local-file (concat "/" cluster ":" file)) file)) | ||
| 334 | ;; A file on the primary host is also local. | ||
| 335 | (should | ||
| 336 | (string-equal (shadow-local-file (concat primary file)) file)) | ||
| 337 | |||
| 338 | ;; Redefine the cluster. | ||
| 339 | (setq primary | ||
| 340 | (file-remote-p shadow-test-remote-temporary-file-directory) | ||
| 341 | regexp (shadow-regexp-superquote primary)) | ||
| 342 | (shadow-set-cluster cluster primary regexp) | ||
| 343 | |||
| 344 | ;; The structure of the local file is still the same. | ||
| 345 | (should (equal (shadow-parse-name file) hup)) | ||
| 346 | ;; The cluster name must be used. | ||
| 347 | (setf (tramp-file-name-host hup) cluster) | ||
| 348 | (should (equal (shadow-parse-name (concat "/" cluster ":" file)) hup)) | ||
| 349 | ;; The structure of a remote file is different. | ||
| 350 | (should | ||
| 351 | (equal (shadow-parse-name (concat primary file)) | ||
| 352 | (tramp-dissect-file-name (concat primary file)))) | ||
| 353 | |||
| 354 | ;; A local file is still local. | ||
| 355 | (should (shadow-local-file file)) | ||
| 356 | ;; A file on this cluster is not local. | ||
| 357 | (should-not (shadow-local-file (concat "/" cluster ":" file))) | ||
| 358 | ;; A file on the primary host is not local. | ||
| 359 | (should-not (shadow-local-file (concat primary file))) | ||
| 360 | ;; There's no error on wrong FILE. | ||
| 361 | (should-not (shadow-local-file nil))) | ||
| 362 | |||
| 363 | ;; Cleanup. | ||
| 364 | (when (file-exists-p shadow-info-file) | ||
| 365 | (delete-file shadow-info-file)) | ||
| 366 | (when (file-exists-p shadow-todo-file) | ||
| 367 | (delete-file shadow-todo-file))))) | ||
| 368 | |||
| 369 | (ert-deftest shadow-test03-expand-cluster-in-file-name () | ||
| 370 | "Check canonical file name of a cluster or site." | ||
| 371 | (skip-unless (file-remote-p shadow-test-remote-temporary-file-directory)) | ||
| 372 | |||
| 373 | (let ((shadow-info-file shadow-test-info-file) | ||
| 374 | (shadow-todo-file shadow-test-todo-file) | ||
| 375 | shadow-clusters | ||
| 376 | cluster primary regexp file1 file2) | ||
| 377 | (unwind-protect | ||
| 378 | (progn | ||
| 379 | ;; Cleanup. | ||
| 380 | (when (file-exists-p shadow-info-file) | ||
| 381 | (delete-file shadow-info-file)) | ||
| 382 | (when (file-exists-p shadow-todo-file) | ||
| 383 | (delete-file shadow-todo-file)) | ||
| 384 | |||
| 385 | ;; Define a cluster. | ||
| 386 | (setq cluster "cluster" | ||
| 387 | primary shadow-system-name | ||
| 388 | regexp (shadow-regexp-superquote primary)) | ||
| 389 | (shadow-set-cluster cluster primary regexp) | ||
| 390 | |||
| 391 | (setq file1 | ||
| 392 | (make-temp-name | ||
| 393 | (expand-file-name "shadowfile-tests" temporary-file-directory)) | ||
| 394 | file2 | ||
| 395 | (make-temp-name | ||
| 396 | (expand-file-name | ||
| 397 | "shadowfile-tests" | ||
| 398 | shadow-test-remote-temporary-file-directory))) | ||
| 399 | |||
| 400 | ;; A local file name is kept. | ||
| 401 | (should | ||
| 402 | (string-equal (shadow-expand-cluster-in-file-name file1) file1)) | ||
| 403 | ;; A remote file is kept. | ||
| 404 | (should | ||
| 405 | (string-equal (shadow-expand-cluster-in-file-name file2) file2)) | ||
| 406 | ;; A cluster name is expanded to the primary name. | ||
| 407 | (should | ||
| 408 | (string-equal | ||
| 409 | (shadow-expand-cluster-in-file-name (format "/%s:%s" cluster file1)) | ||
| 410 | (shadow-expand-cluster-in-file-name (concat primary file1)))) | ||
| 411 | ;; A primary name is expanded if it is a local file name. | ||
| 412 | (should | ||
| 413 | (string-equal | ||
| 414 | (shadow-expand-cluster-in-file-name (concat primary file1)) file1)) | ||
| 415 | |||
| 416 | ;; Redefine the cluster. | ||
| 417 | (setq primary | ||
| 418 | (file-remote-p shadow-test-remote-temporary-file-directory) | ||
| 419 | regexp (shadow-regexp-superquote primary)) | ||
| 420 | (shadow-set-cluster cluster primary regexp) | ||
| 421 | |||
| 422 | ;; A cluster name is expanded to the primary name. | ||
| 423 | (should | ||
| 424 | (string-equal | ||
| 425 | (shadow-expand-cluster-in-file-name (format "/%s:%s" cluster file1)) | ||
| 426 | (shadow-expand-cluster-in-file-name (concat primary file1)))) | ||
| 427 | ;; A primary name is not expanded if it isn't is a local file name. | ||
| 428 | (should | ||
| 429 | (string-equal | ||
| 430 | (shadow-expand-cluster-in-file-name (concat primary file1)) | ||
| 431 | (concat primary file1)))) | ||
| 432 | |||
| 433 | ;; Cleanup. | ||
| 434 | (when (file-exists-p shadow-info-file) | ||
| 435 | (delete-file shadow-info-file)) | ||
| 436 | (when (file-exists-p shadow-todo-file) | ||
| 437 | (delete-file shadow-todo-file))))) | ||
| 438 | |||
| 439 | (ert-deftest shadow-test04-contract-file-name () | ||
| 440 | "Check canonical file name of a cluster or site." | ||
| 441 | (skip-unless (file-remote-p shadow-test-remote-temporary-file-directory)) | ||
| 442 | |||
| 443 | (let ((shadow-info-file shadow-test-info-file) | ||
| 444 | (shadow-todo-file shadow-test-todo-file) | ||
| 445 | shadow-clusters | ||
| 446 | cluster primary regexp file) | ||
| 447 | (unwind-protect | ||
| 448 | (progn | ||
| 449 | ;; Cleanup. | ||
| 450 | (when (file-exists-p shadow-info-file) | ||
| 451 | (delete-file shadow-info-file)) | ||
| 452 | (when (file-exists-p shadow-todo-file) | ||
| 453 | (delete-file shadow-todo-file)) | ||
| 454 | |||
| 455 | ;; Define a cluster. | ||
| 456 | (setq cluster "cluster" | ||
| 457 | primary shadow-system-name | ||
| 458 | regexp (shadow-regexp-superquote primary) | ||
| 459 | file (make-temp-name | ||
| 460 | (expand-file-name | ||
| 461 | "shadowfile-tests" temporary-file-directory))) | ||
| 462 | (shadow-set-cluster cluster primary regexp) | ||
| 463 | |||
| 464 | ;; The cluster name is prepended for local files. | ||
| 465 | (should | ||
| 466 | (string-equal | ||
| 467 | (shadow-contract-file-name file) (concat "/cluster:" file))) | ||
| 468 | ;; A cluster file name is preserved. | ||
| 469 | (should | ||
| 470 | (string-equal | ||
| 471 | (shadow-contract-file-name (concat "/cluster:" file)) | ||
| 472 | (concat "/cluster:" file))) | ||
| 473 | ;; `shadow-system-name' is mapped to the cluster. | ||
| 474 | (should | ||
| 475 | (string-equal | ||
| 476 | (shadow-contract-file-name (concat shadow-system-name file)) | ||
| 477 | (concat "/cluster:" file))) | ||
| 478 | |||
| 479 | ;; Redefine the cluster. | ||
| 480 | (setq primary | ||
| 481 | (file-remote-p shadow-test-remote-temporary-file-directory) | ||
| 482 | regexp (shadow-regexp-superquote primary)) | ||
| 483 | (shadow-set-cluster cluster primary regexp) | ||
| 484 | |||
| 485 | ;; A remote file name is mapped to the cluster. | ||
| 486 | (should | ||
| 487 | (string-equal | ||
| 488 | (shadow-contract-file-name | ||
| 489 | (concat | ||
| 490 | (file-remote-p shadow-test-remote-temporary-file-directory) file)) | ||
| 491 | (concat "/cluster:" file)))) | ||
| 492 | |||
| 493 | ;; Cleanup. | ||
| 494 | (when (file-exists-p shadow-info-file) | ||
| 495 | (delete-file shadow-info-file)) | ||
| 496 | (when (file-exists-p shadow-todo-file) | ||
| 497 | (delete-file shadow-todo-file))))) | ||
| 498 | |||
| 499 | (ert-deftest shadow-test05-file-match () | ||
| 500 | "Check `shadow-same-site' and `shadow-file-match'." | ||
| 501 | (skip-unless (file-remote-p shadow-test-remote-temporary-file-directory)) | ||
| 502 | |||
| 503 | (let ((shadow-info-file shadow-test-info-file) | ||
| 504 | (shadow-todo-file shadow-test-todo-file) | ||
| 505 | shadow-clusters | ||
| 506 | cluster primary regexp file) | ||
| 507 | (unwind-protect | ||
| 508 | (progn | ||
| 509 | ;; Cleanup. | ||
| 510 | (when (file-exists-p shadow-info-file) | ||
| 511 | (delete-file shadow-info-file)) | ||
| 512 | (when (file-exists-p shadow-todo-file) | ||
| 513 | (delete-file shadow-todo-file)) | ||
| 514 | |||
| 515 | ;; Define a cluster. | ||
| 516 | (setq cluster "cluster" | ||
| 517 | primary shadow-system-name | ||
| 518 | regexp (shadow-regexp-superquote primary) | ||
| 519 | file (make-temp-name | ||
| 520 | (expand-file-name | ||
| 521 | "shadowfile-tests" temporary-file-directory))) | ||
| 522 | (shadow-set-cluster cluster primary regexp) | ||
| 523 | |||
| 524 | (should (shadow-same-site (shadow-parse-name "/cluster:") file)) | ||
| 525 | (should | ||
| 526 | (shadow-same-site (shadow-parse-name shadow-system-name) file)) | ||
| 527 | (should (shadow-same-site (shadow-parse-name file) file)) | ||
| 528 | |||
| 529 | (should | ||
| 530 | (shadow-file-match | ||
| 531 | (shadow-parse-name (concat "/cluster:" file)) file)) | ||
| 532 | (should | ||
| 533 | (shadow-file-match | ||
| 534 | (shadow-parse-name (concat shadow-system-name file)) file)) | ||
| 535 | (should (shadow-file-match (shadow-parse-name file) file)) | ||
| 536 | |||
| 537 | ;; Redefine the cluster. | ||
| 538 | (setq primary | ||
| 539 | (file-remote-p shadow-test-remote-temporary-file-directory) | ||
| 540 | regexp (shadow-regexp-superquote primary)) | ||
| 541 | (shadow-set-cluster cluster primary regexp) | ||
| 542 | |||
| 543 | (should | ||
| 544 | (shadow-file-match | ||
| 545 | (shadow-parse-name | ||
| 546 | (concat | ||
| 547 | (file-remote-p shadow-test-remote-temporary-file-directory) | ||
| 548 | file)) | ||
| 549 | file))) | ||
| 550 | |||
| 551 | ;; Cleanup. | ||
| 552 | (when (file-exists-p shadow-info-file) | ||
| 553 | (delete-file shadow-info-file)) | ||
| 554 | (when (file-exists-p shadow-todo-file) | ||
| 555 | (delete-file shadow-todo-file))))) | ||
| 556 | |||
| 557 | (ert-deftest shadow-test06-literal-groups () | ||
| 558 | "Check literal group definitions." | ||
| 559 | (let ((shadow-info-file shadow-test-info-file) | ||
| 560 | (shadow-todo-file shadow-test-todo-file) | ||
| 561 | shadow-clusters shadow-literal-groups | ||
| 562 | cluster1 cluster2 primary regexp file1 file2 mocked-input) | ||
| 563 | (unwind-protect | ||
| 564 | ;; We must mock `read-from-minibuffer' and `read-string', in | ||
| 565 | ;; order to avoid interactive arguments. | ||
| 566 | (cl-letf* (((symbol-function 'read-from-minibuffer) | ||
| 567 | (lambda (&rest args) (pop mocked-input))) | ||
| 568 | ((symbol-function 'read-string) | ||
| 569 | (lambda (&rest args) (pop mocked-input)))) | ||
| 570 | |||
| 571 | ;; Cleanup. | ||
| 572 | (when (file-exists-p shadow-info-file) | ||
| 573 | (delete-file shadow-info-file)) | ||
| 574 | (when (file-exists-p shadow-todo-file) | ||
| 575 | (delete-file shadow-todo-file)) | ||
| 576 | |||
| 577 | ;; Define clusters. | ||
| 578 | (setq cluster1 "cluster1" | ||
| 579 | primary shadow-system-name | ||
| 580 | regexp (shadow-regexp-superquote primary)) | ||
| 581 | (shadow-set-cluster cluster1 primary regexp) | ||
| 582 | |||
| 583 | (setq cluster2 "cluster2" | ||
| 584 | primary | ||
| 585 | (file-remote-p shadow-test-remote-temporary-file-directory) | ||
| 586 | regexp (format "^\\(%s\\|%s\\)$" shadow-system-name primary)) | ||
| 587 | (shadow-set-cluster cluster2 primary regexp) | ||
| 588 | |||
| 589 | ;; Define a literal group. | ||
| 590 | (setq file1 | ||
| 591 | (make-temp-name | ||
| 592 | (expand-file-name "shadowfile-tests" temporary-file-directory)) | ||
| 593 | file2 | ||
| 594 | (make-temp-name | ||
| 595 | (expand-file-name | ||
| 596 | "shadowfile-tests" | ||
| 597 | shadow-test-remote-temporary-file-directory)) | ||
| 598 | mocked-input `(,cluster1 ,file1 ,cluster2 ,file2 ,(kbd "RET"))) | ||
| 599 | (with-temp-buffer | ||
| 600 | (setq-local buffer-file-name file1) | ||
| 601 | (call-interactively 'shadow-define-literal-group)) | ||
| 602 | |||
| 603 | ;; `shadow-literal-groups' is a list of lists. | ||
| 604 | (should (consp shadow-literal-groups)) | ||
| 605 | (should (consp (car shadow-literal-groups))) | ||
| 606 | (should-not (cdr shadow-literal-groups)) | ||
| 607 | |||
| 608 | (should (member (format "/%s:%s" cluster1 (file-local-name file1)) | ||
| 609 | (car shadow-literal-groups))) | ||
| 610 | (should (member (format "/%s:%s" cluster2 (file-local-name file2)) | ||
| 611 | (car shadow-literal-groups)))) | ||
| 612 | |||
| 613 | ;; Cleanup. | ||
| 614 | (when (file-exists-p shadow-info-file) | ||
| 615 | (delete-file shadow-info-file)) | ||
| 616 | (when (file-exists-p shadow-todo-file) | ||
| 617 | (delete-file shadow-todo-file))))) | ||
| 618 | |||
| 619 | (ert-deftest shadow-test07-regexp-groups () | ||
| 620 | "Check regexp group definitions." | ||
| 621 | (let ((shadow-info-file shadow-test-info-file) | ||
| 622 | (shadow-todo-file shadow-test-todo-file) | ||
| 623 | shadow-clusters shadow-regexp-groups | ||
| 624 | cluster1 cluster2 primary regexp file mocked-input) | ||
| 625 | (unwind-protect | ||
| 626 | ;; We must mock `read-from-minibuffer' and `read-string', in | ||
| 627 | ;; order to avoid interactive arguments. | ||
| 628 | (cl-letf* (((symbol-function 'read-from-minibuffer) | ||
| 629 | (lambda (&rest args) (pop mocked-input))) | ||
| 630 | ((symbol-function 'read-string) | ||
| 631 | (lambda (&rest args) (pop mocked-input)))) | ||
| 632 | |||
| 633 | ;; Cleanup. | ||
| 634 | (when (file-exists-p shadow-info-file) | ||
| 635 | (delete-file shadow-info-file)) | ||
| 636 | (when (file-exists-p shadow-todo-file) | ||
| 637 | (delete-file shadow-todo-file)) | ||
| 638 | |||
| 639 | ;; Define clusters. | ||
| 640 | (setq cluster1 "cluster1" | ||
| 641 | primary shadow-system-name | ||
| 642 | regexp (shadow-regexp-superquote primary)) | ||
| 643 | (shadow-set-cluster cluster1 primary regexp) | ||
| 644 | |||
| 645 | (setq cluster2 "cluster2" | ||
| 646 | primary | ||
| 647 | (file-remote-p shadow-test-remote-temporary-file-directory) | ||
| 648 | regexp (format "^\\(%s\\|%s\\)$" shadow-system-name primary)) | ||
| 649 | (shadow-set-cluster cluster2 primary regexp) | ||
| 650 | |||
| 651 | ;; Define a regexp group. | ||
| 652 | (setq file | ||
| 653 | (make-temp-name | ||
| 654 | (expand-file-name "shadowfile-tests" temporary-file-directory)) | ||
| 655 | mocked-input `(,(shadow-regexp-superquote file) | ||
| 656 | ,cluster1 ,cluster2 ,(kbd "RET"))) | ||
| 657 | (with-temp-buffer | ||
| 658 | (setq-local buffer-file-name nil) | ||
| 659 | (call-interactively 'shadow-define-regexp-group)) | ||
| 660 | |||
| 661 | ;; `shadow-regexp-groups' is a list of lists. | ||
| 662 | (should (consp shadow-regexp-groups)) | ||
| 663 | (should (consp (car shadow-regexp-groups))) | ||
| 664 | (should-not (cdr shadow-regexp-groups)) | ||
| 665 | |||
| 666 | (should | ||
| 667 | (member | ||
| 668 | (concat | ||
| 669 | (shadow-site-primary cluster1) (shadow-regexp-superquote file)) | ||
| 670 | (car shadow-regexp-groups))) | ||
| 671 | (should | ||
| 672 | (member | ||
| 673 | (concat | ||
| 674 | (shadow-site-primary cluster2) (shadow-regexp-superquote file)) | ||
| 675 | (car shadow-regexp-groups)))) | ||
| 676 | |||
| 677 | ;; Cleanup. | ||
| 678 | (when (file-exists-p shadow-info-file) | ||
| 679 | (delete-file shadow-info-file)) | ||
| 680 | (when (file-exists-p shadow-todo-file) | ||
| 681 | (delete-file shadow-todo-file))))) | ||
| 682 | |||
| 683 | (ert-deftest shadow-test08-shadow-todo () | ||
| 684 | "Check that needed shadows are added to todo." | ||
| 685 | (let ((backup-inhibited t) | ||
| 686 | (shadow-info-file shadow-test-info-file) | ||
| 687 | (shadow-todo-file shadow-test-todo-file) | ||
| 688 | (shadow-inhibit-message t) | ||
| 689 | shadow-clusters shadow-literal-groups shadow-regexp-groups | ||
| 690 | shadow-files-to-copy | ||
| 691 | cluster1 cluster2 primary regexp file) | ||
| 692 | (unwind-protect | ||
| 693 | (progn | ||
| 694 | ;; Cleanup. | ||
| 695 | (when (file-exists-p shadow-info-file) | ||
| 696 | (delete-file shadow-info-file)) | ||
| 697 | (when (file-exists-p shadow-todo-file) | ||
| 698 | (delete-file shadow-todo-file)) | ||
| 699 | |||
| 700 | ;; Define clusters. | ||
| 701 | (setq cluster1 "cluster1" | ||
| 702 | primary shadow-system-name | ||
| 703 | regexp (shadow-regexp-superquote primary)) | ||
| 704 | (shadow-set-cluster cluster1 primary regexp) | ||
| 705 | |||
| 706 | (setq cluster2 "cluster2" | ||
| 707 | primary | ||
| 708 | (file-remote-p shadow-test-remote-temporary-file-directory) | ||
| 709 | regexp (shadow-regexp-superquote primary)) | ||
| 710 | (shadow-set-cluster cluster2 primary regexp) | ||
| 711 | |||
| 712 | ;; Define a literal group. | ||
| 713 | (setq file | ||
| 714 | (make-temp-name | ||
| 715 | (expand-file-name "shadowfile-tests" temporary-file-directory)) | ||
| 716 | shadow-literal-groups | ||
| 717 | `((,(concat "/cluster1:" file) ,(concat "/cluster2:" file)))) | ||
| 718 | |||
| 719 | ;; Save file from "cluster1" definition. | ||
| 720 | (with-temp-buffer | ||
| 721 | (setq buffer-file-name file) | ||
| 722 | (insert "foo") | ||
| 723 | (save-buffer)) | ||
| 724 | (should | ||
| 725 | (member | ||
| 726 | (cons file (shadow-contract-file-name (concat "/cluster2:" file))) | ||
| 727 | shadow-files-to-copy)) | ||
| 728 | |||
| 729 | ;; Save file from "cluster2" definition. | ||
| 730 | (with-temp-buffer | ||
| 731 | (setq buffer-file-name (concat (shadow-site-primary cluster2) file)) | ||
| 732 | (insert "foo") | ||
| 733 | (save-buffer)) | ||
| 734 | (should | ||
| 735 | (member | ||
| 736 | (cons | ||
| 737 | (concat (shadow-site-primary cluster2) file) | ||
| 738 | (shadow-contract-file-name (concat "/cluster1:" file))) | ||
| 739 | shadow-files-to-copy)) | ||
| 740 | |||
| 741 | ;; Define a regexp group. | ||
| 742 | (setq shadow-files-to-copy nil | ||
| 743 | shadow-regexp-groups | ||
| 744 | `((,(concat (shadow-site-primary cluster1) | ||
| 745 | (shadow-regexp-superquote file)) | ||
| 746 | ,(concat (shadow-site-primary cluster2) | ||
| 747 | (shadow-regexp-superquote file))))) | ||
| 748 | |||
| 749 | ;; Save file from "cluster1" definition. | ||
| 750 | (with-temp-buffer | ||
| 751 | (setq buffer-file-name file) | ||
| 752 | (insert "foo") | ||
| 753 | (save-buffer)) | ||
| 754 | (should | ||
| 755 | (member | ||
| 756 | (cons file (shadow-contract-file-name (concat "/cluster2:" file))) | ||
| 757 | shadow-files-to-copy)) | ||
| 758 | |||
| 759 | ;; Save file from "cluster2" definition. | ||
| 760 | (with-temp-buffer | ||
| 761 | (setq buffer-file-name (concat (shadow-site-primary cluster2) file)) | ||
| 762 | (insert "foo") | ||
| 763 | (save-buffer)) | ||
| 764 | (should | ||
| 765 | (member | ||
| 766 | (cons | ||
| 767 | (concat (shadow-site-primary cluster2) file) | ||
| 768 | (shadow-contract-file-name (concat "/cluster1:" file))) | ||
| 769 | shadow-files-to-copy))) | ||
| 770 | |||
| 771 | ;; Cleanup. | ||
| 772 | (when (file-exists-p shadow-info-file) | ||
| 773 | (delete-file shadow-info-file)) | ||
| 774 | (when (file-exists-p shadow-todo-file) | ||
| 775 | (delete-file shadow-todo-file)) | ||
| 776 | (when (file-exists-p file) | ||
| 777 | (delete-file file)) | ||
| 778 | (when (file-exists-p (concat (shadow-site-primary cluster2) file)) | ||
| 779 | (delete-file (concat (shadow-site-primary cluster2) file)))))) | ||
| 780 | |||
| 781 | (ert-deftest shadow-test09-shadow-copy-files () | ||
| 782 | "Check that needed shadow files are copied." | ||
| 783 | (let ((backup-inhibited t) | ||
| 784 | (shadow-info-file shadow-test-info-file) | ||
| 785 | (shadow-todo-file shadow-test-todo-file) | ||
| 786 | (shadow-inhibit-message t) | ||
| 787 | (shadow-noquery t) | ||
| 788 | shadow-clusters shadow-files-to-copy | ||
| 789 | cluster1 cluster2 primary regexp file mocked-input) | ||
| 790 | (unwind-protect | ||
| 791 | (progn | ||
| 792 | ;; Cleanup. | ||
| 793 | (when (file-exists-p shadow-info-file) | ||
| 794 | (delete-file shadow-info-file)) | ||
| 795 | (when (file-exists-p shadow-todo-file) | ||
| 796 | (delete-file shadow-todo-file)) | ||
| 797 | (when (buffer-live-p shadow-todo-buffer) | ||
| 798 | (with-current-buffer shadow-todo-buffer (erase-buffer))) | ||
| 799 | |||
| 800 | ;; Define clusters. | ||
| 801 | (setq cluster1 "cluster1" | ||
| 802 | primary shadow-system-name | ||
| 803 | regexp (shadow-regexp-superquote primary)) | ||
| 804 | (shadow-set-cluster cluster1 primary regexp) | ||
| 805 | |||
| 806 | (setq cluster2 "cluster2" | ||
| 807 | primary | ||
| 808 | (file-remote-p shadow-test-remote-temporary-file-directory) | ||
| 809 | regexp (shadow-regexp-superquote primary)) | ||
| 810 | (shadow-set-cluster cluster2 primary regexp) | ||
| 811 | |||
| 812 | ;; Define files to copy. | ||
| 813 | (setq file | ||
| 814 | (make-temp-name | ||
| 815 | (expand-file-name "shadowfile-tests" temporary-file-directory)) | ||
| 816 | shadow-literal-groups | ||
| 817 | `((,(concat "/cluster1:" file) ,(concat "/cluster2:" file))) | ||
| 818 | shadow-regexp-groups | ||
| 819 | `((,(concat (shadow-site-primary cluster1) | ||
| 820 | (shadow-regexp-superquote file)) | ||
| 821 | ,(concat (shadow-site-primary cluster2) | ||
| 822 | (shadow-regexp-superquote file)))) | ||
| 823 | mocked-input `(,(concat (shadow-site-primary cluster2) file) | ||
| 824 | ,file)) | ||
| 825 | |||
| 826 | ;; Save files. | ||
| 827 | (with-temp-buffer | ||
| 828 | (setq buffer-file-name file) | ||
| 829 | (insert "foo") | ||
| 830 | (save-buffer)) | ||
| 831 | (with-temp-buffer | ||
| 832 | (setq buffer-file-name (concat (shadow-site-primary cluster2) file)) | ||
| 833 | (insert "foo") | ||
| 834 | (save-buffer)) | ||
| 835 | |||
| 836 | ;; We must mock `write-region', in order to check proper | ||
| 837 | ;; action. | ||
| 838 | (add-function | ||
| 839 | :before (symbol-function 'write-region) | ||
| 840 | (lambda (&rest args) | ||
| 841 | (when (and (buffer-file-name) mocked-input) | ||
| 842 | (should (equal (buffer-file-name) (pop mocked-input))))) | ||
| 843 | '((name . "write-region-mock"))) | ||
| 844 | |||
| 845 | ;; Copy the files. | ||
| 846 | (shadow-copy-files 'noquery) | ||
| 847 | (should-not shadow-files-to-copy) | ||
| 848 | (with-current-buffer shadow-todo-buffer | ||
| 849 | (goto-char (point-min)) | ||
| 850 | (should | ||
| 851 | (looking-at (regexp-quote "(setq shadow-files-to-copy nil)"))))) | ||
| 852 | |||
| 853 | ;; Cleanup. | ||
| 854 | (remove-function (symbol-function 'write-region) "write-region-mock") | ||
| 855 | (when (file-exists-p shadow-info-file) | ||
| 856 | (delete-file shadow-info-file)) | ||
| 857 | (when (file-exists-p shadow-todo-file) | ||
| 858 | (delete-file shadow-todo-file)) | ||
| 859 | (when (file-exists-p file) | ||
| 860 | (delete-file file)) | ||
| 861 | (when (file-exists-p (concat (shadow-site-primary cluster2) file)) | ||
| 862 | (delete-file (concat (shadow-site-primary cluster2) file)))))) | ||
| 863 | |||
| 864 | (defun shadowfile-test-all (&optional interactive) | ||
| 865 | "Run all tests for \\[shadowfile]." | ||
| 866 | (interactive "p") | ||
| 867 | (if interactive | ||
| 868 | (ert-run-tests-interactively "^shadowfile-") | ||
| 869 | (ert-run-tests-batch "^shadowfile-"))) | ||
| 870 | |||
| 871 | (let ((shadow-info-file shadow-test-info-file) | ||
| 872 | (shadow-todo-file shadow-test-todo-file)) | ||
| 873 | (shadow-initialize)) | ||
| 874 | |||
| 875 | (provide 'shadowfile-tests) | ||
| 876 | ;;; shadowfile-tests.el ends here | ||