aboutsummaryrefslogtreecommitdiffstats
path: root/test
diff options
context:
space:
mode:
Diffstat (limited to 'test')
-rw-r--r--test/lisp/shadowfile-tests.el876
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.
64Per definition, all files are identical on the different hosts of
65a cluster (or site). This is not tested here; it must be
66guaranteed 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.
187Per definition, all files are identical on the different hosts of
188a cluster (or site). This is not tested here; it must be
189guaranteed 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