mirror/emacs
1
0
Fork 0
mirror of https://git.savannah.gnu.org/git/emacs.git synced 2024-12-16 09:50:25 +00:00
Code Issues Releases Activity

Fix Bug#37202

Browse Source 
* lisp/shadowfile.el (shadow-debug): New defvar.
(shadow-read-files): Suppress error if there's no TODO file.

* test/lisp/shadowfile-tests.el (shadow-debug): Set to nil.
(shadow--tests-cleanup): New defun.  Apply to all tests.  (Bug#37202)
(shadow-test06-literal-groups): Cleanup temp buffer.
(shadow-test08-shadow-todo): Add debug messages.
(top): Cleanup initially.
This commit is contained in:
Michael Albinus 2019-09-03 13:55:42 +02:00
parent fda015e7b8
commit ea5d591f29
2 changed files with 94 additions and 97 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
lisp/shadowfile.el
View File

@ -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))

186
test/lisp/shadowfile-tests.el
View File

@ -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)