diff options
| author | Michael Albinus | 2019-09-07 12:31:31 +0200 |
|---|---|---|
| committer | Michael Albinus | 2019-09-07 12:31:31 +0200 |
| commit | 01a04880ca7469626a03ea10481d60c5ddec4663 (patch) | |
| tree | 171e9538fc8e870bb046053946ff0490ef95dd11 | |
| parent | 52f83af1f3975130b6bd035166780c2c2dde778c (diff) | |
| download | emacs-01a04880ca7469626a03ea10481d60c5ddec4663.tar.gz emacs-01a04880ca7469626a03ea10481d60c5ddec4663.zip | |
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.
| -rw-r--r-- | lisp/shadowfile.el | 12 | ||||
| -rw-r--r-- | 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." | |||
| 634 | (let ((shadows (shadow-shadows-of | 634 | (let ((shadows (shadow-shadows-of |
| 635 | (shadow-expand-file-name | 635 | (shadow-expand-file-name |
| 636 | (buffer-file-name (current-buffer)))))) | 636 | (buffer-file-name (current-buffer)))))) |
| 637 | (when shadow-debug | ||
| 638 | (message | ||
| 639 | "shadow-add-to-todo: %s %s\n%s" | ||
| 640 | shadows shadow-files-to-copy (with-output-to-string (backtrace)))) | ||
| 637 | (when shadows | 641 | (when shadows |
| 638 | (setq shadow-files-to-copy | 642 | (setq shadow-files-to-copy |
| 639 | (shadow-union shadows shadow-files-to-copy)) | 643 | (shadow-union shadows shadow-files-to-copy)) |
| @@ -647,6 +651,10 @@ Consider them as regular expressions if third arg REGEXP is true." | |||
| 647 | (defun shadow-remove-from-todo (pair) | 651 | (defun shadow-remove-from-todo (pair) |
| 648 | "Remove PAIR from `shadow-files-to-copy'. | 652 | "Remove PAIR from `shadow-files-to-copy'. |
| 649 | PAIR must be `eq' to one of the elements of that list." | 653 | PAIR must be `eq' to one of the elements of that list." |
| 654 | (when shadow-debug | ||
| 655 | (message | ||
| 656 | "shadow-remove-from-todo: %s %s\n%s" | ||
| 657 | pair shadow-files-to-copy (with-output-to-string (backtrace)))) | ||
| 650 | (setq shadow-files-to-copy | 658 | (setq shadow-files-to-copy |
| 651 | (cl-remove-if (lambda (s) (eq s pair)) shadow-files-to-copy))) | 659 | (cl-remove-if (lambda (s) (eq s pair)) shadow-files-to-copy))) |
| 652 | 660 | ||
| @@ -717,6 +725,8 @@ With non-nil argument also saves the buffer." | |||
| 717 | (if save (shadow-save-todo-file)))) | 725 | (if save (shadow-save-todo-file)))) |
| 718 | 726 | ||
| 719 | (defun shadow-save-todo-file () | 727 | (defun shadow-save-todo-file () |
| 728 | (when shadow-debug | ||
| 729 | (message "shadow-save-todo-file:\n%s" (with-output-to-string (backtrace)))) | ||
| 720 | (if (and shadow-todo-buffer (buffer-modified-p shadow-todo-buffer)) | 730 | (if (and shadow-todo-buffer (buffer-modified-p shadow-todo-buffer)) |
| 721 | (with-current-buffer shadow-todo-buffer | 731 | (with-current-buffer shadow-todo-buffer |
| 722 | (condition-case nil ; have to continue even in case of | 732 | (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." | |||
| 772 | (buffer-list)))) | 782 | (buffer-list)))) |
| 773 | (yes-or-no-p "Modified buffers exist; exit anyway? ")) | 783 | (yes-or-no-p "Modified buffers exist; exit anyway? ")) |
| 774 | (or (not (fboundp 'process-list)) | 784 | (or (not (fboundp 'process-list)) |
| 775 | ;; process-list is not defined on MSDOS. | 785 | ;; `process-list' is not defined on MSDOS. |
| 776 | (let ((processes (process-list)) | 786 | (let ((processes (process-list)) |
| 777 | active) | 787 | active) |
| 778 | (while processes | 788 | (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." | |||
| 126 | (unwind-protect | 126 | (unwind-protect |
| 127 | ;; We must mock `read-from-minibuffer' and `read-string', in | 127 | ;; We must mock `read-from-minibuffer' and `read-string', in |
| 128 | ;; order to avoid interactive arguments. | 128 | ;; order to avoid interactive arguments. |
| 129 | (cl-letf* (((symbol-function 'read-from-minibuffer) | 129 | (cl-letf* (((symbol-function #'read-from-minibuffer) |
| 130 | (lambda (&rest args) (pop mocked-input))) | 130 | (lambda (&rest args) (pop mocked-input))) |
| 131 | ((symbol-function 'read-string) | 131 | ((symbol-function #'read-string) |
| 132 | (lambda (&rest args) (pop mocked-input)))) | 132 | (lambda (&rest args) (pop mocked-input)))) |
| 133 | 133 | ||
| 134 | ;; Cleanup & initialize. | 134 | ;; Cleanup & initialize. |
| @@ -140,7 +140,7 @@ guaranteed by the originator of a cluster definition." | |||
| 140 | primary shadow-system-name | 140 | primary shadow-system-name |
| 141 | regexp (shadow-regexp-superquote primary) | 141 | regexp (shadow-regexp-superquote primary) |
| 142 | mocked-input `(,cluster ,primary ,regexp)) | 142 | mocked-input `(,cluster ,primary ,regexp)) |
| 143 | (call-interactively 'shadow-define-cluster) | 143 | (call-interactively #'shadow-define-cluster) |
| 144 | (should | 144 | (should |
| 145 | (string-equal | 145 | (string-equal |
| 146 | (shadow-cluster-name (shadow-get-cluster cluster)) cluster)) | 146 | (shadow-cluster-name (shadow-get-cluster cluster)) cluster)) |
| @@ -164,7 +164,7 @@ guaranteed by the originator of a cluster definition." | |||
| 164 | mocked-input `(,cluster ,cluster ,primary ,regexp)) | 164 | mocked-input `(,cluster ,cluster ,primary ,regexp)) |
| 165 | (with-current-buffer (messages-buffer) | 165 | (with-current-buffer (messages-buffer) |
| 166 | (narrow-to-region (point-max) (point-max))) | 166 | (narrow-to-region (point-max) (point-max))) |
| 167 | (call-interactively 'shadow-define-cluster) | 167 | (call-interactively #'shadow-define-cluster) |
| 168 | (should | 168 | (should |
| 169 | (string-match | 169 | (string-match |
| 170 | (regexp-quote "Not a valid primary!") | 170 | (regexp-quote "Not a valid primary!") |
| @@ -185,7 +185,7 @@ guaranteed by the originator of a cluster definition." | |||
| 185 | mocked-input `(,cluster ,primary ,cluster ,regexp)) | 185 | mocked-input `(,cluster ,primary ,cluster ,regexp)) |
| 186 | (with-current-buffer (messages-buffer) | 186 | (with-current-buffer (messages-buffer) |
| 187 | (narrow-to-region (point-max) (point-max))) | 187 | (narrow-to-region (point-max) (point-max))) |
| 188 | (call-interactively 'shadow-define-cluster) | 188 | (call-interactively #'shadow-define-cluster) |
| 189 | (should | 189 | (should |
| 190 | (string-match | 190 | (string-match |
| 191 | (regexp-quote "Regexp doesn't include the primary host!") | 191 | (regexp-quote "Regexp doesn't include the primary host!") |
| @@ -206,7 +206,7 @@ guaranteed by the originator of a cluster definition." | |||
| 206 | (file-remote-p shadow-test-remote-temporary-file-directory) | 206 | (file-remote-p shadow-test-remote-temporary-file-directory) |
| 207 | regexp (shadow-regexp-superquote primary) | 207 | regexp (shadow-regexp-superquote primary) |
| 208 | mocked-input `(,cluster ,primary ,regexp)) | 208 | mocked-input `(,cluster ,primary ,regexp)) |
| 209 | (call-interactively 'shadow-define-cluster) | 209 | (call-interactively #'shadow-define-cluster) |
| 210 | (should | 210 | (should |
| 211 | (string-equal | 211 | (string-equal |
| 212 | (shadow-cluster-name (shadow-get-cluster cluster)) cluster)) | 212 | (shadow-cluster-name (shadow-get-cluster cluster)) cluster)) |
| @@ -243,9 +243,9 @@ guaranteed by the originator of a cluster definition." | |||
| 243 | (unwind-protect | 243 | (unwind-protect |
| 244 | ;; We must mock `read-from-minibuffer' and `read-string', in | 244 | ;; We must mock `read-from-minibuffer' and `read-string', in |
| 245 | ;; order to avoid interactive arguments. | 245 | ;; order to avoid interactive arguments. |
| 246 | (cl-letf* (((symbol-function 'read-from-minibuffer) | 246 | (cl-letf* (((symbol-function #'read-from-minibuffer) |
| 247 | (lambda (&rest args) (pop mocked-input))) | 247 | (lambda (&rest args) (pop mocked-input))) |
| 248 | ((symbol-function 'read-string) | 248 | ((symbol-function #'read-string) |
| 249 | (lambda (&rest args) (pop mocked-input)))) | 249 | (lambda (&rest args) (pop mocked-input)))) |
| 250 | 250 | ||
| 251 | ;; Cleanup & initialize. | 251 | ;; Cleanup & initialize. |
| @@ -596,9 +596,9 @@ guaranteed by the originator of a cluster definition." | |||
| 596 | (unwind-protect | 596 | (unwind-protect |
| 597 | ;; We must mock `read-from-minibuffer' and `read-string', in | 597 | ;; We must mock `read-from-minibuffer' and `read-string', in |
| 598 | ;; order to avoid interactive arguments. | 598 | ;; order to avoid interactive arguments. |
| 599 | (cl-letf* (((symbol-function 'read-from-minibuffer) | 599 | (cl-letf* (((symbol-function #'read-from-minibuffer) |
| 600 | (lambda (&rest args) (pop mocked-input))) | 600 | (lambda (&rest args) (pop mocked-input))) |
| 601 | ((symbol-function 'read-string) | 601 | ((symbol-function #'read-string) |
| 602 | (lambda (&rest args) (pop mocked-input)))) | 602 | (lambda (&rest args) (pop mocked-input)))) |
| 603 | 603 | ||
| 604 | ;; Cleanup & initialize. | 604 | ;; Cleanup & initialize. |
| @@ -629,7 +629,7 @@ guaranteed by the originator of a cluster definition." | |||
| 629 | mocked-input `(,cluster1 ,file1 ,cluster2 ,file2 ,(kbd "RET"))) | 629 | mocked-input `(,cluster1 ,file1 ,cluster2 ,file2 ,(kbd "RET"))) |
| 630 | (with-temp-buffer | 630 | (with-temp-buffer |
| 631 | (set-visited-file-name file1) | 631 | (set-visited-file-name file1) |
| 632 | (call-interactively 'shadow-define-literal-group) | 632 | (call-interactively #'shadow-define-literal-group) |
| 633 | (set-buffer-modified-p nil)) | 633 | (set-buffer-modified-p nil)) |
| 634 | 634 | ||
| 635 | ;; `shadow-literal-groups' is a list of lists. | 635 | ;; `shadow-literal-groups' is a list of lists. |
| @@ -657,9 +657,9 @@ guaranteed by the originator of a cluster definition." | |||
| 657 | (unwind-protect | 657 | (unwind-protect |
| 658 | ;; We must mock `read-from-minibuffer' and `read-string', in | 658 | ;; We must mock `read-from-minibuffer' and `read-string', in |
| 659 | ;; order to avoid interactive arguments. | 659 | ;; order to avoid interactive arguments. |
| 660 | (cl-letf* (((symbol-function 'read-from-minibuffer) | 660 | (cl-letf* (((symbol-function #'read-from-minibuffer) |
| 661 | (lambda (&rest args) (pop mocked-input))) | 661 | (lambda (&rest args) (pop mocked-input))) |
| 662 | ((symbol-function 'read-string) | 662 | ((symbol-function #'read-string) |
| 663 | (lambda (&rest args) (pop mocked-input)))) | 663 | (lambda (&rest args) (pop mocked-input)))) |
| 664 | 664 | ||
| 665 | ;; Cleanup & initialize. | 665 | ;; Cleanup & initialize. |
| @@ -686,7 +686,8 @@ guaranteed by the originator of a cluster definition." | |||
| 686 | ,cluster1 ,cluster2 ,(kbd "RET"))) | 686 | ,cluster1 ,cluster2 ,(kbd "RET"))) |
| 687 | (with-temp-buffer | 687 | (with-temp-buffer |
| 688 | (set-visited-file-name nil) | 688 | (set-visited-file-name nil) |
| 689 | (call-interactively 'shadow-define-regexp-group)) | 689 | (call-interactively #'shadow-define-regexp-group) |
| 690 | (set-buffer-modified-p nil)) | ||
| 690 | 691 | ||
| 691 | ;; `shadow-regexp-groups' is a list of lists. | 692 | ;; `shadow-regexp-groups' is a list of lists. |
| 692 | (should (consp shadow-regexp-groups)) | 693 | (should (consp shadow-regexp-groups)) |
| @@ -733,7 +734,9 @@ guaranteed by the originator of a cluster definition." | |||
| 733 | regexp (shadow-regexp-superquote primary)) | 734 | regexp (shadow-regexp-superquote primary)) |
| 734 | (shadow-set-cluster cluster1 primary regexp) | 735 | (shadow-set-cluster cluster1 primary regexp) |
| 735 | (when shadow-debug | 736 | (when shadow-debug |
| 736 | (message "%s %s %s %s" cluster1 primary regexp shadow-clusters)) | 737 | (message |
| 738 | "shadow-test08-shadow-todo: %s %s %s %s" | ||
| 739 | cluster1 primary regexp shadow-clusters)) | ||
| 737 | 740 | ||
| 738 | (setq cluster2 "cluster2" | 741 | (setq cluster2 "cluster2" |
| 739 | primary | 742 | primary |
| @@ -741,7 +744,9 @@ guaranteed by the originator of a cluster definition." | |||
| 741 | regexp (shadow-regexp-superquote primary)) | 744 | regexp (shadow-regexp-superquote primary)) |
| 742 | (shadow-set-cluster cluster2 primary regexp) | 745 | (shadow-set-cluster cluster2 primary regexp) |
| 743 | (when shadow-debug | 746 | (when shadow-debug |
| 744 | (message "%s %s %s %s" cluster2 primary regexp shadow-clusters)) | 747 | (message |
| 748 | "shadow-test08-shadow-todo: %s %s %s %s" | ||
| 749 | cluster2 primary regexp shadow-clusters)) | ||
| 745 | 750 | ||
| 746 | ;; Define a literal group. | 751 | ;; Define a literal group. |
| 747 | (setq file | 752 | (setq file |
| @@ -750,7 +755,8 @@ guaranteed by the originator of a cluster definition." | |||
| 750 | shadow-literal-groups | 755 | shadow-literal-groups |
| 751 | `((,(concat "/cluster1:" file) ,(concat "/cluster2:" file)))) | 756 | `((,(concat "/cluster1:" file) ,(concat "/cluster2:" file)))) |
| 752 | (when shadow-debug | 757 | (when shadow-debug |
| 753 | (message "%s %s" file shadow-literal-groups)) | 758 | (message |
| 759 | "shadow-test08-shadow-todo: %s %s" file shadow-literal-groups)) | ||
| 754 | 760 | ||
| 755 | ;; Save file from "cluster1" definition. | 761 | ;; Save file from "cluster1" definition. |
| 756 | (with-temp-buffer | 762 | (with-temp-buffer |
| @@ -759,7 +765,7 @@ guaranteed by the originator of a cluster definition." | |||
| 759 | (save-buffer)) | 765 | (save-buffer)) |
| 760 | (when shadow-debug | 766 | (when shadow-debug |
| 761 | (message | 767 | (message |
| 762 | "%s %s" | 768 | "shadow-test08-shadow-todo: %s %s" |
| 763 | (cons file (shadow-contract-file-name (concat "/cluster2:" file))) | 769 | (cons file (shadow-contract-file-name (concat "/cluster2:" file))) |
| 764 | shadow-files-to-copy)) | 770 | shadow-files-to-copy)) |
| 765 | (should | 771 | (should |
| @@ -774,7 +780,7 @@ guaranteed by the originator of a cluster definition." | |||
| 774 | (save-buffer)) | 780 | (save-buffer)) |
| 775 | (when shadow-debug | 781 | (when shadow-debug |
| 776 | (message | 782 | (message |
| 777 | "%s %s" | 783 | "shadow-test08-shadow-todo: %s %s" |
| 778 | (cons | 784 | (cons |
| 779 | (concat (shadow-site-primary cluster2) file) | 785 | (concat (shadow-site-primary cluster2) file) |
| 780 | (shadow-contract-file-name (concat "/cluster1:" file))) | 786 | (shadow-contract-file-name (concat "/cluster1:" file))) |
| @@ -794,7 +800,8 @@ guaranteed by the originator of a cluster definition." | |||
| 794 | ,(concat (shadow-site-primary cluster2) | 800 | ,(concat (shadow-site-primary cluster2) |
| 795 | (shadow-regexp-superquote file))))) | 801 | (shadow-regexp-superquote file))))) |
| 796 | (when shadow-debug | 802 | (when shadow-debug |
| 797 | (message "%s %s" file shadow-regexp-groups)) | 803 | (message |
| 804 | "shadow-test08-shadow-todo: %s %s" file shadow-regexp-groups)) | ||
| 798 | 805 | ||
| 799 | ;; Save file from "cluster1" definition. | 806 | ;; Save file from "cluster1" definition. |
| 800 | (with-temp-buffer | 807 | (with-temp-buffer |
| @@ -803,7 +810,7 @@ guaranteed by the originator of a cluster definition." | |||
| 803 | (save-buffer)) | 810 | (save-buffer)) |
| 804 | (when shadow-debug | 811 | (when shadow-debug |
| 805 | (message | 812 | (message |
| 806 | "%s %s" | 813 | "shadow-test08-shadow-todo: %s %s" |
| 807 | (cons file (shadow-contract-file-name (concat "/cluster2:" file))) | 814 | (cons file (shadow-contract-file-name (concat "/cluster2:" file))) |
| 808 | shadow-files-to-copy)) | 815 | shadow-files-to-copy)) |
| 809 | (should | 816 | (should |
| @@ -818,7 +825,7 @@ guaranteed by the originator of a cluster definition." | |||
| 818 | (save-buffer)) | 825 | (save-buffer)) |
| 819 | (when shadow-debug | 826 | (when shadow-debug |
| 820 | (message | 827 | (message |
| 821 | "%s %s" | 828 | "shadow-test08-shadow-todo: %s %s" |
| 822 | (cons | 829 | (cons |
| 823 | (concat (shadow-site-primary cluster2) file) | 830 | (concat (shadow-site-primary cluster2) file) |
| 824 | (shadow-contract-file-name (concat "/cluster1:" file))) | 831 | (shadow-contract-file-name (concat "/cluster1:" file))) |
| @@ -898,7 +905,7 @@ guaranteed by the originator of a cluster definition." | |||
| 898 | ;; We must mock `write-region', in order to check proper | 905 | ;; We must mock `write-region', in order to check proper |
| 899 | ;; action. | 906 | ;; action. |
| 900 | (add-function | 907 | (add-function |
| 901 | :before (symbol-function 'write-region) | 908 | :before (symbol-function #'write-region) |
| 902 | (lambda (&rest args) | 909 | (lambda (&rest args) |
| 903 | (when (and (buffer-file-name) mocked-input) | 910 | (when (and (buffer-file-name) mocked-input) |
| 904 | (should (equal (buffer-file-name) (pop mocked-input))))) | 911 | (should (equal (buffer-file-name) (pop mocked-input))))) |
| @@ -913,7 +920,7 @@ guaranteed by the originator of a cluster definition." | |||
| 913 | (looking-at (regexp-quote "(setq shadow-files-to-copy nil)"))))) | 920 | (looking-at (regexp-quote "(setq shadow-files-to-copy nil)"))))) |
| 914 | 921 | ||
| 915 | ;; Cleanup. | 922 | ;; Cleanup. |
| 916 | (remove-function (symbol-function 'write-region) "write-region-mock") | 923 | (remove-function (symbol-function #'write-region) "write-region-mock") |
| 917 | (dolist (elt `(,file ,(concat (shadow-site-primary cluster2) file))) | 924 | (dolist (elt `(,file ,(concat (shadow-site-primary cluster2) file))) |
| 918 | (ignore-errors | 925 | (ignore-errors |
| 919 | (with-current-buffer (get-file-buffer elt) | 926 | (with-current-buffer (get-file-buffer elt) |