code.delx.au - gnu-emacs/blob - test/occur-testsuite.el

   1 ;;; occur-testsuite.el --- Test suite for occur.
   2
   3 ;; Copyright (C) 2010-2011  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     ;; * Test non-overlapping context lines with matches at bob/eob.
 111     ("x" 1 "\
 112 ax
 113 b
 114 c
 115 d
 116 ex
 117 f
 118 g
 119 hx
 120 " "\
 121 3 matches for \"x\" in buffer:  *temp*
 122       1:ax
 123        :b
 124 -------
 125        :d
 126       5:ex
 127        :f
 128 -------
 129        :g
 130       8:hx
 131 ")
 132     ;; * Test non-overlapping context lines with matches not at bob/eob.
 133     ("x" 1 "\
 134 a
 135 bx
 136 c
 137 d
 138 ex
 139 f
 140 " "\
 141 2 matches for \"x\" in buffer:  *temp*
 142        :a
 143       2:bx
 144        :c
 145 -------
 146        :d
 147       5:ex
 148        :f
 149 ")
 150     ;; * Test overlapping context lines with matches at bob/eob.
 151     ("x" 2 "\
 152 ax
 153 bx
 154 c
 155 dx
 156 e
 157 f
 158 gx
 159 h
 160 i
 161 j
 162 kx
 163 " "\
 164 5 matches for \"x\" in buffer:  *temp*
 165       1:ax
 166       2:bx
 167        :c
 168       4:dx
 169        :e
 170        :f
 171       7:gx
 172        :h
 173        :i
 174        :j
 175      11:kx
 176 ")
 177     ;; * Test overlapping context lines with matches not at bob/eob.
 178     ("x" 2 "\
 179 a
 180 b
 181 cx
 182 d
 183 e
 184 f
 185 gx
 186 h
 187 i
 188 " "\
 189 2 matches for \"x\" in buffer:  *temp*
 190        :a
 191        :b
 192       3:cx
 193        :d
 194        :e
 195        :f
 196       7:gx
 197        :h
 198        :i
 199 ")
 200     ;; * Test overlapping context lines with empty first and last line..
 201     ("x" 2 "\
 202
 203 b
 204 cx
 205 d
 206 e
 207 f
 208 gx
 209 h
 210
 211 " "\
 212 2 matches for \"x\" in buffer:  *temp*
 213        :
 214        :b
 215       3:cx
 216        :d
 217        :e
 218        :f
 219       7:gx
 220        :h
 221        :
 222 ")
 223     ;; * Test multi-line overlapping context lines.
 224     ("x\n.x" 2 "\
 225 ax
 226 bx
 227 c
 228 d
 229 ex
 230 fx
 231 g
 232 h
 233 i
 234 jx
 235 kx
 236 " "\
 237 3 matches for \"x^J.x\" in buffer:  *temp*
 238       1:ax
 239        :bx
 240        :c
 241        :d
 242       5:ex
 243        :fx
 244        :g
 245        :h
 246        :i
 247      10:jx
 248        :kx
 249 ")
 250     ;; * Test multi-line non-overlapping context lines.
 251     ("x\n.x" 2 "\
 252 ax
 253 bx
 254 c
 255 d
 256 e
 257 f
 258 gx
 259 hx
 260 " "\
 261 2 matches for \"x^J.x\" in buffer:  *temp*
 262       1:ax
 263        :bx
 264        :c
 265        :d
 266 -------
 267        :e
 268        :f
 269       7:gx
 270        :hx
 271 ")
 272     ;; * Test non-overlapping negative (before-context) lines.
 273     ("x" -2 "\
 274 a
 275 bx
 276 c
 277 d
 278 e
 279 fx
 280 g
 281 h
 282 ix
 283 " "\
 284 3 matches for \"x\" in buffer:  *temp*
 285        :a
 286       2:bx
 287 -------
 288        :d
 289        :e
 290       6:fx
 291 -------
 292        :g
 293        :h
 294       9:ix
 295 ")
 296     ;; * Test overlapping negative (before-context) lines.
 297     ("x" -3 "\
 298 a
 299 bx
 300 c
 301 dx
 302 e
 303 f
 304 gx
 305 h
 306 " "\
 307 3 matches for \"x\" in buffer:  *temp*
 308        :a
 309       2:bx
 310        :c
 311       4:dx
 312        :e
 313        :f
 314       7:gx
 315 ")
 316
 317 )
 318   "List of tests for `occur'.
 319 Each element has the format:
 320 \(REGEXP NLINES INPUT-BUFFER-STRING OUTPUT-BUFFER-STRING).")
 321
 322 (defun test-occur ()
 323   (interactive)
 324   (let ((count 1)
 325         failed
 326         (occur-hook nil))
 327     (dolist (test occur-tests)
 328       (let ((regexp (nth 0 test))
 329             (nlines (nth 1 test))
 330             (input-buffer-string (nth 2 test))
 331             (output-buffer-string (nth 3 test)))
 332         (save-excursion
 333           (with-temp-buffer
 334             (insert input-buffer-string)
 335             (occur regexp nlines)
 336             (unless (equal output-buffer-string
 337                            (with-current-buffer "*Occur*"
 338                              (buffer-string)))
 339               (setq failed (cons count failed))))))
 340       (setq count (1+ count)))
 341     (if failed
 342         (message "FAILED TESTS: %S" (reverse failed))
 343       (message "SUCCESS"))))
 344
 345 (provide 'occur-testsuite)
 346
 347 ;;; occur-testsuite.el ends here