From e05d400c177333cff0f558aff1948bcd55130c17 Mon Sep 17 00:00:00 2001 From: Matt Armstrong Date: Mon, 15 Feb 2021 12:59:08 -0800 Subject: [PATCH 1/2] Add some test coverage for src/filelock.c (Bug#46397). * test/src/filelock-tests.el: new file --- test/src/filelock-tests.el | 183 +++++++++++++++++++++++++++++++++++++ 1 file changed, 183 insertions(+) create mode 100644 test/src/filelock-tests.el diff --git a/test/src/filelock-tests.el b/test/src/filelock-tests.el new file mode 100644 index 0000000000..e568050c42 --- /dev/null +++ b/test/src/filelock-tests.el @@ -0,0 +1,183 @@ +;;; filelock-tests.el --- test file locking -*- lexical-binding: t; -*- + +;; Copyright (C) 2021 Free Software Foundation, Inc. + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;;; Commentary: + +;; This file tests code in src/filelock.c and, to some extent, the +;; related code in src/fileio.c. + +;; Note: many of these tests set file modes to unusual values, with +;; the aim of exercising Emacs' error handling code. These tests +;; require POSIX file system semantics, which are not available on all +;; file systems (e.g. FAT, NTFS). The tests skip themselves when the +;; file system does not support the given file modes. + +;;; Code: + +(require 'cl-lib) +(require 'ert) + +(defvar filelock-tests-temporary-file-directory nil + "The directory for writing temporary files in filelock tests. +This is used by the function +`filelock-tests--make-temp-directory' to override the value of +the variable `temporary-file-directory'.") + +(defun filelock-tests--make-temp-directory () + "Create and return the name of a temporary directory. +The caller should delete the directory." + (let ((temporary-file-directory (or filelock-tests-temporary-file-directory + temporary-file-directory))) + (make-temp-file "test" t))) + +(defun filelock-tests--fixture (test-function) + "Call TEST-FUNCTION under a test fixture. +Create a test directory and a buffer whose `buffer-file-name' and +`buffer-file-truename' are a file within it. Call TEST-FUNCTION, +passing it directory name. Finally, delete the buffer and the +test directory. + +This function attempts to delete the test directory even if the +test leaves the buffer locked or the test directory with strange +permissions." + (let* ((temp-dir (filelock-tests--make-temp-directory)) + (name (concat (file-name-as-directory temp-dir) + "file")) + (create-lockfiles t)) + (unwind-protect + (with-temp-buffer + (setq buffer-file-name name) + (setq buffer-file-truename name) + (unwind-protect + (save-current-buffer + (funcall test-function temp-dir)) + + ;; Here begins somewhat delicate cleanup logic. It must + ;; be performed in this order. + ;; + ;; First, give Emacs permission to modify the test + ;; directory. The test may have left the diretory's modes + ;; in an unusual state. + ;; + ;; Second, mark the buffer unmodified. This prevents + ;; prompts from `kill-buffer' about saving unmodified + ;; buffers (when this test is run interactively). + ;; + ;; Third, delete the temp buffer (by way of + ;; `with-temp-buffer' above). Emacs may also delete the + ;; lock file from the test directory at this point. + ;; + ;; Fourth, delete the test directory itself. + + (set-file-modes temp-dir (logior #o700 (file-modes temp-dir))) + (set-buffer-modified-p nil))) + (delete-directory temp-dir t nil)))) + +(defun filelock-tests--make-file-inaccessible (filename) + "Make file named FILENAME inaccessible. +Returns non-nil if the operation succeeds, otherwise nil. Note: +not all file systems support this operation." + (set-file-modes filename #o000) + (equal #o000 (file-modes filename))) + +(ert-deftest filelock-tests-lock-unlock-no-errors () + "Check that locking and unlocking works without error." + (filelock-tests--fixture + (lambda (_) + (should (not (file-locked-p (buffer-file-name)))) + (insert "this locks the buffer's file") + (should (file-locked-p (buffer-file-name))) + (unlock-buffer) + (should (not (file-locked-p (buffer-file-name))))))) + +(ert-deftest filelock-tests-lock-buffer-permission-denied () + "Check that locking a buffer in a directory with no write +permissions does not work." + (filelock-tests--fixture + (lambda (temp-dir) + (should (not (file-locked-p (buffer-file-name)))) + + (let ((original-modes (file-modes temp-dir))) + (skip-unless (filelock-tests--make-file-inaccessible temp-dir)) + ;; FIXME: file system errors when locking a file are ignored; + ;; should they be? + (insert "this locks the current buffer's file") + (set-file-modes temp-dir original-modes)) + + (should (not (file-locked-p (buffer-file-name))))))) + +(ert-deftest filelock-tests-file-locked-p-permission-denied () + "Check that `file-locked-p' fails if the directory is inaccesible." + (filelock-tests--fixture + (lambda (temp-dir) + (skip-unless (filelock-tests--make-file-inaccessible temp-dir)) + + (let ((err (should-error (file-locked-p (buffer-file-name))))) + (should (equal (cl-subseq err 0 2) + '(file-error "Testing file lock"))))))) + +(ert-deftest filelock-tests-unlock-permission-denied () + "Check that `unlock-buffer' fails in directories that cannot be +modified." + (filelock-tests--fixture + (lambda (temp-dir) + (insert "this locks the current buffer's file") + (should (file-locked-p (buffer-file-name))) + + (skip-unless (filelock-tests--make-file-inaccessible temp-dir)) + + ;; 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"))))))) + +(defun filelock-tests--yes (&rest _) + "Return t." + t) + +(ert-deftest filelock-tests-kill-buffer-permission-denied () + "Check that `unlock-buffer' fails in directories that cannot be +modified." + (filelock-tests--fixture + (lambda (temp-dir) + (insert "this should lock the buffer") + (should (file-locked-p (buffer-file-name))) + + (skip-unless (filelock-tests--make-file-inaccessible temp-dir)) + + ;; Kill the current buffer even if it is modified. Use advice to + ;; fake a "yes" answer for the "Buffer modified; kill anyway?" + ;; prompt. Leave the buffer modified so `kill-buffer' will + ;; attempt to unlock the buffer's file. + ;; + ;; FIXME: Killing buffers should not signal errors related to + ;; their lock files (bug#46397). + (let ((err (unwind-protect + (progn + (advice-add 'yes-or-no-p + :override + 'filelock-tests--yes) + (should-error (kill-buffer))) + (advice-remove 'yes-or-no-p 'filelock-tests--yes)))) + (should (equal (cl-subseq err 0 2) + '(file-error "Unlocking file"))))))) + +(provide 'filelock-tests) +;;; filelock-tests.el ends here -- 2.30.1