Fix Bug#37202

* 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.

diff --git a/lisp/shadowfile.el b/lisp/shadowfile.el
index 07e78506654ab00f56f75052de2b77205ac4da0d..4566ea19f8d412f6e60e79dd201af5291fbcf32e 100644 (file)
--- 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 2a777af4720c37a85768abdc57ec4586cecac156..5ab663c69b3160f3eae729a5c68c91cf3483318b 100644 (file)
--- 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)