From: Michael Albinus Date: Sun, 12 Aug 2018 15:38:24 +0000 (+0200) Subject: ; Remove instrumentation for Bug#32226 X-Git-Tag: emacs-27.0.90~4585 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=4532def340f8f3f40fccb42b6c265278323bff02;p=emacs.git ; Remove instrumentation for Bug#32226 --- 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 (set-visited-file-name filename))) ;; Support VC version backups. (vc-before-save) - ;; We are hunting a nasty error, which happens on hydra. - ;; Adding traces might help. - (if (getenv "BUG_32226") (message "BUG_32226")) (or (run-hook-with-args-until-success 'local-write-file-hooks) (run-hook-with-args-until-success 'write-file-functions) - (progn - (if (getenv "BUG_32226") - (message "BUG_32226 %s" buffer-file-name)) - nil) ;; If a hook returned t, file is already "written". ;; Otherwise, write it the usual way now. (let ((dir (file-name-directory (expand-file-name buffer-file-name)))) - (if (getenv "BUG_32226") (message "BUG_32226 %s" dir)) (unless (file-exists-p dir) (if (y-or-n-p (format-message "Directory `%s' does not exist; create? " dir)) (make-directory dir t) (error "Canceled"))) - (if (getenv "BUG_32226") (message "BUG_32226 %s" dir)) (setq setmodes (basic-save-buffer-1))))) - (if (getenv "BUG_32226") (message "BUG_32226")) ;; Now we have saved the current buffer. Let's make sure ;; that buffer-file-coding-system is fixed to what ;; actually used for saving by binding it locally. @@ -5147,7 +5137,6 @@ Before and after saving the buffer, this function runs ;; backup-buffer. (defun basic-save-buffer-2 () (let (tempsetmodes setmodes) - (if (getenv "BUG_32226") (message "BUG_32226 %s" 1)) (if (not (file-writable-p buffer-file-name)) (let ((dir (file-name-directory buffer-file-name))) (if (not (file-directory-p dir)) @@ -5163,12 +5152,10 @@ Before and after saving the buffer, this function runs buffer-file-name))) (setq tempsetmodes t) (error "Attempt to save to a file which you aren't allowed to write")))))) - (if (getenv "BUG_32226") (message "BUG_32226 %s" 2)) (or buffer-backed-up (setq setmodes (backup-buffer))) (let* ((dir (file-name-directory buffer-file-name)) (dir-writable (file-writable-p dir))) - (if (getenv "BUG_32226") (message "BUG_32226 %s" 3)) (if (or (and file-precious-flag dir-writable) (and break-hardlink-on-save (file-exists-p buffer-file-name) @@ -5186,7 +5173,6 @@ Before and after saving the buffer, this function runs ;; Create temp files with strict access rights. It's easy to ;; loosen them later, whereas it's impossible to close the ;; time-window of loose permissions otherwise. - (if (getenv "BUG_32226") (message "BUG_32226 %s" 4)) (condition-case err (progn (clear-visited-file-modtime) @@ -5204,7 +5190,6 @@ Before and after saving the buffer, this function runs ;; If we failed, restore the buffer's modtime. (error (set-visited-file-modtime old-modtime) (signal (car err) (cdr err)))) - (if (getenv "BUG_32226") (message "BUG_32226 %s" 5)) ;; Since we have created an entirely new file, ;; make sure it gets the right permission bits set. (setq setmodes (or setmodes @@ -5214,13 +5199,11 @@ Before and after saving the buffer, this function runs buffer-file-name))) ;; We succeeded in writing the temp file, ;; so rename it. - (if (getenv "BUG_32226") (message "BUG_32226 %s" 6)) (rename-file tempname buffer-file-name t)) ;; If file not writable, see if we can make it writable ;; temporarily while we write it. ;; But no need to do so if we have just backed it up ;; (setmodes is set) because that says we're superseding. - (if (getenv "BUG_32226") (message "BUG_32226 %s" 7)) (cond ((and tempsetmodes (not setmodes)) ;; Change the mode back, after writing. (setq setmodes (list (file-modes buffer-file-name) @@ -5234,7 +5217,6 @@ Before and after saving the buffer, this function runs (nth 1 setmodes))) (set-file-modes buffer-file-name (logior (car setmodes) 128)))))) - (if (getenv "BUG_32226") (message "BUG_32226 %s %s %s" 8 buffer-file-name buffer-file-truename)) (let (success) (unwind-protect (progn @@ -5243,16 +5225,13 @@ Before and after saving the buffer, this function runs ;; write-region-annotate-functions may make use of it. (write-region nil nil buffer-file-name nil t buffer-file-truename) - (if (getenv "BUG_32226") (message "BUG_32226 %s" 9)) (when save-silently (message nil)) (setq success t)) ;; If we get an error writing the new file, and we made ;; the backup by renaming, undo the backing-up. - (if (getenv "BUG_32226") (message "BUG_32226 %s %s %s" 10 (nth 2 setmodes) buffer-file-name)) (and setmodes (not success) (progn (rename-file (nth 2 setmodes) buffer-file-name t) - (if (getenv "BUG_32226") (message "BUG_32226 %s" 11)) (setq buffer-backed-up nil)))))) setmodes)) 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." (defun shadow-add-to-todo () "If current buffer has shadows, add them to the list needing to be copied." - (message "shadow-add-to-todo 1 %s" (current-buffer)) - (message "shadow-add-to-todo 2 %s" (buffer-file-name)) - (message "shadow-add-to-todo 3 %s" (shadow-expand-file-name (buffer-file-name (current-buffer)))) - (message "shadow-add-to-todo 4 %s" (shadow-shadows-of (shadow-expand-file-name (buffer-file-name (current-buffer))))) (let ((shadows (shadow-shadows-of (shadow-expand-file-name (buffer-file-name (current-buffer)))))) (when shadows - (message "shadow-add-to-todo 5 %s" shadows) - (message "shadow-add-to-todo 6 %s" shadow-files-to-copy) - (message "shadow-add-to-todo 7 %s" (shadow-union shadows shadow-files-to-copy)) (setq shadow-files-to-copy (shadow-union shadows shadow-files-to-copy)) (when (not shadow-inhibit-message) (message "%s" (substitute-command-keys "Use \\[shadow-copy-files] to update shadows.")) (sit-for 1)) - (message "shadow-add-to-todo 8") - (shadow-write-todo-file) - (message "shadow-add-to-todo 9"))) + (shadow-write-todo-file))) nil) ; Return nil for write-file-functions (defun shadow-remove-from-todo (pair) @@ -714,26 +705,18 @@ defined, the old hashtable info is invalid." "Write out information to `shadow-todo-file'. With non-nil argument also saves the buffer." (save-excursion - (message "shadow-write-todo-file 1 %s" shadow-todo-buffer) (if (not shadow-todo-buffer) (setq shadow-todo-buffer (find-file-noselect shadow-todo-file))) - (message "shadow-write-todo-file 2 %s" shadow-todo-buffer) (set-buffer shadow-todo-buffer) - (message "shadow-write-todo-file 3 %s" shadow-todo-buffer) (setq buffer-read-only nil) (delete-region (point-min) (point-max)) - (message "shadow-write-todo-file 4 %s" shadow-todo-buffer) (shadow-insert-var 'shadow-files-to-copy) - (message "shadow-write-todo-file 5 %s" save) - (if save (shadow-save-todo-file)) - (message "shadow-write-todo-file 6 %s" save))) + (if save (shadow-save-todo-file)))) (defun shadow-save-todo-file () - (message "shadow-save-todo-file 1 %s" shadow-todo-buffer) (if (and shadow-todo-buffer (buffer-modified-p shadow-todo-buffer)) (with-current-buffer shadow-todo-buffer - (message "shadow-save-todo-file 2 %s" shadow-todo-buffer) - (condition-case nil ; have to continue even in case of + (condition-case nil ; have to continue even in case of (basic-save-buffer) ; error, otherwise kill-emacs might (error ; not work! (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." shadow-files-to-copy cluster1 cluster2 primary regexp file) (unwind-protect - (condition-case err (progn - (require 'trace) - (dolist (elt (all-completions "shadow-" obarray 'functionp)) - (trace-function-background (intern elt))) - (dolist (elt (all-completions "tramp-" obarray 'functionp)) - (trace-function-background (intern elt))) - (trace-function-background 'save-buffer) - (trace-function-background 'basic-save-buffer) - (trace-function-background 'basic-save-buffer-1) - (trace-function-background 'basic-save-buffer-2) - (dolist (elt write-file-functions) - (trace-function-background elt)) ;; 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)) - (message "Point 1") ;; Define clusters. (setq cluster1 "cluster1" primary shadow-system-name @@ -758,7 +745,6 @@ guaranteed by the originator of a cluster definition." regexp (shadow-regexp-superquote primary)) (shadow-set-cluster cluster2 primary regexp) - (message "Point 2") ;; Define a literal group. (setq file (make-temp-name @@ -766,38 +752,21 @@ guaranteed by the originator of a cluster definition." shadow-literal-groups `((,(concat "/cluster1:" file) ,(concat "/cluster2:" file)))) - (message "Point 3") ;; Save file from "cluster1" definition. (with-temp-buffer (set-visited-file-name file) (insert "foo") (save-buffer)) - (message "%s" file) - (message "%s" (shadow-contract-file-name (concat "/cluster2:" file))) - (message "%s" shadow-files-to-copy) (should (member (cons file (shadow-contract-file-name (concat "/cluster2:" file))) shadow-files-to-copy)) - (message "Point 4") ;; Save file from "cluster2" definition. (with-temp-buffer - (message "Point 4.1") - (message "%s" file) - (message "%s" (shadow-site-primary cluster2)) (set-visited-file-name (concat (shadow-site-primary cluster2) file)) - (message "Point 4.2") (insert "foo") - (message "%s" buffer-file-name) - (message "%s" write-file-functions) - (setenv "BUG_32226" "1") (save-buffer)) - (setenv "BUG_32226") - (message "Point 4.3") - (message "%s" (shadow-site-primary cluster2)) - (message "%s" (shadow-contract-file-name (concat "/cluster1:" file))) - (message "%s" shadow-files-to-copy) (should (member (cons @@ -805,7 +774,6 @@ guaranteed by the originator of a cluster definition." (shadow-contract-file-name (concat "/cluster1:" file))) shadow-files-to-copy)) - (message "Point 5") ;; Define a regexp group. (setq shadow-files-to-copy nil shadow-regexp-groups @@ -814,7 +782,6 @@ guaranteed by the originator of a cluster definition." ,(concat (shadow-site-primary cluster2) (shadow-regexp-superquote file))))) - (message "Point 6") ;; Save file from "cluster1" definition. (with-temp-buffer (set-visited-file-name file) @@ -825,7 +792,6 @@ guaranteed by the originator of a cluster definition." (cons file (shadow-contract-file-name (concat "/cluster2:" file))) shadow-files-to-copy)) - (message "Point 7") ;; Save file from "cluster2" definition. (with-temp-buffer (set-visited-file-name (concat (shadow-site-primary cluster2) file)) @@ -837,11 +803,6 @@ guaranteed by the originator of a cluster definition." (concat (shadow-site-primary cluster2) file) (shadow-contract-file-name (concat "/cluster1:" file))) shadow-files-to-copy))) - (error (message "Error: %s" err) (signal (car err) (cdr err)))) - - (setenv "BUG_32226") - (untrace-all) - (message "%s" (with-current-buffer trace-buffer (buffer-string))) ;; Cleanup. (when (file-exists-p shadow-info-file) @@ -859,6 +820,7 @@ guaranteed by the originator of a cluster definition." "Check that needed shadow files are copied." (skip-unless (not (memq system-type '(windows-nt ms-dos)))) (skip-unless (file-remote-p shadow-test-remote-temporary-file-directory)) + (skip-unless (file-writable-p shadow-test-remote-temporary-file-directory)) (let ((backup-inhibited t) (shadow-info-file shadow-test-info-file)