From 18529d097624e0d4647cf04118d4ce98adc474ba Mon Sep 17 00:00:00 2001 From: Matt Armstrong Date: Mon, 15 Feb 2021 12:59:08 -0800 Subject: [PATCH] Add some test coverage for src/filelock.c (Bug#46397). * test/src/filelock-tests.el: New file. --- test/src/filelock-tests.el | 148 +++++++++++++++++++++++++++++++++++++ 1 file changed, 148 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..d9534e2d16 --- /dev/null +++ b/test/src/filelock-tests.el @@ -0,0 +1,148 @@ +;;; 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 related buffer and file +;; I/O code. + +;;; Code: + +(require 'ert) + +(defun filelock-tests--supported-p () + "Return t if the current system implements file locking." + (not (memq system-type '(ms-dos)))) + +(defun filelock-tests--call-with-fixture (body) + "Call BODY under a standard test fixture. +See `filelock-tests--with-fixture'." + (let* ((test-dir (make-temp-file "filelock-tests-" t)) + (test-dir-modes (file-modes test-dir))) + (unwind-protect + (let ((file-name (file-truename + (concat (file-name-as-directory test-dir) + "file")))) + (with-temp-buffer + (let ((temp-buffer (current-buffer))) + ;; Setting both file names is sufficient to enable file + ;; locks. + (setq buffer-file-name file-name + buffer-file-truename file-name) + (unwind-protect + (let ((create-lockfiles t)) + (funcall body)) + (set-file-modes test-dir test-dir-modes) + (when (buffer-live-p temp-buffer) + (with-current-buffer temp-buffer + (set-buffer-modified-p nil))))))) + (delete-directory test-dir t nil)))) + +(defmacro filelock-tests--with-fixture (&rest body) + "Create a test fixture evaluate BODY there like `progn'. +Create a temporary directory, then create a temporary buffer and +set it the variable `buffer-file-name' and `buffer-file-truename' +to it, let bind `create-lockfiles' to 't' and evaluate BODY. +Finally, delete the temporary directory." + (declare (indent 0)) + `(filelock-tests--call-with-fixture + (lambda () ,@body))) + +(ert-deftest filelock-tests-when-create-lockfiles-nil () + (filelock-tests--with-fixture + (let ((create-lockfiles nil)) + (should (not (file-locked-p buffer-file-truename))) + (insert "some text") + (lock-buffer) + (should (not (file-locked-p buffer-file-truename)))))) + +(ert-deftest filelock-tests-when-create-lockfiles-t () + (filelock-tests--with-fixture + (should (equal t create-lockfiles)) + (insert "some text") + (lock-buffer) + ;; Verify 't' explicitly and not any true value; 't' alone means + ;; the current process owns the lock. + (let ((expected (if (filelock-tests--supported-p) + t + nil))) + (should (equal expected (file-locked-p buffer-file-truename))) + (unlock-buffer) + (should (equal nil (file-locked-p buffer-file-truename)))))) + +(ert-deftest filelock-tests-file-locked-p-inaccessible-dir () + (skip-unless (filelock-tests--supported-p)) + (filelock-tests--with-fixture + (set-file-modes (file-name-directory (buffer-file-name)) + (file-modes-symbolic-to-number "ugo=")) + (set-buffer-modified-p t) + (let ((full-error (should-error (file-locked-p (buffer-file-name)) + :type 'file-error))) + (should (equal "Testing file lock" (nth 1 full-error)))))) + +(ert-deftest filelock-tests-lock-buffer-inaccessible-dir () + (skip-unless (filelock-tests--supported-p)) + (filelock-tests--with-fixture + (let* ((test-dir (file-name-directory (buffer-file-name))) + (original-modes (file-modes test-dir))) + (set-file-modes test-dir (file-modes-symbolic-to-number "ugo=")) + (insert "some text") + ;; FIXME: (lock-buffer) should signal an error here. + (lock-buffer) + (set-file-modes test-dir original-modes) + (should (equal nil (file-locked-p (buffer-file-name))))))) + +(ert-deftest filelock-tests-lock-buffer-dir-not-writeable () + (skip-unless (filelock-tests--supported-p)) + (filelock-tests--with-fixture + (set-file-modes (file-name-directory (buffer-file-name)) + (file-modes-symbolic-to-number "u=rx")) + (insert "some text") + ;; FIXME: (lock-buffer) should signal here, but lock_file() in + ;; filelock.c ignores some file system errors; see the related + ;; FIXME there. + (lock-buffer) + (should (equal nil (file-locked-p (buffer-file-name)))))) + +(ert-deftest filelock-tests-unlock-buffer-inaccessible-dir () + (skip-unless (filelock-tests--supported-p)) + (filelock-tests--with-fixture + (insert "some text") + (lock-buffer) + (should (file-locked-p (buffer-file-name))) + (set-file-modes (file-name-directory (buffer-file-name)) + (file-modes-symbolic-to-number "ugo=")) + (let ((full-error (should-error (unlock-buffer) + :type 'file-error))) + (should (equal "Unlocking file" (nth 1 full-error)))))) + +(ert-deftest filelock-tests-unlock-buffer-dir-not-writeable () + (skip-unless (filelock-tests--supported-p)) + (filelock-tests--with-fixture + (insert "some text") + (should (file-locked-p (buffer-file-name))) + (set-file-modes (file-name-directory (buffer-file-name)) + (file-modes-symbolic-to-number "u=rx")) + (let ((full-error (should-error (unlock-buffer) + :type 'file-error))) + (should (equal "Unlocking file" (nth 1 full-error)))))) + +(provide 'filelock-tests) + +;;; filelock-tests.el ends here -- 2.30.0