all messages for Emacs-related lists mirrored at yhetil.org
 help / color / mirror / code / Atom feed
blob abd61fa350408092dfc46cd8b89685fafff30504 5349 bytes (raw)
name: test/lisp/uniquify-tests.el 	 # note: path name is non-authoritative(*)

  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
 
;;; 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))))

(ert-deftest uniquify-separator-ignored ()
  "If uniquify-buffer-name-style isn't forward or reverse,
uniquify-trailing-separator-p is ignored"
  (let ((uniquify-buffer-name-style 'post-forward-angle-brackets)
        (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))))

(ert-deftest uniquify-space-prefix ()
  "If a buffer starts with a space, | is added at the start"
  (save-excursion
    (find-file " foo")
    (should (equal (buffer-name) "| foo"))
    (kill-buffer)))

(provide 'uniquify-tests)
;;; uniquify-tests.el ends here

debug log:

solving abd61fa3504 ...
found abd61fa3504 in https://git.savannah.gnu.org/cgit/emacs.git

(*) Git path names are given by the tree(s) the blob belongs to.
    Blobs themselves have no identifier aside from the hash of its contents.^

Code repositories for project(s) associated with this external index

	https://git.savannah.gnu.org/cgit/emacs.git
	https://git.savannah.gnu.org/cgit/emacs/org-mode.git

This is an external index of several public inboxes,
see mirroring instructions on how to clone and mirror
all data and code used by this external index.