test/lisp/ibuffer-tests.el

   1 ;;; ibuffer-tests.el --- Test suite. -*- lexical-binding: t -*-
   2
   3 ;; Copyright (C) 2015-2017 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 <http://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-autoload ()
  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 http://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 http://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   (skip-unless (featurep '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 http://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 http://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        ;; Utility functions without polluting the environment
 154        (set-buffer-mode
 155         (lambda (buffer mode)
 156           "Set BUFFER's major mode to MODE, a mode function, or fundamental."
 157           (with-current-buffer buffer
 158             (funcall (or mode #'fundamental-mode)))))
 159        (set-buffer-contents
 160         (lambda (buffer size include-content)
 161           "Add exactly SIZE bytes to BUFFER, including INCLUDE-CONTENT."
 162           (when (or size include-content)
 163             (let* ((unit "\n")
 164                    (chunk "ccccccccccccccccccccccccccccccc\n")
 165                    (chunk-size (length chunk))
 166                    (size (if (and size include-content (stringp include-content))
 167                              (- size (length include-content))
 168                            size)))
 169               (unless (or (null size) (> size 0))
 170                 (error "size argument must be nil or positive"))
 171               (with-current-buffer buffer
 172                 (when include-content
 173                   (insert include-content))
 174                 (when size
 175                   (dotimes (_ (floor size chunk-size))
 176                     (insert chunk))
 177                   (dotimes (_ (mod size chunk-size))
 178                     (insert unit)))
 179                 ;; prevent query on cleanup
 180                 (set-buffer-modified-p nil))))))
 181        (create-file-buffer
 182         (lambda (prefix &rest args-plist)
 183           "Create a file and buffer with designated properties.
 184         PREFIX is a string giving the beginning of the name, and ARGS-PLIST
 185         is a series of keyword-value pairs, with allowed keywords
 186         :suffix STRING, :size NUMBER, :mode MODE-FUNC, :include-content STRING.
 187         Returns the created buffer."
 188           (let* ((suffix  (plist-get args-plist :suffix))
 189                  (size    (plist-get args-plist :size))
 190                  (include (plist-get args-plist :include-content))
 191                  (mode    (plist-get args-plist :mode))
 192                  (file    (make-temp-file prefix nil suffix))
 193                  (buf     (find-file-noselect file t)))
 194             (push buf test-buffer-list) ; record for cleanup
 195             (funcall set-buffer-mode buf mode)
 196             (funcall set-buffer-contents buf size include)
 197             buf)))
 198        (create-non-file-buffer
 199         (lambda (prefix &rest args-plist)
 200           "Create a non-file and buffer with designated properties.
 201         PREFIX is a string giving the beginning of the name, and ARGS-PLIST
 202         is a series of keyword-value pairs, with allowed keywords
 203         :size NUMBER, :mode MODE-FUNC, :include-content STRING.
 204         Returns the created buffer."
 205           (let* ((size    (plist-get args-plist :size))
 206                  (include (plist-get args-plist :include-content))
 207                  (mode    (plist-get args-plist :mode))
 208                  (buf     (generate-new-buffer prefix)))
 209             (push buf test-buffer-list) ; record for cleanup
 210             (funcall set-buffer-mode buf mode)
 211             (funcall set-buffer-contents buf size include)
 212             buf)))
 213        (clean-up
 214         (lambda ()
 215           "Restore all emacs state modified during the tests"
 216           (while test-buffer-list       ; created temporary buffers
 217             (let ((buf (pop test-buffer-list)))
 218               (with-current-buffer buf (bury-buffer)) ; ensure not selected
 219               (kill-buffer buf))))))
 220   ;; Tests
 221   (ert-deftest ibuffer-filter-inclusion-1 ()
 222     "Tests inclusion using basic filter combinators with a single buffer."
 223     (skip-unless (featurep 'ibuf-ext))
 224     (unwind-protect
 225         (let ((buf
 226                (funcall create-file-buffer "ibuf-test-1" :size 100
 227                         :include-content "One ring to rule them all\n")))
 228           (should (ibuffer-included-in-filters-p buf '((size-gt . 99))))
 229           (should (ibuffer-included-in-filters-p buf '((size-lt . 101))))
 230           (should (ibuffer-included-in-filters-p
 231                    buf '((mode . fundamental-mode))))
 232           (should (ibuffer-included-in-filters-p
 233                    buf '((content . "ring to rule them all"))))
 234           (should (ibuffer-included-in-filters-p
 235                    buf '((and (content . "ring to rule them all")))))
 236           (should (ibuffer-included-in-filters-p
 237                    buf '((and (and (content . "ring to rule them all"))))))
 238           (should (ibuffer-included-in-filters-p
 239                    buf '((and (and (and (content . "ring to rule them all")))))))
 240           (should (ibuffer-included-in-filters-p
 241                    buf '((or (content . "ring to rule them all")))))
 242           (should (ibuffer-included-in-filters-p
 243                    buf '((not (not (content . "ring to rule them all"))))))
 244           (should (ibuffer-included-in-filters-p
 245                    buf '((and (size-gt . 99)
 246                               (content . "ring to rule them all")
 247                               (mode . fundamental-mode)
 248                               (basename . "\\`ibuf-test-1")))))
 249           (should (ibuffer-included-in-filters-p
 250                    buf '((not (or (not (size-gt . 99))
 251                                   (not (content . "ring to rule them all"))
 252                                   (not (mode . fundamental-mode))
 253                                   (not (basename . "\\`ibuf-test-1")))))))
 254           (should (ibuffer-included-in-filters-p
 255                    buf '((and (or (size-gt . 99) (size-lt . 10))
 256                               (and (content . "ring.*all")
 257                                    (content . "rule")
 258                                    (content . "them all")
 259                                    (content . "One"))
 260                               (not (mode . text-mode))
 261                               (basename . "\\`ibuf-test-1"))))))
 262       (funcall clean-up)))
 263
 264   (ert-deftest ibuffer-filter-inclusion-2 ()
 265     "Tests inclusion of basic filters in combination on a single buffer."
 266     (skip-unless (featurep 'ibuf-ext))
 267     (unwind-protect
 268         (let ((buf
 269                (funcall create-file-buffer "ibuf-test-2" :size 200
 270                         :mode #'text-mode
 271                         :include-content "and in the darkness find them\n")))
 272           (should (ibuffer-included-in-filters-p buf '((size-gt . 199))))
 273           (should (ibuffer-included-in-filters-p buf '((size-lt . 201))))
 274           (should (ibuffer-included-in-filters-p buf '((not size-gt . 200))))
 275           (should (ibuffer-included-in-filters-p buf '((not (size-gt . 200)))))
 276           (should (ibuffer-included-in-filters-p
 277                    buf '((and (size-gt . 199) (size-lt . 201)))))
 278           (should (ibuffer-included-in-filters-p
 279                    buf '((or (size-gt . 199) (size-gt . 201)))))
 280           (should (ibuffer-included-in-filters-p
 281                    buf '((or (size-gt . 201) (size-gt . 199)))))
 282           (should (ibuffer-included-in-filters-p
 283                    buf '((size-gt . 199) (mode . text-mode)
 284                          (content . "darkness find them"))))
 285           (should (ibuffer-included-in-filters-p
 286                    buf '((and (size-gt . 199) (mode . text-mode)
 287                               (content . "darkness find them")))))
 288           (should (ibuffer-included-in-filters-p
 289                    buf '((not (or (not (size-gt . 199)) (not (mode . text-mode))
 290                                   (not (content . "darkness find them")))))))
 291           (should (ibuffer-included-in-filters-p
 292                    buf '((or (size-gt . 200) (content . "darkness find them")
 293                              (derived-mode . emacs-lisp-mode)))))
 294           (should-not (ibuffer-included-in-filters-p
 295                        buf '((or (size-gt . 200) (content . "rule them all")
 296                                  (derived-mode . emacs-lisp-mode))))))
 297       (funcall clean-up)))
 298
 299   (ert-deftest ibuffer-filter-inclusion-3 ()
 300     "Tests inclusion with filename filters on specified buffers."
 301     (skip-unless (featurep 'ibuf-ext))
 302     (unwind-protect
 303         (let* ((bufA
 304                 (funcall create-file-buffer "ibuf-test-3.a" :size 50
 305                          :mode #'text-mode
 306                          :include-content "...but a multitude of drops?\n"))
 307                (bufB
 308                 (funcall create-non-file-buffer "ibuf-test-3.b" :size 50
 309                          :mode #'text-mode
 310                          :include-content "...but a multitude of drops?\n"))
 311                (dirA (with-current-buffer bufA default-directory))
 312                (dirB (with-current-buffer bufB default-directory)))
 313           (should (ibuffer-included-in-filters-p
 314                    bufA '((basename . "ibuf-test-3"))))
 315           (should (ibuffer-included-in-filters-p
 316                    bufA '((basename . "test-3\\.a"))))
 317           (should (ibuffer-included-in-filters-p
 318                    bufA '((file-extension . "a"))))
 319           (should (ibuffer-included-in-filters-p
 320                    bufA (list (cons 'directory dirA))))
 321           (should-not (ibuffer-included-in-filters-p
 322                        bufB '((basename . "ibuf-test-3"))))
 323           (should-not (ibuffer-included-in-filters-p
 324                        bufB '((file-extension . "b"))))
 325           (should (ibuffer-included-in-filters-p
 326                    bufB (list (cons 'directory dirB))))
 327           (should (ibuffer-included-in-filters-p
 328                    bufA '((name . "ibuf-test-3"))))
 329           (should (ibuffer-included-in-filters-p
 330                    bufB '((name . "ibuf-test-3")))))
 331       (funcall clean-up)))
 332
 333   (ert-deftest ibuffer-filter-inclusion-4 ()
 334     "Tests inclusion with various filters on a single buffer."
 335     (skip-unless (featurep 'ibuf-ext))
 336     (unwind-protect
 337         (let ((buf
 338                (funcall create-file-buffer "ibuf-test-4"
 339                         :mode #'emacs-lisp-mode :suffix ".el"
 340                         :include-content "(message \"--%s--\" 'emacs-rocks)\n")))
 341           (should (ibuffer-included-in-filters-p
 342                    buf '((file-extension . "el"))))
 343           (should (ibuffer-included-in-filters-p
 344                    buf '((derived-mode . prog-mode))))
 345           (should (ibuffer-included-in-filters-p
 346                    buf '((used-mode . emacs-lisp-mode))))
 347           (should (ibuffer-included-in-filters-p
 348                    buf '((mode . emacs-lisp-mode))))
 349           (with-current-buffer buf (set-buffer-modified-p t))
 350           (should (ibuffer-included-in-filters-p buf '((modified))))
 351           (with-current-buffer buf (set-buffer-modified-p nil))
 352           (should (ibuffer-included-in-filters-p buf '((not modified))))
 353           (should (ibuffer-included-in-filters-p
 354                    buf '((and (file-extension . "el")
 355                               (derived-mode . prog-mode)
 356                               (not modified)))))
 357           (should (ibuffer-included-in-filters-p
 358                    buf '((or (file-extension . "tex")
 359                              (derived-mode . prog-mode)
 360                              (modified)))))
 361           (should (ibuffer-included-in-filters-p
 362                    buf '((file-extension . "el")
 363                          (derived-mode . prog-mode)
 364                          (not modified)))))
 365       (funcall clean-up)))
 366
 367   (ert-deftest ibuffer-filter-inclusion-5 ()
 368     "Tests inclusion with various filters on a single buffer."
 369     (skip-unless (featurep 'ibuf-ext))
 370     (unwind-protect
 371         (let ((buf
 372                (funcall create-non-file-buffer "ibuf-test-5.el"
 373                         :mode #'emacs-lisp-mode
 374                         :include-content
 375                         "(message \"--%s--\" \"It really does!\")\n")))
 376           (should-not (ibuffer-included-in-filters-p
 377                        buf '((file-extension . "el"))))
 378           (should (ibuffer-included-in-filters-p
 379                    buf '((size-gt . 18))))
 380           (should (ibuffer-included-in-filters-p
 381                    buf '((predicate . (lambda ()
 382                                         (> (- (point-max) (point-min)) 18))))))
 383           (should (ibuffer-included-in-filters-p
 384                    buf '((and (mode . emacs-lisp-mode)
 385                               (or (starred-name)
 386                                   (size-gt . 18))
 387                               (and (not (size-gt . 100))
 388                                    (content . "[Ii]t  *really does!")
 389                                    (or (name . "test-5")
 390                                        (not (filename . "test-5")))))))))
 391       (funcall clean-up)))
 392
 393   (ert-deftest ibuffer-filter-inclusion-6 ()
 394     "Tests inclusion using saved filters and DeMorgan's laws."
 395     (skip-unless (featurep 'ibuf-ext))
 396     (unwind-protect
 397         (let ((buf
 398                (funcall create-non-file-buffer "*ibuf-test-6*" :size 65
 399                         :mode #'text-mode))
 400               (buf2
 401                (funcall create-file-buffer "ibuf-test-6a" :suffix ".html"
 402                         :mode #'html-mode
 403                         :include-content
 404                         "<HTML><BODY><H1>Hello, World!</H1></BODY></HTML>")))
 405           (should (ibuffer-included-in-filters-p buf '((starred-name))))
 406           (should-not (ibuffer-included-in-filters-p
 407                        buf '((saved . "text document"))))
 408           (should (ibuffer-included-in-filters-p buf2 '((saved . "web"))))
 409           (should (ibuffer-included-in-filters-p
 410                    buf2 '((not (and (not (derived-mode . sgml-mode))
 411                                     (not (derived-mode . css-mode))
 412                                     (not (mode         . javascript-mode))
 413                                     (not (mode         . js2-mode))
 414                                     (not (mode         . scss-mode))
 415                                     (not (derived-mode . haml-mode))
 416                                     (not (mode         . sass-mode)))))))
 417           (should (ibuffer-included-in-filters-p
 418                    buf '((and (starred-name)
 419                               (or (size-gt . 50) (filename . "foo"))))))
 420           (should (ibuffer-included-in-filters-p
 421                    buf '((not (or (not starred-name)
 422                                   (and (size-lt . 51)
 423                                        (not (filename . "foo")))))))))
 424       (funcall clean-up)))
 425
 426   (ert-deftest ibuffer-filter-inclusion-7 ()
 427     "Tests inclusion with various filters on a single buffer."
 428     (skip-unless (featurep 'ibuf-ext))
 429     (unwind-protect
 430         (let ((buf
 431                (funcall create-non-file-buffer "ibuf-test-7"
 432                         :mode #'artist-mode)))
 433           (should (ibuffer-included-in-filters-p
 434                    buf '((not (starred-name)))))
 435           (should (ibuffer-included-in-filters-p
 436                    buf '((not starred-name))))
 437           (should (ibuffer-included-in-filters-p
 438                    buf '((not (not (not starred-name))))))
 439           (should (ibuffer-included-in-filters-p
 440                    buf '((not (modified)))))
 441           (should (ibuffer-included-in-filters-p
 442                    buf '((not modified))))
 443           (should (ibuffer-included-in-filters-p
 444                    buf '((not (not (not modified)))))))
 445       (funcall clean-up)))
 446
 447   (ert-deftest ibuffer-filter-inclusion-8 ()
 448     "Tests inclusion with various filters."
 449     (skip-unless (featurep 'ibuf-ext))
 450     (unwind-protect
 451         (let ((bufA
 452                (funcall create-non-file-buffer "ibuf-test-8a"
 453                         :mode #'artist-mode))
 454               (bufB (funcall create-non-file-buffer "*ibuf-test-8b*" :size 32))
 455               (bufC (funcall create-file-buffer "ibuf-test8c" :suffix "*"
 456                              :size 64))
 457               (bufD (funcall create-file-buffer "*ibuf-test8d" :size 128))
 458               (bufE (funcall create-file-buffer "*ibuf-test8e" :suffix "*<2>"
 459                              :size 16))
 460               (bufF (and (funcall create-non-file-buffer "*ibuf-test8f*")
 461                          (funcall create-non-file-buffer "*ibuf-test8f*"
 462                                   :size 8))))
 463           (with-current-buffer bufA (set-buffer-modified-p t))
 464           (should (ibuffer-included-in-filters-p
 465                    bufA '((and (not starred-name)
 466                                (modified)
 467                                (name . "test-8")
 468                                (not (size-gt . 100))
 469                                (mode . picture-mode)))))
 470           (with-current-buffer bufA (set-buffer-modified-p nil))
 471           (should-not (ibuffer-included-in-filters-p
 472                        bufA '((or (starred-name) (visiting-file) (modified)))))
 473           (should (ibuffer-included-in-filters-p
 474                    bufB '((and (starred-name)
 475                                (name . "test.*8b")
 476                                (size-gt . 31)
 477                                (not visiting-file)))))
 478           (should (ibuffer-included-in-filters-p
 479                    bufC '((and (not (starred-name))
 480                                (visiting-file)
 481                                (name . "8c[^*]*\\*")
 482                                (size-lt . 65)))))
 483           (should (ibuffer-included-in-filters-p
 484                    bufD '((and (not (starred-name))
 485                                (visiting-file)
 486                                (name . "\\`\\*.*test8d")
 487                                (size-lt . 129)
 488                                (size-gt . 127)))))
 489           (should (ibuffer-included-in-filters-p
 490                    bufE '((and (starred-name)
 491                                (visiting-file)
 492                                (name . "8e.*?\\*<[[:digit:]]+>")
 493                                (size-gt . 10)))))
 494           (should (ibuffer-included-in-filters-p
 495                    bufF '((and (starred-name)
 496                                (not (visiting-file))
 497                                (name . "8f\\*<[[:digit:]]>")
 498                                (size-lt . 10))))))
 499       (funcall clean-up))))
 500
 501 ;; Test Filter Combination and Decomposition
 502 (let* (ibuffer-to-kill       ; if non-nil, kill this buffer at cleanup
 503        (ibuffer-already 'check) ; existing ibuffer buffer to use but not kill
 504        ;; Utility functions without polluting the environment
 505        (get-test-ibuffer
 506         (lambda ()
 507           "Returns a test ibuffer-mode buffer, creating one if necessary.
 508         If a new buffer is created, it is named  \"*Test-Ibuffer*\" and is
 509         saved to `ibuffer-to-kill' for later cleanup."
 510           (when (eq ibuffer-already 'check)
 511             (setq ibuffer-already
 512                   (catch 'found-buf
 513                     (dolist (buf (buffer-list) nil)
 514                       (when (with-current-buffer buf
 515                               (derived-mode-p 'ibuffer-mode))
 516                         (throw 'found-buf buf))))))
 517           (or ibuffer-already
 518               ibuffer-to-kill
 519               (let ((test-ibuf-name "*Test-Ibuffer*"))
 520                 (ibuffer nil test-ibuf-name nil t)
 521                 (setq ibuffer-to-kill (get-buffer test-ibuf-name))))))
 522        (clean-up
 523         (lambda ()
 524           "Restore all emacs state modified during the tests"
 525           (when ibuffer-to-kill         ; created ibuffer
 526             (with-current-buffer ibuffer-to-kill
 527               (set-buffer-modified-p nil)
 528               (bury-buffer))
 529             (kill-buffer ibuffer-to-kill)
 530             (setq ibuffer-to-kill nil))
 531           (when (and ibuffer-already (not (eq ibuffer-already 'check)))
 532             ;; restore existing ibuffer state
 533             (ibuffer-update nil t)))))
 534   ;; Tests
 535   (ert-deftest ibuffer-decompose-filter ()
 536     "Tests `ibuffer-decompose-filter' for and, or, not, and saved."
 537     (skip-unless (featurep 'ibuf-ext))
 538     (unwind-protect
 539         (let ((ibuf (funcall get-test-ibuffer)))
 540           (with-current-buffer ibuf
 541             (let ((ibuffer-filtering-qualifiers nil)
 542                   (ibuffer-filter-groups nil)
 543                   (filters '((size-gt . 100) (not (starred-name))
 544                              (name . "foo"))))
 545               (progn
 546                 (push (cons 'or filters) ibuffer-filtering-qualifiers)
 547                 (ibuffer-decompose-filter)
 548                 (should (equal filters ibuffer-filtering-qualifiers))
 549                 (setq ibuffer-filtering-qualifiers nil))
 550               (progn
 551                 (push (cons 'and filters) ibuffer-filtering-qualifiers)
 552                 (ibuffer-decompose-filter)
 553                 (should (equal filters ibuffer-filtering-qualifiers))
 554                 (setq ibuffer-filtering-qualifiers nil))
 555               (progn
 556                 (push (list 'not (car filters)) ibuffer-filtering-qualifiers)
 557                 (ibuffer-decompose-filter)
 558                 (should (equal (list (car filters))
 559                                ibuffer-filtering-qualifiers))
 560                 (setq ibuffer-filtering-qualifiers nil))
 561               (progn
 562                 (push (cons 'not (car filters)) ibuffer-filtering-qualifiers)
 563                 (ibuffer-decompose-filter)
 564                 (should (equal (list (car filters))
 565                                ibuffer-filtering-qualifiers))
 566                 (setq ibuffer-filtering-qualifiers nil))
 567               (let ((gnus (assoc "gnus" ibuffer-saved-filters)))
 568                 (push '(saved . "gnus") ibuffer-filtering-qualifiers)
 569                 (ibuffer-decompose-filter)
 570                 (should (equal (cdr gnus) ibuffer-filtering-qualifiers))
 571                 (ibuffer-decompose-filter)
 572                 (should (equal (cdr (cadr gnus)) ibuffer-filtering-qualifiers))
 573                 (setq ibuffer-filtering-qualifiers nil))
 574               (when (not (assoc "__unknown__" ibuffer-saved-filters))
 575                 (push '(saved . "__uknown__") ibuffer-filtering-qualifiers)
 576                 (should-error (ibuffer-decompose-filter) :type 'error)
 577                 (setq ibuffer-filtering-qualifiers nil))
 578               (progn
 579                 (push (car filters) ibuffer-filtering-qualifiers)
 580                 (should-error (ibuffer-decompose-filter) :type 'error)
 581                 (setq ibuffer-filtering-qualifiers nil)))))
 582       (funcall clean-up)))
 583
 584   (ert-deftest ibuffer-and-filter ()
 585     "Tests `ibuffer-and-filter' in an Ibuffer buffer."
 586     (skip-unless (featurep 'ibuf-ext))
 587     (unwind-protect
 588         (let ((ibuf (funcall get-test-ibuffer)))
 589           (with-current-buffer ibuf
 590             (let ((ibuffer-filtering-qualifiers nil)
 591                   (ibuffer-filter-groups nil)
 592                   (filters [(size-gt . 100) (not (starred-name))
 593                             (filename . "A") (mode . text-mode)]))
 594               (should-error (ibuffer-and-filter) :type 'error)
 595               (progn
 596                 (push (aref filters 1) ibuffer-filtering-qualifiers)
 597                 (should-error (ibuffer-and-filter) :type 'error))
 598               (should (progn
 599                         (push (aref filters 0) ibuffer-filtering-qualifiers)
 600                         (ibuffer-and-filter)
 601                         (and (equal (list 'and (aref filters 0) (aref filters 1))
 602                                     (car ibuffer-filtering-qualifiers))
 603                              (null (cdr ibuffer-filtering-qualifiers)))))
 604               (should (progn
 605                         (ibuffer-and-filter 'decompose)
 606                         (and (equal (aref filters 0)
 607                                     (pop ibuffer-filtering-qualifiers))
 608                              (equal (aref filters 1)
 609                                     (pop ibuffer-filtering-qualifiers))
 610                              (null ibuffer-filtering-qualifiers))))
 611               (should (progn
 612                         (push (list 'and (aref filters 2) (aref filters 3))
 613                               ibuffer-filtering-qualifiers)
 614                         (push (list 'and (aref filters 0) (aref filters 1))
 615                               ibuffer-filtering-qualifiers)
 616                         (ibuffer-and-filter)
 617                         (and (equal (list 'and (aref filters 0) (aref filters 1)
 618                                           (aref filters 2) (aref filters 3))
 619                                     (car ibuffer-filtering-qualifiers))
 620                              (null (cdr ibuffer-filtering-qualifiers)))))
 621               (pop ibuffer-filtering-qualifiers)
 622               (should (progn
 623                         (push (list 'or (aref filters 2) (aref filters 3))
 624                               ibuffer-filtering-qualifiers)
 625                         (push (list 'and (aref filters 0) (aref filters 1))
 626                               ibuffer-filtering-qualifiers)
 627                         (ibuffer-and-filter)
 628                         (and (equal (list 'and (aref filters 0) (aref filters 1)
 629                                           (list 'or (aref filters 2)
 630                                                 (aref filters 3)))
 631                                     (car ibuffer-filtering-qualifiers))
 632                              (null (cdr ibuffer-filtering-qualifiers)))))
 633               (pop ibuffer-filtering-qualifiers)
 634               (should (progn
 635                         (push (list 'and (aref filters 2) (aref filters 3))
 636                               ibuffer-filtering-qualifiers)
 637                         (push (list 'or (aref filters 0) (aref filters 1))
 638                               ibuffer-filtering-qualifiers)
 639                         (ibuffer-and-filter)
 640                         (and (equal (list 'and (list 'or (aref filters 0)
 641                                                     (aref filters 1))
 642                                           (aref filters 2) (aref filters 3))
 643                                     (car ibuffer-filtering-qualifiers))
 644                              (null (cdr ibuffer-filtering-qualifiers)))))
 645               (pop ibuffer-filtering-qualifiers)
 646               (should (progn
 647                         (push (list 'or (aref filters 2) (aref filters 3))
 648                               ibuffer-filtering-qualifiers)
 649                         (push (list 'or (aref filters 0) (aref filters 1))
 650                               ibuffer-filtering-qualifiers)
 651                         (ibuffer-and-filter)
 652                         (and (equal (list 'and
 653                                           (list 'or (aref filters 0)
 654                                                 (aref filters 1))
 655                                           (list 'or (aref filters 2)
 656                                                 (aref filters 3)))
 657                                     (car ibuffer-filtering-qualifiers))
 658                              (null (cdr ibuffer-filtering-qualifiers))))))))
 659       (funcall clean-up)))
 660
 661   (ert-deftest ibuffer-or-filter ()
 662     "Tests `ibuffer-or-filter' in an Ibuffer buffer."
 663     (skip-unless (featurep 'ibuf-ext))
 664     (unwind-protect
 665         (let ((ibuf (funcall get-test-ibuffer)))
 666           (with-current-buffer ibuf
 667             (let ((ibuffer-filtering-qualifiers nil)
 668                   (ibuffer-filter-groups nil)
 669                   (filters [(size-gt . 100) (not (starred-name))
 670                             (filename . "A") (mode . text-mode)]))
 671               (should-error (ibuffer-or-filter) :type 'error)
 672               (progn
 673                 (push (aref filters 1) ibuffer-filtering-qualifiers)
 674                 (should-error (ibuffer-or-filter) :type 'error))
 675               (should (progn
 676                         (push (aref filters 0) ibuffer-filtering-qualifiers)
 677                         (ibuffer-or-filter)
 678                         (and (equal (list 'or (aref filters 0) (aref filters 1))
 679                                     (car ibuffer-filtering-qualifiers))
 680                              (null (cdr ibuffer-filtering-qualifiers)))))
 681               (should (progn
 682                         (ibuffer-or-filter 'decompose)
 683                         (and (equal (aref filters 0)
 684                                     (pop ibuffer-filtering-qualifiers))
 685                              (equal (aref filters 1)
 686                                     (pop ibuffer-filtering-qualifiers))
 687                              (null ibuffer-filtering-qualifiers))))
 688               (should (progn
 689                         (push (list 'or (aref filters 2) (aref filters 3))
 690                               ibuffer-filtering-qualifiers)
 691                         (push (list 'or (aref filters 0) (aref filters 1))
 692                               ibuffer-filtering-qualifiers)
 693                         (ibuffer-or-filter)
 694                         (and (equal (list 'or (aref filters 0) (aref filters 1)
 695                                           (aref filters 2) (aref filters 3))
 696                                     (car ibuffer-filtering-qualifiers))
 697                              (null (cdr ibuffer-filtering-qualifiers)))))
 698               (pop ibuffer-filtering-qualifiers)
 699               (should (progn
 700                         (push (list 'and (aref filters 2) (aref filters 3))
 701                               ibuffer-filtering-qualifiers)
 702                         (push (list 'or (aref filters 0) (aref filters 1))
 703                               ibuffer-filtering-qualifiers)
 704                         (ibuffer-or-filter)
 705                         (and (equal (list 'or (aref filters 0) (aref filters 1)
 706                                           (list 'and (aref filters 2)
 707                                                 (aref filters 3)))
 708                                     (car ibuffer-filtering-qualifiers))
 709                              (null (cdr ibuffer-filtering-qualifiers)))))
 710               (pop ibuffer-filtering-qualifiers)
 711               (should (progn
 712                         (push (list 'or (aref filters 2) (aref filters 3))
 713                               ibuffer-filtering-qualifiers)
 714                         (push (list 'and (aref filters 0) (aref filters 1))
 715                               ibuffer-filtering-qualifiers)
 716                         (ibuffer-or-filter)
 717                         (and (equal (list 'or (list 'and (aref filters 0)
 718                                                     (aref filters 1))
 719                                           (aref filters 2) (aref filters 3))
 720                                     (car ibuffer-filtering-qualifiers))
 721                              (null (cdr ibuffer-filtering-qualifiers)))))
 722               (pop ibuffer-filtering-qualifiers)
 723               (should (progn
 724                         (push (list 'and (aref filters 2) (aref filters 3))
 725                               ibuffer-filtering-qualifiers)
 726                         (push (list 'and (aref filters 0) (aref filters 1))
 727                               ibuffer-filtering-qualifiers)
 728                         (ibuffer-or-filter)
 729                         (and (equal (list 'or
 730                                           (list 'and (aref filters 0)
 731                                                 (aref filters 1))
 732                                           (list 'and (aref filters 2)
 733                                                 (aref filters 3)))
 734                                     (car ibuffer-filtering-qualifiers))
 735                              (null (cdr ibuffer-filtering-qualifiers))))))))
 736       (funcall clean-up))))
 737
 738 (ert-deftest ibuffer-format-qualifier ()
 739   "Tests string recommendation of filter from `ibuffer-format-qualifier'."
 740   (skip-unless (featurep 'ibuf-ext))
 741   (let ((test1 '(mode . org-mode))
 742         (test2 '(size-lt . 100))
 743         (test3 '(derived-mode . prog-mode))
 744         (test4 '(or (size-gt . 10000)
 745                     (and (not (starred-name))
 746                          (directory . "\\<org\\>"))))
 747         (test5 '(or (filename . "scratch")
 748                     (filename . "bonz")
 749                     (filename . "temp")))
 750         (test6 '(or (mode . emacs-lisp-mode) (file-extension . "elc?")
 751                     (and (starred-name) (name . "elisp"))
 752                     (mode . lisp-interaction-mode)))
 753         (description (lambda (q)
 754                        (cadr (assq q ibuffer-filtering-alist))))
 755         (tag (lambda (&rest args )
 756                (concat " [" (apply #'concat args) "]"))))
 757     (should (equal (ibuffer-format-qualifier test1)
 758                    (funcall tag (funcall description 'mode)
 759                             ": " "org-mode")))
 760     (should (equal (ibuffer-format-qualifier test2)
 761                    (funcall tag (funcall description 'size-lt)
 762                             ": " "100")))
 763     (should (equal (ibuffer-format-qualifier test3)
 764                    (funcall tag (funcall description 'derived-mode)
 765                             ": " "prog-mode")))
 766     (should (equal (ibuffer-format-qualifier test4)
 767                    (funcall tag "OR"
 768                             (funcall tag (funcall description 'size-gt)
 769                                      ": " (format "%s" 10000))
 770                             (funcall tag "AND"
 771                                      (funcall tag "NOT"
 772                                               (funcall tag
 773                                                        (funcall description
 774                                                                 'starred-name)
 775                                                        ": " "nil"))
 776                                      (funcall tag
 777                                               (funcall description 'directory)
 778                                               ": " "\\<org\\>")))))
 779     (should (equal (ibuffer-format-qualifier test5)
 780                    (funcall tag "OR"
 781                             (funcall tag (funcall description 'filename)
 782                                      ": "  "scratch")
 783                             (funcall tag (funcall description 'filename)
 784                                      ": " "bonz")
 785                             (funcall tag (funcall description 'filename)
 786                                      ": " "temp"))))
 787     (should (equal (ibuffer-format-qualifier test6)
 788                    (funcall tag "OR"
 789                             (funcall tag (funcall description 'mode)
 790                                      ": " "emacs-lisp-mode")
 791                             (funcall tag (funcall description 'file-extension)
 792                                      ": " "elc?")
 793                             (funcall tag "AND"
 794                                      (funcall tag
 795                                               (funcall description 'starred-name)
 796                                               ": " "nil")
 797                                      (funcall tag
 798                                               (funcall description 'name)
 799                                               ": " "elisp"))
 800                             (funcall tag (funcall description 'mode)
 801                                      ": " "lisp-interaction-mode"))))))
 802
 803 (ert-deftest ibuffer-unary-operand ()
 804   "Tests `ibuffer-unary-operand': (not cell) or (not . cell) -> cell."
 805   (skip-unless (featurep 'ibuf-ext))
 806   (should (equal (ibuffer-unary-operand '(not . (mode "foo")))
 807                  '(mode "foo")))
 808   (should (equal (ibuffer-unary-operand '(not (mode "foo")))
 809                  '(mode "foo")))
 810   (should (equal (ibuffer-unary-operand '(not "cdr"))
 811                  '("cdr")))
 812   (should (equal (ibuffer-unary-operand '(not)) nil))
 813   (should (equal (ibuffer-unary-operand '(not . a)) 'a)))
 814
 815 (provide 'ibuffer-tests)
 816 ;; ibuffer-tests.el ends here