test/occur-testsuite.el

   1 ;;; occur-testsuite.el --- Test suite for occur.
   2
   3 ;; Copyright (C) 2010  Free Software Foundation, Inc.
   4
   5 ;; Author: Juri Linkov <juri@jurta.org>
   6 ;; Keywords: matching, internal
   7
   8 ;; This file is part of GNU Emacs.
   9
  10 ;; GNU Emacs is free software: you can redistribute it and/or modify
  11 ;; it under the terms of the GNU General Public License as published by
  12 ;; the Free Software Foundation, either version 3 of the License, or
  13 ;; (at your option) any later version.
  14
  15 ;; GNU Emacs is distributed in the hope that it will be useful,
  16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18 ;; GNU General Public License for more details.
  19
  20 ;; You should have received a copy of the GNU General Public License
  21 ;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
  22
  23 ;;; Commentary:
  24
  25 ;; Type M-x test-occur RET to test the functionality of `occur'.
  26
  27 ;;; Code:
  28
  29 (defconst occur-tests
  30   '(
  31     ;; * Test one-line matches (at bob, eob, bol, eol).
  32     ("x" 0 "\
  33 xa
  34 b
  35 cx
  36 xd
  37 xex
  38 fx
  39 " "\
  40 5 matches for \"x\" in buffer:  *temp*
  41       1:xa
  42       3:cx
  43       4:xd
  44       5:xex
  45       6:fx
  46 ")
  47     ;; * Test multi-line matches, this is the first test from
  48     ;; http://lists.gnu.org/archive/html/emacs-devel/2005-06/msg01008.html
  49     ;; where numbers are replaced with letters.
  50     ("a\na" 0 "\
  51 a
  52 a
  53 a
  54 a
  55 a
  56 " "\
  57 2 matches for \"a^Ja\" in buffer:  *temp*
  58       1:a
  59        :a
  60       3:a
  61        :a
  62 ")
  63     ;; * Test multi-line matches, this is the second test from
  64     ;; http://lists.gnu.org/archive/html/emacs-devel/2005-06/msg01008.html
  65     ;; where numbers are replaced with letters.
  66     ("a\nb" 0 "\
  67 a
  68 b
  69 c
  70 a
  71 b
  72 " "\
  73 2 matches for \"a^Jb\" in buffer:  *temp*
  74       1:a
  75        :b
  76       4:a
  77        :b
  78 ")
  79     ;; * Test line numbers for multi-line matches with empty last match line.
  80     ("a\n" 0 "\
  81 a
  82
  83 c
  84 a
  85
  86 " "\
  87 2 matches for \"a^J\" in buffer:  *temp*
  88       1:a
  89        :
  90       4:a
  91        :
  92 ")
  93     ;; * Test multi-line matches with 3 match lines.
  94     ("x\n.x\n" 0 "\
  95 ax
  96 bx
  97 c
  98 d
  99 ex
 100 fx
 101 " "\
 102 2 matches for \"x^J.x^J\" in buffer:  *temp*
 103       1:ax
 104        :bx
 105        :c
 106       5:ex
 107        :fx
 108        :
 109 ")
 110     )
 111   "List of tests for `occur'.
 112 Each element has the format:
 113 \(REGEXP NLINES INPUT-BUFFER-STRING OUTPUT-BUFFER-STRING).")
 114
 115 (defun test-occur ()
 116   (interactive)
 117   (let ((count 1)
 118         failed
 119         (occur-hook nil))
 120     (dolist (test occur-tests)
 121       (let ((regexp (nth 0 test))
 122             (nlines (nth 1 test))
 123             (input-buffer-string (nth 2 test))
 124             (output-buffer-string (nth 3 test)))
 125         (save-excursion
 126           (with-temp-buffer
 127             (insert input-buffer-string)
 128             (occur regexp nlines)
 129             (unless (equal output-buffer-string
 130                            (with-current-buffer "*Occur*"
 131                              (buffer-string)))
 132               (setq failed (cons count failed))))))
 133       (setq count (1+ count)))
 134     (if failed
 135         (message "FAILED TESTS: %S" (reverse failed))
 136       (message "SUCCESS"))))
 137
 138 (provide 'occur-testsuite)
 139
 140 ;;; occur-testsuite.el ends here