[Emacs-diffs] master 4532def: ; Remove instrumentation for Bug#32226

[Michael Albinus]

branch: master
commit 4532def340f8f3f40fccb42b6c265278323bff02
Author: Michael Albinus <address@hidden>
Commit: Michael Albinus <address@hidden>

    ; Remove instrumentation for Bug#32226
---
 lisp/files.el                 | 21 ---------------------
 lisp/shadowfile.el            | 23 +++--------------------
 test/lisp/shadowfile-tests.el | 40 +---------------------------------------
 3 files changed, 4 insertions(+), 80 deletions(-)

diff --git a/lisp/files.el b/lisp/files.el
index 3482524..8057def 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 86280c3..180d502 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 ed2ab9b..3bab22f 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)