aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorMichael Albinus2018-08-12 17:38:24 +0200
committerMichael Albinus2018-08-12 17:38:24 +0200
commit4532def340f8f3f40fccb42b6c265278323bff02 (patch)
tree9917449c844f3d49797bbd4ace14424afcb1579c
parent6a7c84d09569b509779ad91ba70d82d550d57115 (diff)
downloademacs-4532def340f8f3f40fccb42b6c265278323bff02.tar.gz
emacs-4532def340f8f3f40fccb42b6c265278323bff02.zip
; Remove instrumentation for Bug#32226
-rw-r--r--lisp/files.el21
-rw-r--r--lisp/shadowfile.el23
-rw-r--r--test/lisp/shadowfile-tests.el40
3 files changed, 4 insertions, 80 deletions
diff --git a/lisp/files.el b/lisp/files.el
index 3482524900f..8057def5259 100644
--- a/lisp/files.el
+++ b/lisp/files.el
@@ -5078,29 +5078,19 @@ Before and after saving the buffer, this function runs
5078 (set-visited-file-name filename))) 5078 (set-visited-file-name filename)))
5079 ;; Support VC version backups. 5079 ;; Support VC version backups.
5080 (vc-before-save) 5080 (vc-before-save)
5081 ;; We are hunting a nasty error, which happens on hydra.
5082 ;; Adding traces might help.
5083 (if (getenv "BUG_32226") (message "BUG_32226"))
5084 (or (run-hook-with-args-until-success 'local-write-file-hooks) 5081 (or (run-hook-with-args-until-success 'local-write-file-hooks)
5085 (run-hook-with-args-until-success 'write-file-functions) 5082 (run-hook-with-args-until-success 'write-file-functions)
5086 (progn
5087 (if (getenv "BUG_32226")
5088 (message "BUG_32226 %s" buffer-file-name))
5089 nil)
5090 ;; If a hook returned t, file is already "written". 5083 ;; If a hook returned t, file is already "written".
5091 ;; Otherwise, write it the usual way now. 5084 ;; Otherwise, write it the usual way now.
5092 (let ((dir (file-name-directory 5085 (let ((dir (file-name-directory
5093 (expand-file-name buffer-file-name)))) 5086 (expand-file-name buffer-file-name))))
5094 (if (getenv "BUG_32226") (message "BUG_32226 %s" dir))
5095 (unless (file-exists-p dir) 5087 (unless (file-exists-p dir)
5096 (if (y-or-n-p 5088 (if (y-or-n-p
5097 (format-message 5089 (format-message
5098 "Directory `%s' does not exist; create? " dir)) 5090 "Directory `%s' does not exist; create? " dir))
5099 (make-directory dir t) 5091 (make-directory dir t)
5100 (error "Canceled"))) 5092 (error "Canceled")))
5101 (if (getenv "BUG_32226") (message "BUG_32226 %s" dir))
5102 (setq setmodes (basic-save-buffer-1))))) 5093 (setq setmodes (basic-save-buffer-1)))))
5103 (if (getenv "BUG_32226") (message "BUG_32226"))
5104 ;; Now we have saved the current buffer. Let's make sure 5094 ;; Now we have saved the current buffer. Let's make sure
5105 ;; that buffer-file-coding-system is fixed to what 5095 ;; that buffer-file-coding-system is fixed to what
5106 ;; actually used for saving by binding it locally. 5096 ;; actually used for saving by binding it locally.
@@ -5147,7 +5137,6 @@ Before and after saving the buffer, this function runs
5147;; backup-buffer. 5137;; backup-buffer.
5148(defun basic-save-buffer-2 () 5138(defun basic-save-buffer-2 ()
5149 (let (tempsetmodes setmodes) 5139 (let (tempsetmodes setmodes)
5150 (if (getenv "BUG_32226") (message "BUG_32226 %s" 1))
5151 (if (not (file-writable-p buffer-file-name)) 5140 (if (not (file-writable-p buffer-file-name))
5152 (let ((dir (file-name-directory buffer-file-name))) 5141 (let ((dir (file-name-directory buffer-file-name)))
5153 (if (not (file-directory-p dir)) 5142 (if (not (file-directory-p dir))
@@ -5163,12 +5152,10 @@ Before and after saving the buffer, this function runs
5163 buffer-file-name))) 5152 buffer-file-name)))
5164 (setq tempsetmodes t) 5153 (setq tempsetmodes t)
5165 (error "Attempt to save to a file which you aren't allowed to write")))))) 5154 (error "Attempt to save to a file which you aren't allowed to write"))))))
5166 (if (getenv "BUG_32226") (message "BUG_32226 %s" 2))
5167 (or buffer-backed-up 5155 (or buffer-backed-up
5168 (setq setmodes (backup-buffer))) 5156 (setq setmodes (backup-buffer)))
5169 (let* ((dir (file-name-directory buffer-file-name)) 5157 (let* ((dir (file-name-directory buffer-file-name))
5170 (dir-writable (file-writable-p dir))) 5158 (dir-writable (file-writable-p dir)))
5171 (if (getenv "BUG_32226") (message "BUG_32226 %s" 3))
5172 (if (or (and file-precious-flag dir-writable) 5159 (if (or (and file-precious-flag dir-writable)
5173 (and break-hardlink-on-save 5160 (and break-hardlink-on-save
5174 (file-exists-p buffer-file-name) 5161 (file-exists-p buffer-file-name)
@@ -5186,7 +5173,6 @@ Before and after saving the buffer, this function runs
5186 ;; Create temp files with strict access rights. It's easy to 5173 ;; Create temp files with strict access rights. It's easy to
5187 ;; loosen them later, whereas it's impossible to close the 5174 ;; loosen them later, whereas it's impossible to close the
5188 ;; time-window of loose permissions otherwise. 5175 ;; time-window of loose permissions otherwise.
5189 (if (getenv "BUG_32226") (message "BUG_32226 %s" 4))
5190 (condition-case err 5176 (condition-case err
5191 (progn 5177 (progn
5192 (clear-visited-file-modtime) 5178 (clear-visited-file-modtime)
@@ -5204,7 +5190,6 @@ Before and after saving the buffer, this function runs
5204 ;; If we failed, restore the buffer's modtime. 5190 ;; If we failed, restore the buffer's modtime.
5205 (error (set-visited-file-modtime old-modtime) 5191 (error (set-visited-file-modtime old-modtime)
5206 (signal (car err) (cdr err)))) 5192 (signal (car err) (cdr err))))
5207 (if (getenv "BUG_32226") (message "BUG_32226 %s" 5))
5208 ;; Since we have created an entirely new file, 5193 ;; Since we have created an entirely new file,
5209 ;; make sure it gets the right permission bits set. 5194 ;; make sure it gets the right permission bits set.
5210 (setq setmodes (or setmodes 5195 (setq setmodes (or setmodes
@@ -5214,13 +5199,11 @@ Before and after saving the buffer, this function runs
5214 buffer-file-name))) 5199 buffer-file-name)))
5215 ;; We succeeded in writing the temp file, 5200 ;; We succeeded in writing the temp file,
5216 ;; so rename it. 5201 ;; so rename it.
5217 (if (getenv "BUG_32226") (message "BUG_32226 %s" 6))
5218 (rename-file tempname buffer-file-name t)) 5202 (rename-file tempname buffer-file-name t))
5219 ;; If file not writable, see if we can make it writable 5203 ;; If file not writable, see if we can make it writable
5220 ;; temporarily while we write it. 5204 ;; temporarily while we write it.
5221 ;; But no need to do so if we have just backed it up 5205 ;; But no need to do so if we have just backed it up
5222 ;; (setmodes is set) because that says we're superseding. 5206 ;; (setmodes is set) because that says we're superseding.
5223 (if (getenv "BUG_32226") (message "BUG_32226 %s" 7))
5224 (cond ((and tempsetmodes (not setmodes)) 5207 (cond ((and tempsetmodes (not setmodes))
5225 ;; Change the mode back, after writing. 5208 ;; Change the mode back, after writing.
5226 (setq setmodes (list (file-modes buffer-file-name) 5209 (setq setmodes (list (file-modes buffer-file-name)
@@ -5234,7 +5217,6 @@ Before and after saving the buffer, this function runs
5234 (nth 1 setmodes))) 5217 (nth 1 setmodes)))
5235 (set-file-modes buffer-file-name 5218 (set-file-modes buffer-file-name
5236 (logior (car setmodes) 128)))))) 5219 (logior (car setmodes) 128))))))
5237 (if (getenv "BUG_32226") (message "BUG_32226 %s %s %s" 8 buffer-file-name buffer-file-truename))
5238 (let (success) 5220 (let (success)
5239 (unwind-protect 5221 (unwind-protect
5240 (progn 5222 (progn
@@ -5243,16 +5225,13 @@ Before and after saving the buffer, this function runs
5243 ;; write-region-annotate-functions may make use of it. 5225 ;; write-region-annotate-functions may make use of it.
5244 (write-region nil nil 5226 (write-region nil nil
5245 buffer-file-name nil t buffer-file-truename) 5227 buffer-file-name nil t buffer-file-truename)
5246 (if (getenv "BUG_32226") (message "BUG_32226 %s" 9))
5247 (when save-silently (message nil)) 5228 (when save-silently (message nil))
5248 (setq success t)) 5229 (setq success t))
5249 ;; If we get an error writing the new file, and we made 5230 ;; If we get an error writing the new file, and we made
5250 ;; the backup by renaming, undo the backing-up. 5231 ;; the backup by renaming, undo the backing-up.
5251 (if (getenv "BUG_32226") (message "BUG_32226 %s %s %s" 10 (nth 2 setmodes) buffer-file-name))
5252 (and setmodes (not success) 5232 (and setmodes (not success)
5253 (progn 5233 (progn
5254 (rename-file (nth 2 setmodes) buffer-file-name t) 5234 (rename-file (nth 2 setmodes) buffer-file-name t)
5255 (if (getenv "BUG_32226") (message "BUG_32226 %s" 11))
5256 (setq buffer-backed-up nil)))))) 5235 (setq buffer-backed-up nil))))))
5257 setmodes)) 5236 setmodes))
5258 5237
diff --git a/lisp/shadowfile.el b/lisp/shadowfile.el
index 86280c38adf..180d5026b6e 100644
--- a/lisp/shadowfile.el
+++ b/lisp/shadowfile.el
@@ -628,26 +628,17 @@ Consider them as regular expressions if third arg REGEXP is true."
628 628
629(defun shadow-add-to-todo () 629(defun shadow-add-to-todo ()
630 "If current buffer has shadows, add them to the list needing to be copied." 630 "If current buffer has shadows, add them to the list needing to be copied."
631 (message "shadow-add-to-todo 1 %s" (current-buffer))
632 (message "shadow-add-to-todo 2 %s" (buffer-file-name))
633 (message "shadow-add-to-todo 3 %s" (shadow-expand-file-name (buffer-file-name (current-buffer))))
634 (message "shadow-add-to-todo 4 %s" (shadow-shadows-of (shadow-expand-file-name (buffer-file-name (current-buffer)))))
635 (let ((shadows (shadow-shadows-of 631 (let ((shadows (shadow-shadows-of
636 (shadow-expand-file-name 632 (shadow-expand-file-name
637 (buffer-file-name (current-buffer)))))) 633 (buffer-file-name (current-buffer))))))
638 (when shadows 634 (when shadows
639 (message "shadow-add-to-todo 5 %s" shadows)
640 (message "shadow-add-to-todo 6 %s" shadow-files-to-copy)
641 (message "shadow-add-to-todo 7 %s" (shadow-union shadows shadow-files-to-copy))
642 (setq shadow-files-to-copy 635 (setq shadow-files-to-copy
643 (shadow-union shadows shadow-files-to-copy)) 636 (shadow-union shadows shadow-files-to-copy))
644 (when (not shadow-inhibit-message) 637 (when (not shadow-inhibit-message)
645 (message "%s" (substitute-command-keys 638 (message "%s" (substitute-command-keys
646 "Use \\[shadow-copy-files] to update shadows.")) 639 "Use \\[shadow-copy-files] to update shadows."))
647 (sit-for 1)) 640 (sit-for 1))
648 (message "shadow-add-to-todo 8") 641 (shadow-write-todo-file)))
649 (shadow-write-todo-file)
650 (message "shadow-add-to-todo 9")))
651 nil) ; Return nil for write-file-functions 642 nil) ; Return nil for write-file-functions
652 643
653(defun shadow-remove-from-todo (pair) 644(defun shadow-remove-from-todo (pair)
@@ -714,26 +705,18 @@ defined, the old hashtable info is invalid."
714 "Write out information to `shadow-todo-file'. 705 "Write out information to `shadow-todo-file'.
715With non-nil argument also saves the buffer." 706With non-nil argument also saves the buffer."
716 (save-excursion 707 (save-excursion
717 (message "shadow-write-todo-file 1 %s" shadow-todo-buffer)
718 (if (not shadow-todo-buffer) 708 (if (not shadow-todo-buffer)
719 (setq shadow-todo-buffer (find-file-noselect shadow-todo-file))) 709 (setq shadow-todo-buffer (find-file-noselect shadow-todo-file)))
720 (message "shadow-write-todo-file 2 %s" shadow-todo-buffer)
721 (set-buffer shadow-todo-buffer) 710 (set-buffer shadow-todo-buffer)
722 (message "shadow-write-todo-file 3 %s" shadow-todo-buffer)
723 (setq buffer-read-only nil) 711 (setq buffer-read-only nil)
724 (delete-region (point-min) (point-max)) 712 (delete-region (point-min) (point-max))
725 (message "shadow-write-todo-file 4 %s" shadow-todo-buffer)
726 (shadow-insert-var 'shadow-files-to-copy) 713 (shadow-insert-var 'shadow-files-to-copy)
727 (message "shadow-write-todo-file 5 %s" save) 714 (if save (shadow-save-todo-file))))
728 (if save (shadow-save-todo-file))
729 (message "shadow-write-todo-file 6 %s" save)))
730 715
731(defun shadow-save-todo-file () 716(defun shadow-save-todo-file ()
732 (message "shadow-save-todo-file 1 %s" shadow-todo-buffer)
733 (if (and shadow-todo-buffer (buffer-modified-p shadow-todo-buffer)) 717 (if (and shadow-todo-buffer (buffer-modified-p shadow-todo-buffer))
734 (with-current-buffer shadow-todo-buffer 718 (with-current-buffer shadow-todo-buffer
735 (message "shadow-save-todo-file 2 %s" shadow-todo-buffer) 719 (condition-case nil ; have to continue even in case of
736 (condition-case nil ; have to continue even in case of
737 (basic-save-buffer) ; error, otherwise kill-emacs might 720 (basic-save-buffer) ; error, otherwise kill-emacs might
738 (error ; not work! 721 (error ; not work!
739 (message "WARNING: Can't save shadow todo file; it is locked!") 722 (message "WARNING: Can't save shadow todo file; it is locked!")
diff --git a/test/lisp/shadowfile-tests.el b/test/lisp/shadowfile-tests.el
index ed2ab9b3292..3bab22f8d66 100644
--- a/test/lisp/shadowfile-tests.el
+++ b/test/lisp/shadowfile-tests.el
@@ -726,26 +726,13 @@ guaranteed by the originator of a cluster definition."
726 shadow-files-to-copy 726 shadow-files-to-copy
727 cluster1 cluster2 primary regexp file) 727 cluster1 cluster2 primary regexp file)
728 (unwind-protect 728 (unwind-protect
729 (condition-case err
730 (progn 729 (progn
731 (require 'trace)
732 (dolist (elt (all-completions "shadow-" obarray 'functionp))
733 (trace-function-background (intern elt)))
734 (dolist (elt (all-completions "tramp-" obarray 'functionp))
735 (trace-function-background (intern elt)))
736 (trace-function-background 'save-buffer)
737 (trace-function-background 'basic-save-buffer)
738 (trace-function-background 'basic-save-buffer-1)
739 (trace-function-background 'basic-save-buffer-2)
740 (dolist (elt write-file-functions)
741 (trace-function-background elt))
742 ;; Cleanup. 730 ;; Cleanup.
743 (when (file-exists-p shadow-info-file) 731 (when (file-exists-p shadow-info-file)
744 (delete-file shadow-info-file)) 732 (delete-file shadow-info-file))
745 (when (file-exists-p shadow-todo-file) 733 (when (file-exists-p shadow-todo-file)
746 (delete-file shadow-todo-file)) 734 (delete-file shadow-todo-file))
747 735
748 (message "Point 1")
749 ;; Define clusters. 736 ;; Define clusters.
750 (setq cluster1 "cluster1" 737 (setq cluster1 "cluster1"
751 primary shadow-system-name 738 primary shadow-system-name
@@ -758,7 +745,6 @@ guaranteed by the originator of a cluster definition."
758 regexp (shadow-regexp-superquote primary)) 745 regexp (shadow-regexp-superquote primary))
759 (shadow-set-cluster cluster2 primary regexp) 746 (shadow-set-cluster cluster2 primary regexp)
760 747
761 (message "Point 2")
762 ;; Define a literal group. 748 ;; Define a literal group.
763 (setq file 749 (setq file
764 (make-temp-name 750 (make-temp-name
@@ -766,38 +752,21 @@ guaranteed by the originator of a cluster definition."
766 shadow-literal-groups 752 shadow-literal-groups
767 `((,(concat "/cluster1:" file) ,(concat "/cluster2:" file)))) 753 `((,(concat "/cluster1:" file) ,(concat "/cluster2:" file))))
768 754
769 (message "Point 3")
770 ;; Save file from "cluster1" definition. 755 ;; Save file from "cluster1" definition.
771 (with-temp-buffer 756 (with-temp-buffer
772 (set-visited-file-name file) 757 (set-visited-file-name file)
773 (insert "foo") 758 (insert "foo")
774 (save-buffer)) 759 (save-buffer))
775 (message "%s" file)
776 (message "%s" (shadow-contract-file-name (concat "/cluster2:" file)))
777 (message "%s" shadow-files-to-copy)
778 (should 760 (should
779 (member 761 (member
780 (cons file (shadow-contract-file-name (concat "/cluster2:" file))) 762 (cons file (shadow-contract-file-name (concat "/cluster2:" file)))
781 shadow-files-to-copy)) 763 shadow-files-to-copy))
782 764
783 (message "Point 4")
784 ;; Save file from "cluster2" definition. 765 ;; Save file from "cluster2" definition.
785 (with-temp-buffer 766 (with-temp-buffer
786 (message "Point 4.1")
787 (message "%s" file)
788 (message "%s" (shadow-site-primary cluster2))
789 (set-visited-file-name (concat (shadow-site-primary cluster2) file)) 767 (set-visited-file-name (concat (shadow-site-primary cluster2) file))
790 (message "Point 4.2")
791 (insert "foo") 768 (insert "foo")
792 (message "%s" buffer-file-name)
793 (message "%s" write-file-functions)
794 (setenv "BUG_32226" "1")
795 (save-buffer)) 769 (save-buffer))
796 (setenv "BUG_32226")
797 (message "Point 4.3")
798 (message "%s" (shadow-site-primary cluster2))
799 (message "%s" (shadow-contract-file-name (concat "/cluster1:" file)))
800 (message "%s" shadow-files-to-copy)
801 (should 770 (should
802 (member 771 (member
803 (cons 772 (cons
@@ -805,7 +774,6 @@ guaranteed by the originator of a cluster definition."
805 (shadow-contract-file-name (concat "/cluster1:" file))) 774 (shadow-contract-file-name (concat "/cluster1:" file)))
806 shadow-files-to-copy)) 775 shadow-files-to-copy))
807 776
808 (message "Point 5")
809 ;; Define a regexp group. 777 ;; Define a regexp group.
810 (setq shadow-files-to-copy nil 778 (setq shadow-files-to-copy nil
811 shadow-regexp-groups 779 shadow-regexp-groups
@@ -814,7 +782,6 @@ guaranteed by the originator of a cluster definition."
814 ,(concat (shadow-site-primary cluster2) 782 ,(concat (shadow-site-primary cluster2)
815 (shadow-regexp-superquote file))))) 783 (shadow-regexp-superquote file)))))
816 784
817 (message "Point 6")
818 ;; Save file from "cluster1" definition. 785 ;; Save file from "cluster1" definition.
819 (with-temp-buffer 786 (with-temp-buffer
820 (set-visited-file-name file) 787 (set-visited-file-name file)
@@ -825,7 +792,6 @@ guaranteed by the originator of a cluster definition."
825 (cons file (shadow-contract-file-name (concat "/cluster2:" file))) 792 (cons file (shadow-contract-file-name (concat "/cluster2:" file)))
826 shadow-files-to-copy)) 793 shadow-files-to-copy))
827 794
828 (message "Point 7")
829 ;; Save file from "cluster2" definition. 795 ;; Save file from "cluster2" definition.
830 (with-temp-buffer 796 (with-temp-buffer
831 (set-visited-file-name (concat (shadow-site-primary cluster2) file)) 797 (set-visited-file-name (concat (shadow-site-primary cluster2) file))
@@ -837,11 +803,6 @@ guaranteed by the originator of a cluster definition."
837 (concat (shadow-site-primary cluster2) file) 803 (concat (shadow-site-primary cluster2) file)
838 (shadow-contract-file-name (concat "/cluster1:" file))) 804 (shadow-contract-file-name (concat "/cluster1:" file)))
839 shadow-files-to-copy))) 805 shadow-files-to-copy)))
840 (error (message "Error: %s" err) (signal (car err) (cdr err))))
841
842 (setenv "BUG_32226")
843 (untrace-all)
844 (message "%s" (with-current-buffer trace-buffer (buffer-string)))
845 806
846 ;; Cleanup. 807 ;; Cleanup.
847 (when (file-exists-p shadow-info-file) 808 (when (file-exists-p shadow-info-file)
@@ -859,6 +820,7 @@ guaranteed by the originator of a cluster definition."
859 "Check that needed shadow files are copied." 820 "Check that needed shadow files are copied."
860 (skip-unless (not (memq system-type '(windows-nt ms-dos)))) 821 (skip-unless (not (memq system-type '(windows-nt ms-dos))))
861 (skip-unless (file-remote-p shadow-test-remote-temporary-file-directory)) 822 (skip-unless (file-remote-p shadow-test-remote-temporary-file-directory))
823 (skip-unless (file-writable-p shadow-test-remote-temporary-file-directory))
862 824
863 (let ((backup-inhibited t) 825 (let ((backup-inhibited t)
864 (shadow-info-file shadow-test-info-file) 826 (shadow-info-file shadow-test-info-file)