test/lisp/ibuffer-tests.el

   1 ;;; ibuffer-tests.el --- Test suite. -*- lexical-binding: t -*-
   2
   3 ;; Copyright (C) 2015-2018 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 (with-current-buffer bufA default-directory))
 316                (dirB (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