From 7b272d53d603d9f3cfd2421d31e5891723fc2ca1 Mon Sep 17 00:00:00 2001
From: Matt Armstrong <matt@rfc20.org>
Date: Fri, 19 Feb 2021 15:39:15 -0800
Subject: [PATCH 2/2] File unlock errors now issue warnings (Bug#46397)

* lisp/userlock.el (userlock--handle-unlock-error): New function, call
`display-error'.
* src/filelock.c (unlock_file_body): New function, do what
unlock_file() used to.
(unlock_file_handle_error): New function, call
`userlock--handle-unlock-error' with the captured error.
(unlock_file): Use condition case to glue together the above.
* test/src/filelock-tests.el (filelock-tests-kill-buffer-spoiled):
(filelock-tests-unlock-spoiled): Modify to test new behavior.
---
 lisp/userlock.el           |  9 +++++++++
 src/filelock.c             | 21 +++++++++++++++++++--
 test/src/filelock-tests.el | 34 ++++++++++++++++++++++------------
 3 files changed, 50 insertions(+), 14 deletions(-)

diff --git a/lisp/userlock.el b/lisp/userlock.el
index a340ff85b2..d33089b11a 100644
--- a/lisp/userlock.el
+++ b/lisp/userlock.el
@@ -193,4 +193,13 @@ ask-user-about-supersession-help
     (with-current-buffer standard-output
       (help-mode))))
 
+;;;###autoload
+(defun userlock--handle-unlock-error (err)
+  "Report an error ERR that occurred while unlocking a file."
+  (display-warning
+   '(unlock-file)
+   (message "Error unlocking file, proceeding as if unlocked: %s"
+            (error-message-string err))
+   :warning))
+
 ;;; userlock.el ends here
diff --git a/src/filelock.c b/src/filelock.c
index 373fc00a42..1f5bba4447 100644
--- a/src/filelock.c
+++ b/src/filelock.c
@@ -719,8 +719,8 @@ lock_file (Lisp_Object fn)
     }
 }
 
-void
-unlock_file (Lisp_Object fn)
+static Lisp_Object
+unlock_file_body (Lisp_Object fn)
 {
   char *lfname;
   USE_SAFE_ALLOCA;
@@ -737,6 +737,23 @@ unlock_file (Lisp_Object fn)
     report_file_errno ("Unlocking file", filename, err);
 
   SAFE_FREE ();
+  return Qnil;
+}
+
+static Lisp_Object
+unlock_file_handle_error (Lisp_Object err)
+{
+  call1 (intern ("userlock--handle-unlock-error"), err);
+  return Qnil;
+}
+
+void
+unlock_file (Lisp_Object fn)
+{
+  internal_condition_case_1 (unlock_file_body,
+			     fn,
+			     list1(Qfile_error),
+			     unlock_file_handle_error);
 }
 
 #else  /* MSDOS */
diff --git a/test/src/filelock-tests.el b/test/src/filelock-tests.el
index c6f55efd49..a96d6d6728 100644
--- a/test/src/filelock-tests.el
+++ b/test/src/filelock-tests.el
@@ -138,11 +138,16 @@ filelock-tests-unlock-spoiled
      (should-not (file-locked-p buffer-file-truename))
      (filelock-tests--spoil-lock-file buffer-file-truename)
 
-     ;; FIXME: Unlocking buffers should not signal errors related to
-     ;; their lock files (bug#46397).
-     (let ((err (should-error (unlock-buffer))))
-       (should (equal (cl-subseq err 0 2)
-                      '(file-error "Unlocking file")))))))
+     ;; Errors from `unlock-buffer' should call
+     ;; `userlock--handle-unlock-error' (bug#46397).
+     (let (errors)
+       (cl-letf (((symbol-function 'userlock--handle-unlock-error)
+                  (lambda (err) (push err errors))))
+         (unlock-buffer))
+       (should (consp errors))
+       (should (equal '(file-error "Unlocking file")
+                      (seq-subseq (car errors) 0 2)))
+       (should (equal (length errors) 1))))))
 
 (ert-deftest filelock-tests-kill-buffer-spoiled ()
   "Check that `kill-buffer' fails if a lockfile is \"spoiled\"."
@@ -161,13 +166,18 @@ filelock-tests-kill-buffer-spoiled
      ;; a function that fakes a "yes" answer for the "Buffer modified;
      ;; kill anyway?" prompt.
      ;;
-     ;; FIXME: Killing buffers should not signal errors related to
-     ;; their lock files (bug#46397).
-     (let* ((err (cl-letf (((symbol-function 'yes-or-no-p)
-                            (lambda (&rest _) t)))
-                   (should-error (kill-buffer)))))
-       (should (equal (seq-subseq err 0 2)
-                      '(file-error "Unlocking file")))))))
+     ;; File errors from unlocking files should call
+     ;; `userlock--handle-unlock-error' (bug#46397).
+     (let (errors)
+       (cl-letf (((symbol-function 'yes-or-no-p)
+                  (lambda (&rest _) t))
+                 ((symbol-function 'userlock--handle-unlock-error)
+                  (lambda (err) (push err errors))))
+         (kill-buffer))
+       (should (consp errors))
+       (should (equal '(file-error "Unlocking file")
+                      (seq-subseq (car errors) 0 2)))
+       (should (equal (length errors) 1))))))
 
 (provide 'filelock-tests)
 ;;; filelock-tests.el ends here
-- 
2.30.1