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
| | ;;; uniquify-tests.el --- Tests for uniquify -*- lexical-binding: t; -*-
;; Copyright (C) 2023 Free Software Foundation, Inc.
;; Author: Spencer Baugh <sbaugh@janestreet.com>
;; This program 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.
;; This program 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:
;;; Code:
(require 'ert)
(ert-deftest uniquify-basic ()
(let (bufs old-names)
(cl-flet ((names-are (current-names &optional nosave)
(should (equal (mapcar #'buffer-name bufs) current-names))
(unless nosave (push current-names old-names))))
(should (eq (get-buffer "z") nil))
(push (find-file-noselect "a/b/z") bufs)
(names-are '("z"))
(push (find-file-noselect "a/b/c/z") bufs)
(names-are '("z<c>" "z<b>"))
(push (find-file-noselect "a/b/d/z") bufs)
(names-are '("z<d>" "z<c>" "z<b>"))
(push (find-file-noselect "e/b/z") bufs)
(names-are '("z<e/b>" "z<d>" "z<c>" "z<a/b>"))
;; buffers without a buffer-file-name don't get uniquified by uniquify
(push (generate-new-buffer "z") bufs)
(names-are '("z" "z<e/b>" "z<d>" "z<c>" "z<a/b>"))
;; but they do get uniquified by the C code which uses <n>
(push (generate-new-buffer "z") bufs)
(names-are '("z<2>" "z" "z<e/b>" "z<d>" "z<c>" "z<a/b>"))
(save-excursion
;; uniquify will happily work with file-visiting buffers whose names don't match buffer-file-name
(find-file "f/y")
(push (current-buffer) bufs)
(rename-buffer "z" t)
(names-are '("z<f>" "z<2>" "z" "z<e/b>" "z<d>" "z<c>" "z<a/b>") 'nosave)
;; somewhat confusing behavior results if a buffer is renamed to match an already-uniquified buffer
(rename-buffer "z<a/b>" t)
(names-are '("z<a/b><f>" "z<2>" "z" "z<e/b>" "z<d>" "z<c>" "z<a/b>") 'nosave))
(while bufs
(kill-buffer (pop bufs))
(names-are (pop old-names) 'nosave)))))
(ert-deftest uniquify-dirs ()
"Check strip-common-suffix and trailing-separator-p work together; bug#47132"
(let* ((root (make-temp-file "emacs-uniquify-tests" 'dir))
(a-path (file-name-concat root "a/x/y/dir"))
(b-path (file-name-concat root "b/x/y/dir")))
(make-directory a-path 'parents)
(make-directory b-path 'parents)
(let ((uniquify-buffer-name-style 'forward)
(uniquify-strip-common-suffix t)
(uniquify-trailing-separator-p nil))
(let ((bufs (list (find-file-noselect a-path)
(find-file-noselect b-path))))
(should (equal (mapcar #'buffer-name bufs)
'("a/dir" "b/dir")))
(mapc #'kill-buffer bufs)))
(let ((uniquify-buffer-name-style 'forward)
(uniquify-strip-common-suffix nil)
(uniquify-trailing-separator-p t))
(let ((bufs (list (find-file-noselect a-path)
(find-file-noselect b-path))))
(should (equal (mapcar #'buffer-name bufs)
'("a/x/y/dir/" "b/x/y/dir/")))
(mapc #'kill-buffer bufs)))
(let ((uniquify-buffer-name-style 'forward)
(uniquify-strip-common-suffix t)
(uniquify-trailing-separator-p t))
(let ((bufs (list (find-file-noselect a-path)
(find-file-noselect b-path))))
(should (equal (mapcar #'buffer-name bufs)
'("a/dir/" "b/dir/")))
(mapc #'kill-buffer bufs)))))
(ert-deftest uniquify-rename-to-dir ()
"Giving a buffer a name which matches a directory doesn't rename the buffer"
(let ((uniquify-buffer-name-style 'forward)
(uniquify-trailing-separator-p t))
(save-excursion
(find-file "../README")
(rename-buffer "lisp" t)
(should (equal (buffer-name) "lisp"))
(kill-buffer))))
(ert-deftest uniquify-separator-style-reverse ()
(let ((uniquify-buffer-name-style 'reverse)
(uniquify-trailing-separator-p t))
(save-excursion
(should (file-directory-p "../lib-src"))
(find-file "../lib-src")
(should (equal (buffer-name) "\\lib-src"))
(kill-buffer))))
(provide 'uniquify-tests)
;;; uniquify-tests.el ends here
|