master 7075ebb 2/2: Make remote file locks more robust

[Michael Albinus]

branch: master
commit 7075ebbf5b67e58d8270c0e3673133ac0586f8b5
Author: Michael Albinus <michael.albinus@gmx.de>
Commit: Michael Albinus <michael.albinus@gmx.de>

    Make remote file locks more robust
    
    * lisp/net/tramp.el (tramp-handle-write-region):
    * lisp/net/tramp-adb.el (tramp-adb-handle-write-region):
    * lisp/net/tramp-smb.el (tramp-smb-handle-write-region):
    * lisp/net/tramp-sshfs.el (tramp-sshfs-handle-write-region):
    Make file locks more robust.
    
    * test/lisp/net/tramp-tests.el (tramp-test39-make-lock-file-name):
    Rename and extend.
---
 lisp/net/tramp-adb.el        |  6 +++---
 lisp/net/tramp-smb.el        |  6 +++---
 lisp/net/tramp-sshfs.el      |  6 +++---
 lisp/net/tramp.el            |  6 +++---
 test/lisp/net/tramp-tests.el | 19 ++++++++++++++-----
 5 files changed, 26 insertions(+), 17 deletions(-)

diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el
index 8138d9a..b081e59 100644
--- a/lisp/net/tramp-adb.el
+++ b/lisp/net/tramp-adb.el
@@ -549,14 +549,14 @@ But handle the case, if the \"test\" command is not 
available."
                     (format "File %s exists; overwrite anyway? " filename)))))
       (tramp-error v 'file-already-exists filename))
 
-    (let (file-locked
+    (let ((file-locked (eq (file-locked-p lockname) t))
          (curbuf (current-buffer))
          (tmpfile (tramp-compat-make-temp-file filename)))
 
       ;; Lock file.
       (when (and (not (auto-save-file-name-p (file-name-nondirectory 
filename)))
                 (file-remote-p lockname)
-                (not (eq (file-locked-p lockname) t)))
+                (not file-locked))
        (setq file-locked t)
        ;; `lock-file' exists since Emacs 28.1.
        (tramp-compat-funcall 'lock-file lockname))
@@ -592,7 +592,7 @@ But handle the case, if the \"test\" command is not 
available."
             (current-time))))
 
       ;; Unlock file.
-      (when (and file-locked (eq (file-locked-p lockname) t))
+      (when file-locked
        ;; `unlock-file' exists since Emacs 28.1.
        (tramp-compat-funcall 'unlock-file lockname))
 
diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el
index 4008c25..4e4f554 100644
--- a/lisp/net/tramp-smb.el
+++ b/lisp/net/tramp-smb.el
@@ -1589,14 +1589,14 @@ errors for shares like \"C$/\", which are common in 
Microsoft Windows."
                     (format "File %s exists; overwrite anyway? " filename)))))
       (tramp-error v 'file-already-exists filename))
 
-    (let (file-locked
+    (let ((file-locked (eq (file-locked-p lockname) t))
          (curbuf (current-buffer))
          (tmpfile (tramp-compat-make-temp-file filename)))
 
       ;; Lock file.
       (when (and (not (auto-save-file-name-p (file-name-nondirectory 
filename)))
                 (file-remote-p lockname)
-                (not (eq (file-locked-p lockname) t)))
+                (not file-locked))
        (setq file-locked t)
        ;; `lock-file' exists since Emacs 28.1.
        (tramp-compat-funcall 'lock-file lockname))
@@ -1635,7 +1635,7 @@ errors for shares like \"C$/\", which are common in 
Microsoft Windows."
             (current-time))))
 
       ;; Unlock file.
-      (when (and file-locked (eq (file-locked-p lockname) t))
+      (when file-locked
        ;; `unlock-file' exists since Emacs 28.1.
        (tramp-compat-funcall 'unlock-file lockname))
 
diff --git a/lisp/net/tramp-sshfs.el b/lisp/net/tramp-sshfs.el
index 99f4063..c5b84a6 100644
--- a/lisp/net/tramp-sshfs.el
+++ b/lisp/net/tramp-sshfs.el
@@ -295,12 +295,12 @@ arguments to pass to the OPERATION."
                     (format "File %s exists; overwrite anyway? " filename)))))
       (tramp-error v 'file-already-exists filename))
 
-    (let (file-locked)
+    (let ((file-locked (eq (file-locked-p lockname) t)))
 
       ;; Lock file.
       (when (and (not (auto-save-file-name-p (file-name-nondirectory 
filename)))
                 (file-remote-p lockname)
-                (not (eq (file-locked-p lockname) t)))
+                (not file-locked))
        (setq file-locked t)
        ;; `lock-file' exists since Emacs 28.1.
        (tramp-compat-funcall 'lock-file lockname))
@@ -311,7 +311,7 @@ arguments to pass to the OPERATION."
        (tramp-flush-file-properties v localname))
 
       ;; Unlock file.
-      (when (and file-locked (eq (file-locked-p lockname) t))
+      (when file-locked
        ;; `unlock-file' exists since Emacs 28.1.
        (tramp-compat-funcall 'unlock-file lockname))
 
diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el
index 736c7ef..093335a 100644
--- a/lisp/net/tramp.el
+++ b/lisp/net/tramp.el
@@ -4463,7 +4463,7 @@ of."
                     (format "File %s exists; overwrite anyway? " filename)))))
       (tramp-error v 'file-already-exists filename))
 
-    (let (file-locked
+    (let ((file-locked (eq (file-locked-p lockname) t))
          (tmpfile (tramp-compat-make-temp-file filename))
          (modes (tramp-default-file-modes
                  filename (and (eq mustbenew 'excl) 'nofollow)))
@@ -4477,7 +4477,7 @@ of."
       ;; Lock file.
       (when (and (not (auto-save-file-name-p (file-name-nondirectory 
filename)))
                 (file-remote-p lockname)
-                (not (eq (file-locked-p lockname) t)))
+                (not file-locked))
        (setq file-locked t)
        ;; `lock-file' exists since Emacs 28.1.
        (tramp-compat-funcall 'lock-file lockname))
@@ -4515,7 +4515,7 @@ of."
       (tramp-set-file-uid-gid filename uid gid)
 
       ;; Unlock file.
-      (when (and file-locked (eq (file-locked-p lockname) t))
+      (when file-locked
        ;; `unlock-file' exists since Emacs 28.1.
        (tramp-compat-funcall 'unlock-file lockname))
 
diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el
index 3dd22ac..be4b427 100644
--- a/test/lisp/net/tramp-tests.el
+++ b/test/lisp/net/tramp-tests.el
@@ -2466,7 +2466,8 @@ This checks also `file-name-as-directory', 
`file-name-directory',
                          "^\\'")
                        tramp--test-messages))))))))
 
-           ;; We do not test lockname here.  See `tramp-test39-lock-file'.
+           ;; We do not test lockname here.  See
+           ;; `tramp-test39-make-lock-file-name'.
 
            ;; Do not overwrite if excluded.
            (cl-letf (((symbol-function #'y-or-n-p) #'tramp--test-always)
@@ -5746,8 +5747,8 @@ Use direct async.")
        (tramp-cleanup-connection tramp-test-vec 'keep-debug 'keep-password)))))
 
 ;; The functions were introduced in Emacs 28.1.
-(ert-deftest tramp-test39-lock-file ()
-  "Check `lock-file', `unlock-file' and `file-locked-p'."
+(ert-deftest tramp-test39-make-lock-file-name ()
+  "Check `make-lock-file-name', `lock-file', `unlock-file' and 
`file-locked-p'."
   (skip-unless (tramp--test-enabled))
   (skip-unless (not (tramp--test-ange-ftp-p)))
   ;; Since Emacs 28.1.
@@ -5783,6 +5784,15 @@ Use direct async.")
            (with-no-warnings (lock-file tmp-name1))
            (should (eq (with-no-warnings (file-locked-p tmp-name1)) t))
 
+            ;; `save-buffer' removes the lock.
+            (with-temp-buffer
+              (set-visited-file-name tmp-name1)
+              (insert "foo")
+              (save-buffer))
+            (should-not (with-no-warnings (file-locked-p tmp-name1)))
+           (with-no-warnings (lock-file tmp-name1))
+           (should (eq (with-no-warnings (file-locked-p tmp-name1)) t))
+
            ;; A new connection changes process id, and also the
            ;; lockname contents.
            (tramp-cleanup-connection tramp-test-vec 'keep-debug 'keep-password)
@@ -5838,8 +5848,7 @@ Use direct async.")
                (should-error
                  (set-visited-file-name tmp-name1)
                 :type 'file-locked)))
-           (should (stringp (with-no-warnings (file-locked-p tmp-name1))))
-           (should-not (file-exists-p tmp-name1)))
+           (should (stringp (with-no-warnings (file-locked-p tmp-name1)))))
 
        ;; Cleanup.
        (ignore-errors (delete-file tmp-name1))