diff options
| -rw-r--r-- | lisp/shadowfile.el | 5 | ||||
| -rw-r--r-- | test/lisp/shadowfile-tests.el | 186 |
2 files changed, 94 insertions, 97 deletions
diff --git a/lisp/shadowfile.el b/lisp/shadowfile.el index 07e78506654..4566ea19f8d 100644 --- a/lisp/shadowfile.el +++ b/lisp/shadowfile.el @@ -165,6 +165,9 @@ created by `shadow-define-regexp-group'.") (defvar shadow-info-buffer nil) ; buf visiting shadow-info-file (defvar shadow-todo-buffer nil) ; buf visiting shadow-todo-file +(defvar shadow-debug nil + "Use for debug messages.") + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Syntactic sugar; General list and string manipulation ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -673,7 +676,7 @@ Return t unless files were locked; then return nil." (eval-buffer)) (when shadow-todo-file (set-buffer (setq shadow-todo-buffer - (find-file-noselect shadow-todo-file))) + (find-file-noselect shadow-todo-file 'nowarn))) (when (and (not (buffer-modified-p)) (file-newer-than-file-p (make-auto-save-file-name) shadow-todo-file)) diff --git a/test/lisp/shadowfile-tests.el b/test/lisp/shadowfile-tests.el index 2a777af4720..5ab663c69b3 100644 --- a/test/lisp/shadowfile-tests.el +++ b/test/lisp/shadowfile-tests.el @@ -64,6 +64,7 @@ "Temporary directory for Tramp tests.") (setq password-cache-expiry nil + shadow-debug nil tramp-verbose 0 tramp-message-show-message nil) @@ -79,6 +80,35 @@ (expand-file-name "shadow_todo_test" temporary-file-directory) "File to store the list of uncopied shadows in during tests.") +(defun shadow--tests-cleanup () + "Reset all `shadowfile' internals." + ;; Delete auto-saved files. + (with-current-buffer (find-file-noselect shadow-info-file 'nowarn) + (ignore-errors (delete-file (make-auto-save-file-name))) + (set-buffer-modified-p nil) + (kill-buffer)) + (with-current-buffer (find-file-noselect shadow-todo-file 'nowarn) + (ignore-errors (delete-file (make-auto-save-file-name))) + (set-buffer-modified-p nil) + (kill-buffer)) + ;; Delete buffers. + (when (buffer-live-p shadow-info-buffer) + (with-current-buffer shadow-info-buffer + (set-buffer-modified-p nil) + (kill-buffer))) + (when (buffer-live-p shadow-todo-buffer) + (with-current-buffer shadow-todo-buffer + (set-buffer-modified-p nil) + (kill-buffer))) + ;; Delete files. + (ignore-errors (delete-file shadow-info-file)) + (ignore-errors (delete-file shadow-todo-file)) + ;; Reset variables. + (setq shadow-info-buffer nil + shadow-hashtable nil + shadow-todo-buffer nil + shadow-files-to-copy nil)) + (ert-deftest shadow-test00-clusters () "Check cluster definitions. Per definition, all files are identical on the different hosts of @@ -101,11 +131,8 @@ guaranteed by the originator of a cluster definition." ((symbol-function 'read-string) (lambda (&rest args) (pop mocked-input)))) - ;; Cleanup. - (when (file-exists-p shadow-info-file) - (delete-file shadow-info-file)) - (when (file-exists-p shadow-todo-file) - (delete-file shadow-todo-file)) + ;; Cleanup. + (shadow--tests-cleanup) ;; Define a cluster. (setq cluster "cluster" @@ -198,10 +225,7 @@ guaranteed by the originator of a cluster definition." ;; Cleanup. (with-current-buffer (messages-buffer) (widen)) - (when (file-exists-p shadow-info-file) - (delete-file shadow-info-file)) - (when (file-exists-p shadow-todo-file) - (delete-file shadow-todo-file))))) + (shadow--tests-cleanup)))) (ert-deftest shadow-test01-sites () "Check site definitions. @@ -224,10 +248,7 @@ guaranteed by the originator of a cluster definition." (lambda (&rest args) (pop mocked-input)))) ;; Cleanup. - (when (file-exists-p shadow-info-file) - (delete-file shadow-info-file)) - (when (file-exists-p shadow-todo-file) - (delete-file shadow-todo-file)) + (shadow--tests-cleanup) ;; Define a cluster. (setq cluster1 "cluster1" @@ -308,10 +329,7 @@ guaranteed by the originator of a cluster definition." (shadow-site-match (shadow-site-primary cluster1) cluster2))) ;; Cleanup. - (when (file-exists-p shadow-info-file) - (delete-file shadow-info-file)) - (when (file-exists-p shadow-todo-file) - (delete-file shadow-todo-file))))) + (shadow--tests-cleanup)))) (ert-deftest shadow-test02-files () "Check file manipulation functions." @@ -325,10 +343,7 @@ guaranteed by the originator of a cluster definition." (unwind-protect (progn ;; Cleanup. - (when (file-exists-p shadow-info-file) - (delete-file shadow-info-file)) - (when (file-exists-p shadow-todo-file) - (delete-file shadow-todo-file)) + (shadow--tests-cleanup) ;; Define a cluster. (setq cluster "cluster" @@ -384,10 +399,7 @@ guaranteed by the originator of a cluster definition." (should-not (shadow-local-file nil))) ;; Cleanup. - (when (file-exists-p shadow-info-file) - (delete-file shadow-info-file)) - (when (file-exists-p shadow-todo-file) - (delete-file shadow-todo-file))))) + (shadow--tests-cleanup)))) (ert-deftest shadow-test03-expand-cluster-in-file-name () "Check canonical file name of a cluster or site." @@ -401,10 +413,7 @@ guaranteed by the originator of a cluster definition." (unwind-protect (progn ;; Cleanup. - (when (file-exists-p shadow-info-file) - (delete-file shadow-info-file)) - (when (file-exists-p shadow-todo-file) - (delete-file shadow-todo-file)) + (shadow--tests-cleanup) ;; Define a cluster. (setq cluster "cluster" @@ -455,10 +464,7 @@ guaranteed by the originator of a cluster definition." (concat primary file1)))) ;; Cleanup. - (when (file-exists-p shadow-info-file) - (delete-file shadow-info-file)) - (when (file-exists-p shadow-todo-file) - (delete-file shadow-todo-file))))) + (shadow--tests-cleanup)))) (ert-deftest shadow-test04-contract-file-name () "Check canonical file name of a cluster or site." @@ -472,10 +478,7 @@ guaranteed by the originator of a cluster definition." (unwind-protect (progn ;; Cleanup. - (when (file-exists-p shadow-info-file) - (delete-file shadow-info-file)) - (when (file-exists-p shadow-todo-file) - (delete-file shadow-todo-file)) + (shadow--tests-cleanup) ;; Define a cluster. (setq cluster "cluster" @@ -516,10 +519,7 @@ guaranteed by the originator of a cluster definition." (concat "/cluster:" file)))) ;; Cleanup. - (when (file-exists-p shadow-info-file) - (delete-file shadow-info-file)) - (when (file-exists-p shadow-todo-file) - (delete-file shadow-todo-file))))) + (shadow--tests-cleanup)))) (ert-deftest shadow-test05-file-match () "Check `shadow-same-site' and `shadow-file-match'." @@ -533,10 +533,7 @@ guaranteed by the originator of a cluster definition." (unwind-protect (progn ;; Cleanup. - (when (file-exists-p shadow-info-file) - (delete-file shadow-info-file)) - (when (file-exists-p shadow-todo-file) - (delete-file shadow-todo-file)) + (shadow--tests-cleanup) ;; Define a cluster. (setq cluster "cluster" @@ -575,10 +572,7 @@ guaranteed by the originator of a cluster definition." file))) ;; Cleanup. - (when (file-exists-p shadow-info-file) - (delete-file shadow-info-file)) - (when (file-exists-p shadow-todo-file) - (delete-file shadow-todo-file))))) + (shadow--tests-cleanup)))) (ert-deftest shadow-test06-literal-groups () "Check literal group definitions." @@ -598,10 +592,7 @@ guaranteed by the originator of a cluster definition." (lambda (&rest args) (pop mocked-input)))) ;; Cleanup. - (when (file-exists-p shadow-info-file) - (delete-file shadow-info-file)) - (when (file-exists-p shadow-todo-file) - (delete-file shadow-todo-file)) + (shadow--tests-cleanup) ;; Define clusters. (setq cluster1 "cluster1" @@ -627,7 +618,8 @@ guaranteed by the originator of a cluster definition." mocked-input `(,cluster1 ,file1 ,cluster2 ,file2 ,(kbd "RET"))) (with-temp-buffer (set-visited-file-name file1) - (call-interactively 'shadow-define-literal-group)) + (call-interactively 'shadow-define-literal-group) + (set-buffer-modified-p nil)) ;; `shadow-literal-groups' is a list of lists. (should (consp shadow-literal-groups)) @@ -640,10 +632,7 @@ guaranteed by the originator of a cluster definition." (car shadow-literal-groups)))) ;; Cleanup. - (when (file-exists-p shadow-info-file) - (delete-file shadow-info-file)) - (when (file-exists-p shadow-todo-file) - (delete-file shadow-todo-file))))) + (shadow--tests-cleanup)))) (ert-deftest shadow-test07-regexp-groups () "Check regexp group definitions." @@ -663,10 +652,7 @@ guaranteed by the originator of a cluster definition." (lambda (&rest args) (pop mocked-input)))) ;; Cleanup. - (when (file-exists-p shadow-info-file) - (delete-file shadow-info-file)) - (when (file-exists-p shadow-todo-file) - (delete-file shadow-todo-file)) + (shadow--tests-cleanup) ;; Define clusters. (setq cluster1 "cluster1" @@ -707,10 +693,7 @@ guaranteed by the originator of a cluster definition." (car shadow-regexp-groups)))) ;; Cleanup. - (when (file-exists-p shadow-info-file) - (delete-file shadow-info-file)) - (when (file-exists-p shadow-todo-file) - (delete-file shadow-todo-file))))) + (shadow--tests-cleanup)))) (ert-deftest shadow-test08-shadow-todo () "Check that needed shadows are added to todo." @@ -728,22 +711,23 @@ guaranteed by the originator of a cluster definition." (unwind-protect (progn ;; Cleanup. - (when (file-exists-p shadow-info-file) - (delete-file shadow-info-file)) - (when (file-exists-p shadow-todo-file) - (delete-file shadow-todo-file)) + (shadow--tests-cleanup) ;; Define clusters. (setq cluster1 "cluster1" primary shadow-system-name regexp (shadow-regexp-superquote primary)) (shadow-set-cluster cluster1 primary regexp) + (when shadow-debug + (message "%s %s %s %s" cluster1 primary regexp shadow-clusters)) (setq cluster2 "cluster2" primary (file-remote-p shadow-test-remote-temporary-file-directory) regexp (shadow-regexp-superquote primary)) (shadow-set-cluster cluster2 primary regexp) + (when shadow-debug + (message "%s %s %s %s" cluster2 primary regexp shadow-clusters)) ;; Define a literal group. (setq file @@ -751,12 +735,19 @@ guaranteed by the originator of a cluster definition." (expand-file-name "shadowfile-tests" temporary-file-directory)) shadow-literal-groups `((,(concat "/cluster1:" file) ,(concat "/cluster2:" file)))) + (when shadow-debug + (message "%s %s" file shadow-literal-groups)) ;; Save file from "cluster1" definition. (with-temp-buffer (set-visited-file-name file) (insert "foo") (save-buffer)) + (when shadow-debug + (message + "%s %s" + (cons file (shadow-contract-file-name (concat "/cluster2:" file))) + shadow-files-to-copy)) (should (member (cons file (shadow-contract-file-name (concat "/cluster2:" file))) @@ -767,6 +758,13 @@ guaranteed by the originator of a cluster definition." (set-visited-file-name (concat (shadow-site-primary cluster2) file)) (insert "foo") (save-buffer)) + (when shadow-debug + (message + "%s %s" + (cons + (concat (shadow-site-primary cluster2) file) + (shadow-contract-file-name (concat "/cluster1:" file))) + shadow-files-to-copy)) (should (member (cons @@ -781,12 +779,19 @@ guaranteed by the originator of a cluster definition." (shadow-regexp-superquote file)) ,(concat (shadow-site-primary cluster2) (shadow-regexp-superquote file))))) + (when shadow-debug + (message "%s %s" file shadow-regexp-groups)) ;; Save file from "cluster1" definition. (with-temp-buffer (set-visited-file-name file) (insert "foo") (save-buffer)) + (when shadow-debug + (message + "%s %s" + (cons file (shadow-contract-file-name (concat "/cluster2:" file))) + shadow-files-to-copy)) (should (member (cons file (shadow-contract-file-name (concat "/cluster2:" file))) @@ -797,6 +802,13 @@ guaranteed by the originator of a cluster definition." (set-visited-file-name (concat (shadow-site-primary cluster2) file)) (insert "foo") (save-buffer)) + (when shadow-debug + (message + "%s %s" + (cons + (concat (shadow-site-primary cluster2) file) + (shadow-contract-file-name (concat "/cluster1:" file))) + shadow-files-to-copy)) (should (member (cons @@ -805,16 +817,9 @@ guaranteed by the originator of a cluster definition." shadow-files-to-copy))) ;; Cleanup. - (when (file-exists-p shadow-info-file) - (delete-file shadow-info-file)) - (when (file-exists-p shadow-todo-file) - (delete-file shadow-todo-file)) - (ignore-errors - (when (file-exists-p file) - (delete-file file))) - (ignore-errors - (when (file-exists-p (concat (shadow-site-primary cluster2) file)) - (delete-file (concat (shadow-site-primary cluster2) file))))))) + (ignore-errors (delete-file file)) + (ignore-errors (delete-file (concat (shadow-site-primary cluster2) file))) + (shadow--tests-cleanup)))) (ert-deftest shadow-test09-shadow-copy-files () "Check that needed shadow files are copied." @@ -832,12 +837,7 @@ guaranteed by the originator of a cluster definition." (unwind-protect (progn ;; Cleanup. - (when (file-exists-p shadow-info-file) - (delete-file shadow-info-file)) - (when (file-exists-p shadow-todo-file) - (delete-file shadow-todo-file)) - (when (buffer-live-p shadow-todo-buffer) - (with-current-buffer shadow-todo-buffer (erase-buffer))) + (shadow--tests-cleanup) ;; Define clusters. (setq cluster1 "cluster1" @@ -894,16 +894,9 @@ guaranteed by the originator of a cluster definition." ;; Cleanup. (remove-function (symbol-function 'write-region) "write-region-mock") - (when (file-exists-p shadow-info-file) - (delete-file shadow-info-file)) - (when (file-exists-p shadow-todo-file) - (delete-file shadow-todo-file)) - (ignore-errors - (when (file-exists-p file) - (delete-file file))) - (ignore-errors - (when (file-exists-p (concat (shadow-site-primary cluster2) file)) - (delete-file (concat (shadow-site-primary cluster2) file))))))) + (ignore-errors (delete-file file)) + (ignore-errors (delete-file (concat (shadow-site-primary cluster2) file))) + (shadow--tests-cleanup)))) (defun shadowfile-test-all (&optional interactive) "Run all tests for \\[shadowfile]." @@ -914,6 +907,7 @@ guaranteed by the originator of a cluster definition." (let ((shadow-info-file shadow-test-info-file) (shadow-todo-file shadow-test-todo-file)) + (shadow--tests-cleanup) (shadow-initialize)) (provide 'shadowfile-tests) |