1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
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 <https://www.gnu.org/licenses/>.
;;; 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
|