From 01a04880ca7469626a03ea10481d60c5ddec4663 Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Sat, 7 Sep 2019 12:31:31 +0200 Subject: [PATCH] Add traces in shadowfile * lisp/shadowfile.el (shadow-add-to-todo) (shadow-remove-from-todo, shadow-save-todo-file): * test/lisp/shadowfile-tests.el (shadow-test08-shadow-todo): Add traces. --- lisp/shadowfile.el | 12 +++++++- test/lisp/shadowfile-tests.el | 55 ++++++++++++++++++++--------------- 2 files changed, 42 insertions(+), 25 deletions(-) diff --git a/lisp/shadowfile.el b/lisp/shadowfile.el index 4566ea19f8d..2778e583674 100644 --- a/lisp/shadowfile.el +++ b/lisp/shadowfile.el @@ -634,6 +634,10 @@ Consider them as regular expressions if third arg REGEXP is true." (let ((shadows (shadow-shadows-of (shadow-expand-file-name (buffer-file-name (current-buffer)))))) + (when shadow-debug + (message + "shadow-add-to-todo: %s %s\n%s" + shadows shadow-files-to-copy (with-output-to-string (backtrace)))) (when shadows (setq shadow-files-to-copy (shadow-union shadows shadow-files-to-copy)) @@ -647,6 +651,10 @@ Consider them as regular expressions if third arg REGEXP is true." (defun shadow-remove-from-todo (pair) "Remove PAIR from `shadow-files-to-copy'. PAIR must be `eq' to one of the elements of that list." + (when shadow-debug + (message + "shadow-remove-from-todo: %s %s\n%s" + pair shadow-files-to-copy (with-output-to-string (backtrace)))) (setq shadow-files-to-copy (cl-remove-if (lambda (s) (eq s pair)) shadow-files-to-copy))) @@ -717,6 +725,8 @@ With non-nil argument also saves the buffer." (if save (shadow-save-todo-file)))) (defun shadow-save-todo-file () + (when shadow-debug + (message "shadow-save-todo-file:\n%s" (with-output-to-string (backtrace)))) (if (and shadow-todo-buffer (buffer-modified-p shadow-todo-buffer)) (with-current-buffer shadow-todo-buffer (condition-case nil ; have to continue even in case of @@ -772,7 +782,7 @@ look for files that have been changed and need to be copied to other systems." (buffer-list)))) (yes-or-no-p "Modified buffers exist; exit anyway? ")) (or (not (fboundp 'process-list)) - ;; process-list is not defined on MSDOS. + ;; `process-list' is not defined on MSDOS. (let ((processes (process-list)) active) (while processes diff --git a/test/lisp/shadowfile-tests.el b/test/lisp/shadowfile-tests.el index a523a340a40..2696704e7fe 100644 --- a/test/lisp/shadowfile-tests.el +++ b/test/lisp/shadowfile-tests.el @@ -126,9 +126,9 @@ guaranteed by the originator of a cluster definition." (unwind-protect ;; We must mock `read-from-minibuffer' and `read-string', in ;; order to avoid interactive arguments. - (cl-letf* (((symbol-function 'read-from-minibuffer) + (cl-letf* (((symbol-function #'read-from-minibuffer) (lambda (&rest args) (pop mocked-input))) - ((symbol-function 'read-string) + ((symbol-function #'read-string) (lambda (&rest args) (pop mocked-input)))) ;; Cleanup & initialize. @@ -140,7 +140,7 @@ guaranteed by the originator of a cluster definition." primary shadow-system-name regexp (shadow-regexp-superquote primary) mocked-input `(,cluster ,primary ,regexp)) - (call-interactively 'shadow-define-cluster) + (call-interactively #'shadow-define-cluster) (should (string-equal (shadow-cluster-name (shadow-get-cluster cluster)) cluster)) @@ -164,7 +164,7 @@ guaranteed by the originator of a cluster definition." mocked-input `(,cluster ,cluster ,primary ,regexp)) (with-current-buffer (messages-buffer) (narrow-to-region (point-max) (point-max))) - (call-interactively 'shadow-define-cluster) + (call-interactively #'shadow-define-cluster) (should (string-match (regexp-quote "Not a valid primary!") @@ -185,7 +185,7 @@ guaranteed by the originator of a cluster definition." mocked-input `(,cluster ,primary ,cluster ,regexp)) (with-current-buffer (messages-buffer) (narrow-to-region (point-max) (point-max))) - (call-interactively 'shadow-define-cluster) + (call-interactively #'shadow-define-cluster) (should (string-match (regexp-quote "Regexp doesn't include the primary host!") @@ -206,7 +206,7 @@ guaranteed by the originator of a cluster definition." (file-remote-p shadow-test-remote-temporary-file-directory) regexp (shadow-regexp-superquote primary) mocked-input `(,cluster ,primary ,regexp)) - (call-interactively 'shadow-define-cluster) + (call-interactively #'shadow-define-cluster) (should (string-equal (shadow-cluster-name (shadow-get-cluster cluster)) cluster)) @@ -243,9 +243,9 @@ guaranteed by the originator of a cluster definition." (unwind-protect ;; We must mock `read-from-minibuffer' and `read-string', in ;; order to avoid interactive arguments. - (cl-letf* (((symbol-function 'read-from-minibuffer) + (cl-letf* (((symbol-function #'read-from-minibuffer) (lambda (&rest args) (pop mocked-input))) - ((symbol-function 'read-string) + ((symbol-function #'read-string) (lambda (&rest args) (pop mocked-input)))) ;; Cleanup & initialize. @@ -596,9 +596,9 @@ guaranteed by the originator of a cluster definition." (unwind-protect ;; We must mock `read-from-minibuffer' and `read-string', in ;; order to avoid interactive arguments. - (cl-letf* (((symbol-function 'read-from-minibuffer) + (cl-letf* (((symbol-function #'read-from-minibuffer) (lambda (&rest args) (pop mocked-input))) - ((symbol-function 'read-string) + ((symbol-function #'read-string) (lambda (&rest args) (pop mocked-input)))) ;; Cleanup & initialize. @@ -629,7 +629,7 @@ 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. @@ -657,9 +657,9 @@ guaranteed by the originator of a cluster definition." (unwind-protect ;; We must mock `read-from-minibuffer' and `read-string', in ;; order to avoid interactive arguments. - (cl-letf* (((symbol-function 'read-from-minibuffer) + (cl-letf* (((symbol-function #'read-from-minibuffer) (lambda (&rest args) (pop mocked-input))) - ((symbol-function 'read-string) + ((symbol-function #'read-string) (lambda (&rest args) (pop mocked-input)))) ;; Cleanup & initialize. @@ -686,7 +686,8 @@ guaranteed by the originator of a cluster definition." ,cluster1 ,cluster2 ,(kbd "RET"))) (with-temp-buffer (set-visited-file-name nil) - (call-interactively 'shadow-define-regexp-group)) + (call-interactively #'shadow-define-regexp-group) + (set-buffer-modified-p nil)) ;; `shadow-regexp-groups' is a list of lists. (should (consp shadow-regexp-groups)) @@ -733,7 +734,9 @@ guaranteed by the originator of a cluster definition." regexp (shadow-regexp-superquote primary)) (shadow-set-cluster cluster1 primary regexp) (when shadow-debug - (message "%s %s %s %s" cluster1 primary regexp shadow-clusters)) + (message + "shadow-test08-shadow-todo: %s %s %s %s" + cluster1 primary regexp shadow-clusters)) (setq cluster2 "cluster2" primary @@ -741,7 +744,9 @@ guaranteed by the originator of a cluster definition." regexp (shadow-regexp-superquote primary)) (shadow-set-cluster cluster2 primary regexp) (when shadow-debug - (message "%s %s %s %s" cluster2 primary regexp shadow-clusters)) + (message + "shadow-test08-shadow-todo: %s %s %s %s" + cluster2 primary regexp shadow-clusters)) ;; Define a literal group. (setq file @@ -750,7 +755,8 @@ guaranteed by the originator of a cluster definition." shadow-literal-groups `((,(concat "/cluster1:" file) ,(concat "/cluster2:" file)))) (when shadow-debug - (message "%s %s" file shadow-literal-groups)) + (message + "shadow-test08-shadow-todo: %s %s" file shadow-literal-groups)) ;; Save file from "cluster1" definition. (with-temp-buffer @@ -759,7 +765,7 @@ guaranteed by the originator of a cluster definition." (save-buffer)) (when shadow-debug (message - "%s %s" + "shadow-test08-shadow-todo: %s %s" (cons file (shadow-contract-file-name (concat "/cluster2:" file))) shadow-files-to-copy)) (should @@ -774,7 +780,7 @@ guaranteed by the originator of a cluster definition." (save-buffer)) (when shadow-debug (message - "%s %s" + "shadow-test08-shadow-todo: %s %s" (cons (concat (shadow-site-primary cluster2) file) (shadow-contract-file-name (concat "/cluster1:" file))) @@ -794,7 +800,8 @@ guaranteed by the originator of a cluster definition." ,(concat (shadow-site-primary cluster2) (shadow-regexp-superquote file))))) (when shadow-debug - (message "%s %s" file shadow-regexp-groups)) + (message + "shadow-test08-shadow-todo: %s %s" file shadow-regexp-groups)) ;; Save file from "cluster1" definition. (with-temp-buffer @@ -803,7 +810,7 @@ guaranteed by the originator of a cluster definition." (save-buffer)) (when shadow-debug (message - "%s %s" + "shadow-test08-shadow-todo: %s %s" (cons file (shadow-contract-file-name (concat "/cluster2:" file))) shadow-files-to-copy)) (should @@ -818,7 +825,7 @@ guaranteed by the originator of a cluster definition." (save-buffer)) (when shadow-debug (message - "%s %s" + "shadow-test08-shadow-todo: %s %s" (cons (concat (shadow-site-primary cluster2) file) (shadow-contract-file-name (concat "/cluster1:" file))) @@ -898,7 +905,7 @@ guaranteed by the originator of a cluster definition." ;; We must mock `write-region', in order to check proper ;; action. (add-function - :before (symbol-function 'write-region) + :before (symbol-function #'write-region) (lambda (&rest args) (when (and (buffer-file-name) mocked-input) (should (equal (buffer-file-name) (pop mocked-input))))) @@ -913,7 +920,7 @@ guaranteed by the originator of a cluster definition." (looking-at (regexp-quote "(setq shadow-files-to-copy nil)"))))) ;; Cleanup. - (remove-function (symbol-function 'write-region) "write-region-mock") + (remove-function (symbol-function #'write-region) "write-region-mock") (dolist (elt `(,file ,(concat (shadow-site-primary cluster2) file))) (ignore-errors (with-current-buffer (get-file-buffer elt) -- 2.39.5