1;;; ibuffer-tests.el --- Test suite. -*- lexical-binding: t -*- 2 3;; Copyright (C) 2015-2021 Free Software Foundation, Inc. 4 5;; This file is part of GNU Emacs. 6 7;; GNU Emacs is free software: you can redistribute it and/or modify 8;; it under the terms of the GNU General Public License as published by 9;; the Free Software Foundation, either version 3 of the License, or 10;; (at your option) any later version. 11 12;; GNU Emacs is distributed in the hope that it will be useful, 13;; but WITHOUT ANY WARRANTY; without even the implied warranty of 14;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 15;; GNU General Public License for more details. 16 17;; You should have received a copy of the GNU General Public License 18;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. 19 20;;; Code: 21(require 'ert) 22(require 'ibuffer) 23(eval-when-compile 24 (require 'ibuf-macs)) 25 26(defvar ibuffer-filter-groups) 27(defvar ibuffer-filtering-alist) 28(defvar ibuffer-filtering-qualifiers) 29(defvar ibuffer-save-with-custom) 30(defvar ibuffer-saved-filter-groups) 31(defvar ibuffer-saved-filters) 32(declare-function ibuffer-format-qualifier "ibuf-ext" (qualifier)) 33(declare-function ibuffer-unary-operand "ibuf-ext" (filter)) 34 35(ert-deftest ibuffer-0autoload () ; sort first 36 "Tests to see whether ibuffer has been autoloaded" 37 (skip-unless (not (featurep 'ibuf-ext))) 38 (should 39 (fboundp 'ibuffer-mark-unsaved-buffers)) 40 (should 41 (autoloadp 42 (symbol-function 43 'ibuffer-mark-unsaved-buffers)))) 44 45(ert-deftest ibuffer-test-Bug24997 () 46 "Test for https://debbugs.gnu.org/24997 ." 47 (ibuffer) 48 (let ((orig ibuffer-filtering-qualifiers)) 49 (unwind-protect 50 (progn 51 (setq ibuffer-filtering-qualifiers 52 '((size-gt . 10) 53 (used-mode . lisp-interaction-mode))) 54 (ibuffer-update nil t) 55 (ignore-errors (ibuffer-decompose-filter)) 56 (should (cdr ibuffer-filtering-qualifiers))) 57 (setq ibuffer-filtering-qualifiers orig) 58 (ibuffer-update nil t)))) 59 60(ert-deftest ibuffer-test-Bug25000 () 61 "Test for https://debbugs.gnu.org/25000 ." 62 (let ((case-fold-search t) 63 (buf1 (generate-new-buffer "ibuffer-test-Bug25000-buf1")) 64 (buf2 (generate-new-buffer "ibuffer-test-Bug25000-buf2"))) 65 (ibuffer) 66 (unwind-protect 67 (ibuffer-save-marks 68 (ibuffer-unmark-all-marks) 69 (ibuffer-mark-by-name-regexp (buffer-name buf1)) 70 (ibuffer-change-marks ibuffer-marked-char ?L) 71 (ibuffer-mark-by-name-regexp (buffer-name buf2)) 72 (ibuffer-change-marks ibuffer-marked-char ?l) 73 (should-not (cdr (ibuffer-buffer-names-with-mark ?l)))) 74 (mapc (lambda (buf) (when (buffer-live-p buf) 75 (kill-buffer buf))) (list buf1 buf2))))) 76 77(ert-deftest ibuffer-save-filters () 78 "Tests that `ibuffer-save-filters' saves in the proper format." 79 (require 'ibuf-ext) 80 (let ((ibuffer-save-with-custom nil) 81 (ibuffer-saved-filters nil) 82 (test1 '((mode . org-mode) 83 (or (size-gt . 10000) 84 (and (not (starred-name)) 85 (directory . "\<org\>"))))) 86 (test2 '((or (mode . emacs-lisp-mode) (file-extension . "elc?") 87 (and (starred-name) (name . "elisp")) 88 (mode . lisp-interaction-mode)))) 89 (test3 '((size-lt . 100) (derived-mode . prog-mode) 90 (or (filename . "scratch") 91 (filename . "bonz") 92 (filename . "temp"))))) 93 (ibuffer-save-filters "test1" test1) 94 (should (equal (car ibuffer-saved-filters) (cons "test1" test1))) 95 (ibuffer-save-filters "test2" test2) 96 (should (equal (car ibuffer-saved-filters) (cons "test2" test2))) 97 (should (equal (cadr ibuffer-saved-filters) (cons "test1" test1))) 98 (ibuffer-save-filters "test3" test3) 99 (should (equal (car ibuffer-saved-filters) (cons "test3" test3))) 100 (should (equal (cadr ibuffer-saved-filters) (cons "test2" test2))) 101 (should (equal (car (cddr ibuffer-saved-filters)) (cons "test1" test1))) 102 (should (equal (cdr (assoc "test1" ibuffer-saved-filters)) test1)) 103 (should (equal (cdr (assoc "test2" ibuffer-saved-filters)) test2)) 104 (should (equal (cdr (assoc "test3" ibuffer-saved-filters)) test3)))) 105 106(ert-deftest ibuffer-test-Bug25058 () 107 "Test for https://debbugs.gnu.org/25058 ." 108 (ibuffer) 109 (let ((orig-filters ibuffer-saved-filter-groups) 110 (tmp-filters '(("saved-filters" 111 ("Shell" 112 (used-mode . shell-mode)) 113 ("Elisp" 114 (or 115 (used-mode . emacs-lisp-mode) 116 (used-mode . lisp-interaction-mode))) 117 ("Dired" 118 (used-mode . dired-mode)) 119 ("Info" 120 (or 121 (used-mode . help-mode) 122 (used-mode . debugger-mode) 123 (used-mode . Custom-mode) 124 (used-mode . completion-list-mode) 125 (name . "\\`[*]Messages[*]\\'"))))))) 126 (unwind-protect 127 (progn 128 (setq ibuffer-saved-filter-groups tmp-filters) 129 (ibuffer-switch-to-saved-filter-groups "saved-filters") 130 (ibuffer-decompose-filter-group "Elisp") 131 (ibuffer-filter-disable) 132 (ibuffer-switch-to-saved-filter-groups "saved-filters") 133 (should (assoc "Elisp" (cdar ibuffer-saved-filter-groups)))) 134 (setq ibuffer-saved-filter-groups orig-filters) 135 (ibuffer-awhen (get-buffer "*Ibuffer*") 136 (and (buffer-live-p it) (kill-buffer it)))))) 137 138 139(ert-deftest ibuffer-test-Bug25042 () 140 "Test for https://debbugs.gnu.org/25042 ." 141 (ibuffer) 142 (let ((filters ibuffer-filtering-qualifiers)) 143 (unwind-protect 144 (progn 145 (ignore-errors ; Mistyped `match-string' instead of `string-match'. 146 (setq ibuffer-filtering-qualifiers nil) 147 (ibuffer-filter-by-predicate '(match-string "foo" (buffer-name)))) 148 (should-not ibuffer-filtering-qualifiers)) 149 (setq ibuffer-filtering-qualifiers filters)))) 150 151;; Test Filter Inclusion 152(let* (test-buffer-list ; accumulated buffers to clean up 153 test-file-list 154 ;; Utility functions without polluting the environment 155 (set-buffer-mode 156 (lambda (buffer mode) 157 "Set BUFFER's major mode to MODE, a mode function, or fundamental." 158 (with-current-buffer buffer 159 (funcall (or mode #'fundamental-mode))))) 160 (set-buffer-contents 161 (lambda (buffer size include-content) 162 "Add exactly SIZE bytes to BUFFER, including INCLUDE-CONTENT." 163 (when (or size include-content) 164 (let* ((unit "\n") 165 (chunk "ccccccccccccccccccccccccccccccc\n") 166 (chunk-size (length chunk)) 167 (size (if (and size include-content (stringp include-content)) 168 (- size (length include-content)) 169 size))) 170 (unless (or (null size) (> size 0)) 171 (error "size argument must be nil or positive")) 172 (with-current-buffer buffer 173 (when include-content 174 (insert include-content)) 175 (when size 176 (dotimes (_ (floor size chunk-size)) 177 (insert chunk)) 178 (dotimes (_ (mod size chunk-size)) 179 (insert unit))) 180 ;; prevent query on cleanup 181 (set-buffer-modified-p nil)))))) 182 (create-file-buffer 183 (lambda (prefix &rest args-plist) 184 "Create a file and buffer with designated properties. 185 PREFIX is a string giving the beginning of the name, and ARGS-PLIST 186 is a series of keyword-value pairs, with allowed keywords 187 :suffix STRING, :size NUMBER, :mode MODE-FUNC, :include-content STRING. 188 Returns the created buffer." 189 (let* ((suffix (plist-get args-plist :suffix)) 190 (size (plist-get args-plist :size)) 191 (include (plist-get args-plist :include-content)) 192 (mode (plist-get args-plist :mode)) 193 (file (make-temp-file prefix nil suffix)) 194 (buf (find-file-noselect file t))) 195 (push buf test-buffer-list) ; record for cleanup 196 (push file test-file-list) 197 (funcall set-buffer-mode buf mode) 198 (funcall set-buffer-contents buf size include) 199 buf))) 200 (create-non-file-buffer 201 (lambda (prefix &rest args-plist) 202 "Create a non-file and buffer with designated properties. 203 PREFIX is a string giving the beginning of the name, and ARGS-PLIST 204 is a series of keyword-value pairs, with allowed keywords 205 :size NUMBER, :mode MODE-FUNC, :include-content STRING. 206 Returns the created buffer." 207 (let* ((size (plist-get args-plist :size)) 208 (include (plist-get args-plist :include-content)) 209 (mode (plist-get args-plist :mode)) 210 (buf (generate-new-buffer prefix))) 211 (push buf test-buffer-list) ; record for cleanup 212 (funcall set-buffer-mode buf mode) 213 (funcall set-buffer-contents buf size include) 214 buf))) 215 (clean-up 216 (lambda () 217 "Restore all emacs state modified during the tests" 218 (dolist (f test-file-list) 219 (and f (file-exists-p f) (delete-file f))) 220 (while test-buffer-list ; created temporary buffers 221 (let ((buf (pop test-buffer-list))) 222 (with-current-buffer buf (bury-buffer)) ; ensure not selected 223 (kill-buffer buf)))))) 224 ;; Tests 225 (ert-deftest ibuffer-filter-inclusion-1 () 226 "Tests inclusion using basic filter combinators with a single buffer." 227 (require 'ibuf-ext) 228 (unwind-protect 229 (let ((buf 230 (funcall create-file-buffer "ibuf-test-1" :size 100 231 :include-content "One ring to rule them all\n"))) 232 (should (ibuffer-included-in-filters-p buf '((size-gt . 99)))) 233 (should (ibuffer-included-in-filters-p buf '((size-lt . 101)))) 234 (should (ibuffer-included-in-filters-p 235 buf '((mode . fundamental-mode)))) 236 (should (ibuffer-included-in-filters-p 237 buf '((content . "ring to rule them all")))) 238 (should (ibuffer-included-in-filters-p 239 buf '((and (content . "ring to rule them all"))))) 240 (should (ibuffer-included-in-filters-p 241 buf '((and (and (content . "ring to rule them all")))))) 242 (should (ibuffer-included-in-filters-p 243 buf '((and (and (and (content . "ring to rule them all"))))))) 244 (should (ibuffer-included-in-filters-p 245 buf '((or (content . "ring to rule them all"))))) 246 (should (ibuffer-included-in-filters-p 247 buf '((not (not (content . "ring to rule them all")))))) 248 (should (ibuffer-included-in-filters-p 249 buf '((and (size-gt . 99) 250 (content . "ring to rule them all") 251 (mode . fundamental-mode) 252 (basename . "\\`ibuf-test-1"))))) 253 (should (ibuffer-included-in-filters-p 254 buf '((not (or (not (size-gt . 99)) 255 (not (content . "ring to rule them all")) 256 (not (mode . fundamental-mode)) 257 (not (basename . "\\`ibuf-test-1"))))))) 258 (should (ibuffer-included-in-filters-p 259 buf '((and (or (size-gt . 99) (size-lt . 10)) 260 (and (content . "ring.*all") 261 (content . "rule") 262 (content . "them all") 263 (content . "One")) 264 (not (mode . text-mode)) 265 (basename . "\\`ibuf-test-1")))))) 266 (funcall clean-up))) 267 268 (ert-deftest ibuffer-filter-inclusion-2 () 269 "Tests inclusion of basic filters in combination on a single buffer." 270 (require 'ibuf-ext) 271 (unwind-protect 272 (let ((buf 273 (funcall create-file-buffer "ibuf-test-2" :size 200 274 :mode #'text-mode 275 :include-content "and in the darkness find them\n"))) 276 (should (ibuffer-included-in-filters-p buf '((size-gt . 199)))) 277 (should (ibuffer-included-in-filters-p buf '((size-lt . 201)))) 278 (should (ibuffer-included-in-filters-p buf '((not size-gt . 200)))) 279 (should (ibuffer-included-in-filters-p buf '((not (size-gt . 200))))) 280 (should (ibuffer-included-in-filters-p 281 buf '((and (size-gt . 199) (size-lt . 201))))) 282 (should (ibuffer-included-in-filters-p 283 buf '((or (size-gt . 199) (size-gt . 201))))) 284 (should (ibuffer-included-in-filters-p 285 buf '((or (size-gt . 201) (size-gt . 199))))) 286 (should (ibuffer-included-in-filters-p 287 buf '((size-gt . 199) (mode . text-mode) 288 (content . "darkness find them")))) 289 (should (ibuffer-included-in-filters-p 290 buf '((and (size-gt . 199) (mode . text-mode) 291 (content . "darkness find them"))))) 292 (should (ibuffer-included-in-filters-p 293 buf '((not (or (not (size-gt . 199)) (not (mode . text-mode)) 294 (not (content . "darkness find them"))))))) 295 (should (ibuffer-included-in-filters-p 296 buf '((or (size-gt . 200) (content . "darkness find them") 297 (derived-mode . emacs-lisp-mode))))) 298 (should-not (ibuffer-included-in-filters-p 299 buf '((or (size-gt . 200) (content . "rule them all") 300 (derived-mode . emacs-lisp-mode)))))) 301 (funcall clean-up))) 302 303 (ert-deftest ibuffer-filter-inclusion-3 () 304 "Tests inclusion with filename filters on specified buffers." 305 (require 'ibuf-ext) 306 (unwind-protect 307 (let* ((bufA 308 (funcall create-file-buffer "ibuf-test-3.a" :size 50 309 :mode #'text-mode 310 :include-content "...but a multitude of drops?\n")) 311 (bufB 312 (funcall create-non-file-buffer "ibuf-test-3.b" :size 50 313 :mode #'text-mode 314 :include-content "...but a multitude of drops?\n")) 315 (dirA (regexp-quote (with-current-buffer bufA default-directory))) 316 (dirB (regexp-quote (with-current-buffer bufB default-directory)))) 317 (should (ibuffer-included-in-filters-p 318 bufA '((basename . "ibuf-test-3")))) 319 (should (ibuffer-included-in-filters-p 320 bufA '((basename . "test-3\\.a")))) 321 (should (ibuffer-included-in-filters-p 322 bufA '((file-extension . "a")))) 323 (should (ibuffer-included-in-filters-p 324 bufA (list (cons 'directory dirA)))) 325 (should-not (ibuffer-included-in-filters-p 326 bufB '((basename . "ibuf-test-3")))) 327 (should-not (ibuffer-included-in-filters-p 328 bufB '((file-extension . "b")))) 329 (should (ibuffer-included-in-filters-p 330 bufB (list (cons 'directory dirB)))) 331 (should (ibuffer-included-in-filters-p 332 bufA '((name . "ibuf-test-3")))) 333 (should (ibuffer-included-in-filters-p 334 bufB '((name . "ibuf-test-3"))))) 335 (funcall clean-up))) 336 337 (ert-deftest ibuffer-filter-inclusion-4 () 338 "Tests inclusion with various filters on a single buffer." 339 (require 'ibuf-ext) 340 (unwind-protect 341 (let ((buf 342 (funcall create-file-buffer "ibuf-test-4" 343 :mode #'emacs-lisp-mode :suffix ".el" 344 :include-content "(message \"--%s--\" 'emacs-rocks)\n"))) 345 (should (ibuffer-included-in-filters-p 346 buf '((file-extension . "el")))) 347 (should (ibuffer-included-in-filters-p 348 buf '((derived-mode . prog-mode)))) 349 (should (ibuffer-included-in-filters-p 350 buf '((used-mode . emacs-lisp-mode)))) 351 (should (ibuffer-included-in-filters-p 352 buf '((mode . emacs-lisp-mode)))) 353 (with-current-buffer buf (set-buffer-modified-p t)) 354 (should (ibuffer-included-in-filters-p buf '((modified)))) 355 (with-current-buffer buf (set-buffer-modified-p nil)) 356 (should (ibuffer-included-in-filters-p buf '((not modified)))) 357 (should (ibuffer-included-in-filters-p 358 buf '((and (file-extension . "el") 359 (derived-mode . prog-mode) 360 (not modified))))) 361 (should (ibuffer-included-in-filters-p 362 buf '((or (file-extension . "tex") 363 (derived-mode . prog-mode) 364 (modified))))) 365 (should (ibuffer-included-in-filters-p 366 buf '((file-extension . "el") 367 (derived-mode . prog-mode) 368 (not modified))))) 369 (funcall clean-up))) 370 371 (ert-deftest ibuffer-filter-inclusion-5 () 372 "Tests inclusion with various filters on a single buffer." 373 (require 'ibuf-ext) 374 (unwind-protect 375 (let ((buf 376 (funcall create-non-file-buffer "ibuf-test-5.el" 377 :mode #'emacs-lisp-mode 378 :include-content 379 "(message \"--%s--\" \"It really does!\")\n"))) 380 (should-not (ibuffer-included-in-filters-p 381 buf '((file-extension . "el")))) 382 (should (ibuffer-included-in-filters-p 383 buf '((size-gt . 18)))) 384 (should (ibuffer-included-in-filters-p 385 buf '((predicate . (lambda () 386 (> (- (point-max) (point-min)) 18)))))) 387 (should (ibuffer-included-in-filters-p 388 buf '((and (mode . emacs-lisp-mode) 389 (or (starred-name) 390 (size-gt . 18)) 391 (and (not (size-gt . 100)) 392 (content . "[Ii]t *really does!") 393 (or (name . "test-5") 394 (not (filename . "test-5"))))))))) 395 (funcall clean-up))) 396 397 (ert-deftest ibuffer-filter-inclusion-6 () 398 "Tests inclusion using saved filters and DeMorgan's laws." 399 (require 'ibuf-ext) 400 (unwind-protect 401 (let ((buf 402 (funcall create-non-file-buffer "*ibuf-test-6*" :size 65 403 :mode #'text-mode)) 404 (buf2 405 (funcall create-file-buffer "ibuf-test-6a" :suffix ".html" 406 :mode #'html-mode 407 :include-content 408 "<HTML><BODY><H1>Hello, World!</H1></BODY></HTML>"))) 409 (should (ibuffer-included-in-filters-p buf '((starred-name)))) 410 (should-not (ibuffer-included-in-filters-p 411 buf '((saved . "text document")))) 412 (should (ibuffer-included-in-filters-p buf2 '((saved . "web")))) 413 (should (ibuffer-included-in-filters-p 414 buf2 '((not (and (not (derived-mode . sgml-mode)) 415 (not (derived-mode . css-mode)) 416 (not (mode . javascript-mode)) 417 (not (mode . js2-mode)) 418 (not (mode . scss-mode)) 419 (not (derived-mode . haml-mode)) 420 (not (mode . sass-mode))))))) 421 (should (ibuffer-included-in-filters-p 422 buf '((and (starred-name) 423 (or (size-gt . 50) (filename . "foo")))))) 424 (should (ibuffer-included-in-filters-p 425 buf '((not (or (not starred-name) 426 (and (size-lt . 51) 427 (not (filename . "foo"))))))))) 428 (funcall clean-up))) 429 430 (ert-deftest ibuffer-filter-inclusion-7 () 431 "Tests inclusion with various filters on a single buffer." 432 (require 'ibuf-ext) 433 (unwind-protect 434 (let ((buf 435 (funcall create-non-file-buffer "ibuf-test-7" 436 :mode #'artist-mode))) 437 (should (ibuffer-included-in-filters-p 438 buf '((not (starred-name))))) 439 (should (ibuffer-included-in-filters-p 440 buf '((not starred-name)))) 441 (should (ibuffer-included-in-filters-p 442 buf '((not (not (not starred-name)))))) 443 (should (ibuffer-included-in-filters-p 444 buf '((not (modified))))) 445 (should (ibuffer-included-in-filters-p 446 buf '((not modified)))) 447 (should (ibuffer-included-in-filters-p 448 buf '((not (not (not modified))))))) 449 (funcall clean-up))) 450 451 (ert-deftest ibuffer-filter-inclusion-8 () 452 "Tests inclusion with various filters." 453 (require 'ibuf-ext) 454 (unwind-protect 455 (let ((bufA 456 (funcall create-non-file-buffer "ibuf-test-8a" 457 :mode #'artist-mode)) 458 (bufB (funcall create-non-file-buffer "*ibuf-test-8b*" :size 32)) 459 (bufC (or (memq system-type '(ms-dos windows-nt)) 460 (funcall create-file-buffer "ibuf-test8c" :suffix "*" 461 :size 64))) 462 (bufD (or (memq system-type '(ms-dos windows-nt)) 463 (funcall create-file-buffer "*ibuf-test8d" :size 128))) 464 (bufE (or (memq system-type '(ms-dos windows-nt)) 465 (funcall create-file-buffer "*ibuf-test8e" 466 :suffix "*<2>" :size 16))) 467 (bufF (and (funcall create-non-file-buffer "*ibuf-test8f*") 468 (funcall create-non-file-buffer "*ibuf-test8f*" 469 :size 8)))) 470 (with-current-buffer bufA (set-buffer-modified-p t)) 471 (should (ibuffer-included-in-filters-p 472 bufA '((and (not starred-name) 473 (modified) 474 (name . "test-8") 475 (not (size-gt . 100)) 476 (mode . picture-mode))))) 477 (with-current-buffer bufA (set-buffer-modified-p nil)) 478 (should-not (ibuffer-included-in-filters-p 479 bufA '((or (starred-name) (visiting-file) (modified))))) 480 (should (ibuffer-included-in-filters-p 481 bufB '((and (starred-name) 482 (name . "test.*8b") 483 (size-gt . 31) 484 (not visiting-file))))) 485 ;; MS-DOS and MS-Windows don't allow "*" in file names. 486 (or (memq system-type '(ms-dos windows-nt)) 487 (should (ibuffer-included-in-filters-p 488 bufC '((and (not (starred-name)) 489 (visiting-file) 490 (name . "8c[^*]*\\*") 491 (size-lt . 65)))))) 492 ;; MS-DOS and MS-Windows don't allow "*" in file names. 493 (or (memq system-type '(ms-dos windows-nt)) 494 (should (ibuffer-included-in-filters-p 495 bufD '((and (not (starred-name)) 496 (visiting-file) 497 (name . "\\`\\*.*test8d") 498 (size-lt . 129) 499 (size-gt . 127)))))) 500 ;; MS-DOS and MS-Windows don't allow "*" in file names. 501 (or (memq system-type '(ms-dos windows-nt)) 502 (should (ibuffer-included-in-filters-p 503 bufE '((and (starred-name) 504 (visiting-file) 505 (name . "8e.*?\\*<[[:digit:]]+>") 506 (size-gt . 10)))))) 507 (should (ibuffer-included-in-filters-p 508 bufF '((and (starred-name) 509 (not (visiting-file)) 510 (name . "8f\\*<[[:digit:]]>") 511 (size-lt . 10)))))) 512 (funcall clean-up)))) 513 514;; Test Filter Combination and Decomposition 515(let* (ibuffer-to-kill ; if non-nil, kill this buffer at cleanup 516 (ibuffer-already 'check) ; existing ibuffer buffer to use but not kill 517 ;; Utility functions without polluting the environment 518 (get-test-ibuffer 519 (lambda () 520 "Returns a test ibuffer-mode buffer, creating one if necessary. 521 If a new buffer is created, it is named \"*Test-Ibuffer*\" and is 522 saved to `ibuffer-to-kill' for later cleanup." 523 (when (eq ibuffer-already 'check) 524 (setq ibuffer-already 525 (catch 'found-buf 526 (dolist (buf (buffer-list) nil) 527 (when (with-current-buffer buf 528 (derived-mode-p 'ibuffer-mode)) 529 (throw 'found-buf buf)))))) 530 (or ibuffer-already 531 ibuffer-to-kill 532 (let ((test-ibuf-name "*Test-Ibuffer*")) 533 (ibuffer nil test-ibuf-name nil t) 534 (setq ibuffer-to-kill (get-buffer test-ibuf-name)))))) 535 (clean-up 536 (lambda () 537 "Restore all emacs state modified during the tests" 538 (when ibuffer-to-kill ; created ibuffer 539 (with-current-buffer ibuffer-to-kill 540 (set-buffer-modified-p nil) 541 (bury-buffer)) 542 (kill-buffer ibuffer-to-kill) 543 (setq ibuffer-to-kill nil)) 544 (when (and ibuffer-already (not (eq ibuffer-already 'check))) 545 ;; restore existing ibuffer state 546 (ibuffer-update nil t))))) 547 ;; Tests 548 (ert-deftest ibuffer-decompose-filter () 549 "Tests `ibuffer-decompose-filter' for and, or, not, and saved." 550 (require 'ibuf-ext) 551 (unwind-protect 552 (let ((ibuf (funcall get-test-ibuffer))) 553 (with-current-buffer ibuf 554 (let ((ibuffer-filtering-qualifiers nil) 555 (ibuffer-filter-groups nil) 556 (filters '((size-gt . 100) (not (starred-name)) 557 (name . "foo")))) 558 (progn 559 (push (cons 'or filters) ibuffer-filtering-qualifiers) 560 (ibuffer-decompose-filter) 561 (should (equal filters ibuffer-filtering-qualifiers)) 562 (setq ibuffer-filtering-qualifiers nil)) 563 (progn 564 (push (cons 'and filters) ibuffer-filtering-qualifiers) 565 (ibuffer-decompose-filter) 566 (should (equal filters ibuffer-filtering-qualifiers)) 567 (setq ibuffer-filtering-qualifiers nil)) 568 (progn 569 (push (list 'not (car filters)) ibuffer-filtering-qualifiers) 570 (ibuffer-decompose-filter) 571 (should (equal (list (car filters)) 572 ibuffer-filtering-qualifiers)) 573 (setq ibuffer-filtering-qualifiers nil)) 574 (progn 575 (push (cons 'not (car filters)) ibuffer-filtering-qualifiers) 576 (ibuffer-decompose-filter) 577 (should (equal (list (car filters)) 578 ibuffer-filtering-qualifiers)) 579 (setq ibuffer-filtering-qualifiers nil)) 580 (let ((gnus (assoc "gnus" ibuffer-saved-filters))) 581 (push '(saved . "gnus") ibuffer-filtering-qualifiers) 582 (ibuffer-decompose-filter) 583 (should (equal (cdr gnus) ibuffer-filtering-qualifiers)) 584 (ibuffer-decompose-filter) 585 (should (equal (cdr (cadr gnus)) ibuffer-filtering-qualifiers)) 586 (setq ibuffer-filtering-qualifiers nil)) 587 (when (not (assoc "__unknown__" ibuffer-saved-filters)) 588 (push '(saved . "__uknown__") ibuffer-filtering-qualifiers) 589 (should-error (ibuffer-decompose-filter) :type 'error) 590 (setq ibuffer-filtering-qualifiers nil)) 591 (progn 592 (push (car filters) ibuffer-filtering-qualifiers) 593 (should-error (ibuffer-decompose-filter) :type 'error) 594 (setq ibuffer-filtering-qualifiers nil))))) 595 (funcall clean-up))) 596 597 (ert-deftest ibuffer-and-filter () 598 "Tests `ibuffer-and-filter' in an Ibuffer buffer." 599 (require 'ibuf-ext) 600 (unwind-protect 601 (let ((ibuf (funcall get-test-ibuffer))) 602 (with-current-buffer ibuf 603 (let ((ibuffer-filtering-qualifiers nil) 604 (ibuffer-filter-groups nil) 605 (filters [(size-gt . 100) (not (starred-name)) 606 (filename . "A") (mode . text-mode)])) 607 (should-error (ibuffer-and-filter) :type 'error) 608 (progn 609 (push (aref filters 1) ibuffer-filtering-qualifiers) 610 (should-error (ibuffer-and-filter) :type 'error)) 611 (should (progn 612 (push (aref filters 0) ibuffer-filtering-qualifiers) 613 (ibuffer-and-filter) 614 (and (equal (list 'and (aref filters 0) (aref filters 1)) 615 (car ibuffer-filtering-qualifiers)) 616 (null (cdr ibuffer-filtering-qualifiers))))) 617 (should (progn 618 (ibuffer-and-filter 'decompose) 619 (and (equal (aref filters 0) 620 (pop ibuffer-filtering-qualifiers)) 621 (equal (aref filters 1) 622 (pop ibuffer-filtering-qualifiers)) 623 (null ibuffer-filtering-qualifiers)))) 624 (should (progn 625 (push (list 'and (aref filters 2) (aref filters 3)) 626 ibuffer-filtering-qualifiers) 627 (push (list 'and (aref filters 0) (aref filters 1)) 628 ibuffer-filtering-qualifiers) 629 (ibuffer-and-filter) 630 (and (equal (list 'and (aref filters 0) (aref filters 1) 631 (aref filters 2) (aref filters 3)) 632 (car ibuffer-filtering-qualifiers)) 633 (null (cdr ibuffer-filtering-qualifiers))))) 634 (pop ibuffer-filtering-qualifiers) 635 (should (progn 636 (push (list 'or (aref filters 2) (aref filters 3)) 637 ibuffer-filtering-qualifiers) 638 (push (list 'and (aref filters 0) (aref filters 1)) 639 ibuffer-filtering-qualifiers) 640 (ibuffer-and-filter) 641 (and (equal (list 'and (aref filters 0) (aref filters 1) 642 (list 'or (aref filters 2) 643 (aref filters 3))) 644 (car ibuffer-filtering-qualifiers)) 645 (null (cdr ibuffer-filtering-qualifiers))))) 646 (pop ibuffer-filtering-qualifiers) 647 (should (progn 648 (push (list 'and (aref filters 2) (aref filters 3)) 649 ibuffer-filtering-qualifiers) 650 (push (list 'or (aref filters 0) (aref filters 1)) 651 ibuffer-filtering-qualifiers) 652 (ibuffer-and-filter) 653 (and (equal (list 'and (list 'or (aref filters 0) 654 (aref filters 1)) 655 (aref filters 2) (aref filters 3)) 656 (car ibuffer-filtering-qualifiers)) 657 (null (cdr ibuffer-filtering-qualifiers))))) 658 (pop ibuffer-filtering-qualifiers) 659 (should (progn 660 (push (list 'or (aref filters 2) (aref filters 3)) 661 ibuffer-filtering-qualifiers) 662 (push (list 'or (aref filters 0) (aref filters 1)) 663 ibuffer-filtering-qualifiers) 664 (ibuffer-and-filter) 665 (and (equal (list 'and 666 (list 'or (aref filters 0) 667 (aref filters 1)) 668 (list 'or (aref filters 2) 669 (aref filters 3))) 670 (car ibuffer-filtering-qualifiers)) 671 (null (cdr ibuffer-filtering-qualifiers)))))))) 672 (funcall clean-up))) 673 674 (ert-deftest ibuffer-or-filter () 675 "Tests `ibuffer-or-filter' in an Ibuffer buffer." 676 (require 'ibuf-ext) 677 (unwind-protect 678 (let ((ibuf (funcall get-test-ibuffer))) 679 (with-current-buffer ibuf 680 (let ((ibuffer-filtering-qualifiers nil) 681 (ibuffer-filter-groups nil) 682 (filters [(size-gt . 100) (not (starred-name)) 683 (filename . "A") (mode . text-mode)])) 684 (should-error (ibuffer-or-filter) :type 'error) 685 (progn 686 (push (aref filters 1) ibuffer-filtering-qualifiers) 687 (should-error (ibuffer-or-filter) :type 'error)) 688 (should (progn 689 (push (aref filters 0) ibuffer-filtering-qualifiers) 690 (ibuffer-or-filter) 691 (and (equal (list 'or (aref filters 0) (aref filters 1)) 692 (car ibuffer-filtering-qualifiers)) 693 (null (cdr ibuffer-filtering-qualifiers))))) 694 (should (progn 695 (ibuffer-or-filter 'decompose) 696 (and (equal (aref filters 0) 697 (pop ibuffer-filtering-qualifiers)) 698 (equal (aref filters 1) 699 (pop ibuffer-filtering-qualifiers)) 700 (null ibuffer-filtering-qualifiers)))) 701 (should (progn 702 (push (list 'or (aref filters 2) (aref filters 3)) 703 ibuffer-filtering-qualifiers) 704 (push (list 'or (aref filters 0) (aref filters 1)) 705 ibuffer-filtering-qualifiers) 706 (ibuffer-or-filter) 707 (and (equal (list 'or (aref filters 0) (aref filters 1) 708 (aref filters 2) (aref filters 3)) 709 (car ibuffer-filtering-qualifiers)) 710 (null (cdr ibuffer-filtering-qualifiers))))) 711 (pop ibuffer-filtering-qualifiers) 712 (should (progn 713 (push (list 'and (aref filters 2) (aref filters 3)) 714 ibuffer-filtering-qualifiers) 715 (push (list 'or (aref filters 0) (aref filters 1)) 716 ibuffer-filtering-qualifiers) 717 (ibuffer-or-filter) 718 (and (equal (list 'or (aref filters 0) (aref filters 1) 719 (list 'and (aref filters 2) 720 (aref filters 3))) 721 (car ibuffer-filtering-qualifiers)) 722 (null (cdr ibuffer-filtering-qualifiers))))) 723 (pop ibuffer-filtering-qualifiers) 724 (should (progn 725 (push (list 'or (aref filters 2) (aref filters 3)) 726 ibuffer-filtering-qualifiers) 727 (push (list 'and (aref filters 0) (aref filters 1)) 728 ibuffer-filtering-qualifiers) 729 (ibuffer-or-filter) 730 (and (equal (list 'or (list 'and (aref filters 0) 731 (aref filters 1)) 732 (aref filters 2) (aref filters 3)) 733 (car ibuffer-filtering-qualifiers)) 734 (null (cdr ibuffer-filtering-qualifiers))))) 735 (pop ibuffer-filtering-qualifiers) 736 (should (progn 737 (push (list 'and (aref filters 2) (aref filters 3)) 738 ibuffer-filtering-qualifiers) 739 (push (list 'and (aref filters 0) (aref filters 1)) 740 ibuffer-filtering-qualifiers) 741 (ibuffer-or-filter) 742 (and (equal (list 'or 743 (list 'and (aref filters 0) 744 (aref filters 1)) 745 (list 'and (aref filters 2) 746 (aref filters 3))) 747 (car ibuffer-filtering-qualifiers)) 748 (null (cdr ibuffer-filtering-qualifiers)))))))) 749 (funcall clean-up)))) 750 751(ert-deftest ibuffer-format-qualifier () 752 "Tests string recommendation of filter from `ibuffer-format-qualifier'." 753 (require 'ibuf-ext) 754 (let ((test1 '(mode . org-mode)) 755 (test2 '(size-lt . 100)) 756 (test3 '(derived-mode . prog-mode)) 757 (test4 '(or (size-gt . 10000) 758 (and (not (starred-name)) 759 (directory . "\\<org\\>")))) 760 (test5 '(or (filename . "scratch") 761 (filename . "bonz") 762 (filename . "temp"))) 763 (test6 '(or (mode . emacs-lisp-mode) (file-extension . "elc?") 764 (and (starred-name) (name . "elisp")) 765 (mode . lisp-interaction-mode))) 766 (description (lambda (q) 767 (cadr (assq q ibuffer-filtering-alist)))) 768 (tag (lambda (&rest args ) 769 (concat " [" (apply #'concat args) "]")))) 770 (should (equal (ibuffer-format-qualifier test1) 771 (funcall tag (funcall description 'mode) 772 ": " "org-mode"))) 773 (should (equal (ibuffer-format-qualifier test2) 774 (funcall tag (funcall description 'size-lt) 775 ": " "100"))) 776 (should (equal (ibuffer-format-qualifier test3) 777 (funcall tag (funcall description 'derived-mode) 778 ": " "prog-mode"))) 779 (should (equal (ibuffer-format-qualifier test4) 780 (funcall tag "OR" 781 (funcall tag (funcall description 'size-gt) 782 ": " (format "%s" 10000)) 783 (funcall tag "AND" 784 (funcall tag "NOT" 785 (funcall tag 786 (funcall description 787 'starred-name) 788 ": " "nil")) 789 (funcall tag 790 (funcall description 'directory) 791 ": " "\\<org\\>"))))) 792 (should (equal (ibuffer-format-qualifier test5) 793 (funcall tag "OR" 794 (funcall tag (funcall description 'filename) 795 ": " "scratch") 796 (funcall tag (funcall description 'filename) 797 ": " "bonz") 798 (funcall tag (funcall description 'filename) 799 ": " "temp")))) 800 (should (equal (ibuffer-format-qualifier test6) 801 (funcall tag "OR" 802 (funcall tag (funcall description 'mode) 803 ": " "emacs-lisp-mode") 804 (funcall tag (funcall description 'file-extension) 805 ": " "elc?") 806 (funcall tag "AND" 807 (funcall tag 808 (funcall description 'starred-name) 809 ": " "nil") 810 (funcall tag 811 (funcall description 'name) 812 ": " "elisp")) 813 (funcall tag (funcall description 'mode) 814 ": " "lisp-interaction-mode")))))) 815 816(ert-deftest ibuffer-unary-operand () 817 "Tests `ibuffer-unary-operand': (not cell) or (not . cell) -> cell." 818 (require 'ibuf-ext) 819 (should (equal (ibuffer-unary-operand '(not . (mode "foo"))) 820 '(mode "foo"))) 821 (should (equal (ibuffer-unary-operand '(not (mode "foo"))) 822 '(mode "foo"))) 823 (should (equal (ibuffer-unary-operand '(not "cdr")) 824 '("cdr"))) 825 (should (equal (ibuffer-unary-operand '(not)) nil)) 826 (should (equal (ibuffer-unary-operand '(not . a)) 'a))) 827 828(provide 'ibuffer-tests) 829;; ibuffer-tests.el ends here 830