cgit.sxemacs.org Git - sxemacs/blob - tests/automated/regexp-tests.el

   1 ;;; -*- coding: iso-8859-1 -*-
   2
   3 ;; Copyright (C) 2000 Free Software Foundation, Inc.
   4
   5 ;; Author: Yoshiki Hayashi  <yoshiki@xemacs.org>
   6 ;; Maintainer: Yoshiki Hayashi  <yoshiki@xemacs.org>
   7 ;; Created: 2000
   8 ;; Keywords: tests
   9
  10 ;; This file is part of SXEmacs.
  11
  12 ;; SXEmacs is free software: you can redistribute it and/or modify it
  13 ;; under the terms of the GNU General Public License as published by the
  14 ;; Free Software Foundation, either version 3 of the License, or (at your
  15 ;; option) any later version.
  16
  17 ;; SXEmacs is distributed in the hope that it will be
  18 ;; useful, but WITHOUT ANY WARRANTY; without even the implied warranty of
  19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  20 ;; General Public License for more details.
  21
  22 ;; You should have received a copy of the GNU General Public License
  23 ;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
  24
  25 ;;; Synched up with: Not in FSF.
  26
  27 ;;; Commentary:
  28
  29 ;; Test regular expression.
  30
  31 (Check-Error-Message error "Trailing backslash"
  32                      (string-match "\\" "a"))
  33 (Check-Error-Message error "Invalid preceding regular expression"
  34                      (string-match "a++" "a"))
  35 (Check-Error-Message error "Invalid preceding regular expression"
  36                      (string-match "a**" "a"))
  37 (Check-Error-Message error "Invalid preceding regular expression"
  38                      (string-match "a???" "a"))
  39 (Check-Error-Message error "Unmatched \\[ or \\[^"
  40                      (string-match "[" "a"))
  41 (Check-Error-Message error "Unmatched \\[ or \\[^"
  42                      (string-match "[abc" "a"))
  43 (Check-Error-Message error "Unmatched ) or \\\\)"
  44                      (string-match "\\)" "a"))
  45 (Check-Error-Message error "Invalid regular expression"
  46                      (string-match "\\(?.\\)" "a"))
  47 (Check-Error-Message error "Unmatched \\\\{"
  48                      (string-match "a\\{" "a"))
  49 (Check-Error-Message error "Invalid content of \\\\{\\\\}"
  50                      (string-match "a\\{a\\}" "a"))
  51
  52 ;; exactn
  53
  54 ;; string-match
  55 (with-temp-buffer
  56   ;; case-insensitive
  57   (Assert (string-match "ä" "ä"))
  58   (Assert (string-match "ä" "Ä"))
  59   (Assert (string-match "Ä" "Ä"))
  60   (Assert (string-match "Ä" "ä"))
  61   ;; case-sensitive
  62   (setq case-fold-search nil)
  63   (Assert (string-match "ä" "ä"))
  64   (Assert (not (string-match "ä" "Ä")))
  65   (Assert (string-match "Ä" "Ä"))
  66   (Assert (not (string-match "Ä" "ä"))))
  67
  68 ;; looking-at
  69 (with-temp-buffer
  70   (insert "äÄ")
  71   ;; case-insensitive
  72   (goto-char (point-min))
  73   (Assert (looking-at "ä"))
  74   (Assert (looking-at "Ä"))
  75   (forward-char)
  76   (Assert (looking-at "ä"))
  77   (Assert (looking-at "Ä"))
  78   ;; case-sensitive
  79   (setq case-fold-search nil)
  80   (goto-char (point-min))
  81   (Assert (looking-at "ä"))
  82   (Assert (not (looking-at "Ä")))
  83   (forward-char)
  84   (Assert (not (looking-at "ä")))
  85   (Assert (looking-at "Ä")))
  86
  87 ;; re-search-forward and re-search-backward
  88 (with-temp-buffer
  89   (insert "äÄ")
  90   ;; case insensitive
  91   ;; forward
  92   (goto-char (point-min))
  93   ;; Avoid trivial regexp.
  94   (Assert (eq 2 (re-search-forward "ä\\|a" nil t)))
  95   (goto-char (point-min))
  96   (Assert (eq 2 (re-search-forward "Ä\\|a" nil t)))
  97   (goto-char (1+ (point-min)))
  98   (Assert (eq 3 (re-search-forward "ä\\|a" nil t)))
  99   (goto-char (1+ (point-min)))
 100   (Assert (eq 3 (re-search-forward "Ä\\|a" nil t)))
 101   ;; backward
 102   (goto-char (point-max))
 103   (Assert (eq 2 (re-search-backward "ä\\|a" nil t)))
 104   (goto-char (point-max))
 105   (Assert (eq 2 (re-search-backward "Ä\\|a" nil t)))
 106   (goto-char (1- (point-max)))
 107   (Assert (eq 1 (re-search-backward "ä\\|a" nil t)))
 108   (goto-char (1- (point-max)))
 109   (Assert (eq 1 (re-search-backward "Ä\\|a" nil t)))
 110   ;; case sensitive
 111   (setq case-fold-search nil)
 112   ;; forward
 113   (goto-char (point-min))
 114   (Assert (eq 2 (re-search-forward "ä\\|a" nil t)))
 115   (goto-char (point-min))
 116   (Assert (eq 3 (re-search-forward "Ä\\|a" nil t)))
 117   (goto-char (1+ (point-min)))
 118   (Assert (not (re-search-forward "ä\\|a" nil t)))
 119   (goto-char (1+ (point-min)))
 120   (Assert (eq 3 (re-search-forward "Ä\\|a" nil t)))
 121   ;; backward
 122   (goto-char (point-max))
 123   (Assert (eq 1 (re-search-backward "ä\\|a" nil t)))
 124   (goto-char (point-max))
 125   (Assert (eq 2 (re-search-backward "Ä\\|a" nil t)))
 126   (goto-char (1- (point-max)))
 127   (Assert (eq 1 (re-search-backward "ä\\|a" nil t)))
 128   (goto-char (1- (point-max)))
 129   (Assert (not (re-search-backward "Ä\\|a" nil t))))
 130
 131 ;; duplicate
 132 (with-temp-buffer
 133   ;; case insensitive
 134   (Assert (string-match "^\\(ä\\)\\1$" "ää"))
 135   (Assert (string-match "^\\(ä\\)\\1$" "äÄ"))
 136   (Assert (string-match "^\\(ä\\)\\1$" "ÄÄ"))
 137   (Assert (string-match "^\\(ä\\)\\1$" "Ää"))
 138   (Assert (string-match "^\\(Ä\\)\\1$" "ää"))
 139   (Assert (string-match "^\\(Ä\\)\\1$" "äÄ"))
 140   (Assert (string-match "^\\(Ä\\)\\1$" "ÄÄ"))
 141   (Assert (string-match "^\\(Ä\\)\\1$" "Ää"))
 142   ;; case sensitive
 143   (setq case-fold-search nil)
 144   (Assert (string-match "^\\(ä\\)\\1$" "ää"))
 145   (Assert (not (string-match "^\\(ä\\)\\1$" "äÄ")))
 146   (Assert (not (string-match "^\\(ä\\)\\1$" "ÄÄ")))
 147   (Assert (not (string-match "^\\(ä\\)\\1$" "Ää")))
 148   (Assert (not (string-match "^\\(Ä\\)\\1$" "ää")))
 149   (Assert (not (string-match "^\\(Ä\\)\\1$" "äÄ")))
 150   (Assert (string-match "^\\(Ä\\)\\1$" "ÄÄ"))
 151   (Assert (not (string-match "^\\(Ä\\)\\1$" "Ää"))))
 152
 153 ;; multiple-match
 154 ;; Thanks to Manfred Bartz <MBartz@xix.com>
 155 ;; c.e.x <vn4rkkm7ouf3b5@corp.supernews.com>
 156 ;; #### Need to do repetitions of more complex regexps
 157 ;; #### WASH ME!
 158 (with-temp-buffer
 159   (Assert (not (string-match "^a\\{4,4\\}$" "aaa")))
 160   (Assert      (string-match "^a\\{4,4\\}$" "aaaa"))
 161   (Assert (not (string-match "^a\\{4,4\\}$" "aaaaa")))
 162   (Assert (not (string-match "^[a]\\{4,4\\}$" "aaa")))
 163   (Assert      (string-match "^[a]\\{4,4\\}$" "aaaa"))
 164   (Assert (not (string-match "^[a]\\{4,4\\}$" "aaaaa")))
 165   (Assert (not (string-match "^\\(a\\)\\{4,4\\}$" "aaa")))
 166   (Assert      (string-match "^\\(a\\)\\{4,4\\}$" "aaaa"))
 167   (Assert (not (string-match "^\\(a\\)\\{4,4\\}$" "aaaaa")))
 168   ;; Use class because repetition of single char broken in 21.5.15
 169   (Assert (not (string-match "^[a]\\{3,5\\}$" "aa")))
 170   (Assert      (string-match "^[a]\\{3,5\\}$" "aaa"))
 171   (Assert      (string-match "^[a]\\{3,5\\}$" "aaaa"))
 172   (Assert      (string-match "^[a]\\{3,5\\}$" "aaaaa"))
 173   (Assert (not (string-match "^[a]\\{3,5\\}$" "aaaaaa")))
 174   (insert "\
 175 aa
 176 aaa
 177 aaaa
 178 aaaaa
 179 aaaaaa
 180 baaaa
 181 ")
 182   (goto-char (point-min))
 183   (forward-line 1)
 184   (Assert (not (looking-at "^a\\{4,4\\}$")))
 185   (forward-line 1)
 186   (Assert      (looking-at "^a\\{4,4\\}$"))
 187   (forward-line 1)
 188   (Assert (not (looking-at "^a\\{4,4\\}$")))
 189   (goto-char (point-min))
 190   (forward-line 1)
 191   (Assert (not (looking-at "^[a]\\{4,4\\}$")))
 192   (forward-line 1)
 193   (Assert      (looking-at "^[a]\\{4,4\\}$"))
 194   (forward-line 1)
 195   (Assert (not (looking-at "^[a]\\{4,4\\}$")))
 196   (goto-char (point-min))
 197   (forward-line 1)
 198   (Assert (not (looking-at "^\\(a\\)\\{4,4\\}$")))
 199   (forward-line 1)
 200   (Assert      (looking-at "^\\(a\\)\\{4,4\\}$"))
 201   (forward-line 1)
 202   (Assert (not (looking-at "^\\(a\\)\\{4,4\\}$")))
 203   ;; Use class because repetition of single char broken in 21.5.15
 204   (goto-char (point-min))
 205   (Assert (not (looking-at "^[a]\\{3,5\\}$")))
 206   (forward-line 1)
 207   (Assert      (looking-at "^[a]\\{3,5\\}$"))
 208   (forward-line 1)
 209   (Assert      (looking-at "^[a]\\{3,5\\}$"))
 210   (forward-line 1)
 211   (Assert      (looking-at "^[a]\\{3,5\\}$"))
 212   (forward-line 1)
 213   (Assert (not (looking-at "^[a]\\{3,5\\}$")))
 214   (goto-char (point-min))
 215   (Assert (= 12 (re-search-forward "a\\{4,4\\}")))
 216   (goto-char (point-min))
 217   (Assert (= 12 (re-search-forward "b?a\\{4,4\\}")))
 218   (goto-char (point-min))
 219   (Assert (= 31 (re-search-forward "ba\\{4,4\\}")))
 220   (goto-char (point-min))
 221   (Assert (= 31 (re-search-forward "[b]a\\{4,4\\}")))
 222   (goto-char (point-min))
 223   (Assert (= 31 (re-search-forward "\\(b\\)a\\{4,4\\}")))
 224   (goto-char (point-min))
 225   (Assert (= 12 (re-search-forward "^a\\{4,4\\}")))
 226   (goto-char (point-min))
 227   (Assert (= 12 (re-search-forward "^a\\{4,4\\}$")))
 228   (goto-char (point-min))
 229   (Assert (= 12 (re-search-forward "[a]\\{4,4\\}")))
 230   (goto-char (point-min))
 231   (Assert (= 12 (re-search-forward "^[a]\\{4,4\\}")))
 232   (goto-char (point-min))
 233   (Assert (= 12 (re-search-forward "^[a]\\{4,4\\}$")))
 234   )
 235
 236 ;; charset, charset_not
 237 ;; Not called because it takes too much time.
 238 (defun test-regexp-charset-paranoid ()
 239   (let ((i 0)
 240         (max (expt 2 (if (featurep 'mule) 19 8)))
 241         (range "[a-z]")
 242         (range-not "[^a-z]")
 243         char string)
 244     (while (< i max)
 245       (when (setq char (int-to-char i))
 246         (setq string (char-to-string char))
 247         (if (or (and (<= 65 i)
 248                      (<= i 90))
 249                 (and (<= 97 i)
 250                      (<= i 122)))
 251             (progn
 252               (Assert (string-match range string))
 253               (Assert (not (string-match range-not string))))
 254           (Assert (not (string-match range string)))
 255           (Assert (string-match range-not string))))
 256       (setq i (1+ i)))))
 257
 258 ;; (test-regexp-charset-paranoid)
 259
 260 ;; charset_mule, charset_mule_not
 261 ;; Not called because it takes too much time.
 262 (defun test-regex-charset-mule-paranoid ()
 263   (if (featurep 'mule)
 264       (let ((i 0)
 265             (max (expt 2 19))
 266             (range (format "[%c-%c]"
 267                            (make-char 'japanese-jisx0208 36 34)
 268                            (make-char 'japanese-jisx0208 36 42)))
 269             (range-not (format "[^%c-%c]"
 270                                (make-char 'japanese-jisx0208 36 34)
 271                                (make-char 'japanese-jisx0208 36 42)))
 272             (min-int (char-to-int (make-char 'japanese-jisx0208 36 34)))
 273             (max-int (char-to-int (make-char 'japanese-jisx0208 36 42)))
 274             char string)
 275         (while (< i max)
 276           (when (setq char (int-to-char i))
 277             (setq string (char-to-string char))
 278             (if (and (<= min-int i)
 279                      (<= i max-int))
 280                 (progn
 281                   (Assert (string-match range string))
 282                   (Assert (not (string-match range-not string))))
 283               (Assert (not (string-match range string)))
 284               (Assert (string-match range-not string))))
 285           (setq i (1+ i))))))
 286
 287 ;; (test-regex-charset-mule-paranoid)
 288
 289 ;; Test replace-match
 290 (with-temp-buffer
 291   (insert "This is a test buffer.")
 292   (goto-char (point-min))
 293   (search-forward "this is a test ")
 294   (looking-at "Unmatchable text")
 295   (replace-match "")
 296   (Assert (looking-at "^buffer.$")))
 297
 298 ;; Test that trivial regexps reset unused registers
 299 ;; Thanks to Martin Sternholm for the report.
 300 ;; xemacs-beta <5blm6h2ki5.fsf@lister.roxen.com>
 301 (with-temp-buffer
 302   (insert "ab")
 303   (goto-char (point-min))
 304   (re-search-forward "\\(a\\)")
 305   ;; test the whole-match data, too -- one try scotched that, too!
 306   (Assert (string= (match-string 0) "a"))
 307   (Assert (string= (match-string 1) "a"))
 308   (re-search-forward "b")
 309   (Assert (string= (match-string 0) "b"))
 310   (Assert (not (match-string 1))))
 311
 312 ;; Test word boundaries
 313 (Assert (= (string-match " \\<a" " a") 0))
 314 (Assert (= (string-match "a\\> " "a ") 0))
 315 (Assert (= (string-match " \\ba" " a") 0))
 316 (Assert (= (string-match "a\\b " "a ") 0))
 317 (Assert (= (string-match "\\ba" " a") 1))
 318 (Assert (= (string-match "a\\b" "a ") 0))
 319 ;; should work at target boundaries
 320 (Assert (= (string-match "\\<a" "a") 0))
 321 (Assert (= (string-match "a\\>" "a") 0))
 322 (Assert (= (string-match "\\ba" "a") 0))
 323 (Assert (= (string-match "a\\b" "a") 0))
 324 ;; but not if the "word" would be on the null side of the boundary!
 325 (Assert (not (string-match "\\<" "")))
 326 (Assert (not (string-match "\\>" "")))
 327 (Assert (not (string-match " \\<" " ")))
 328 (Assert (not (string-match "\\> " " ")))
 329 (Assert (not (string-match "a\\<" "a")))
 330 (Assert (not (string-match "\\>a" "a")))
 331 ;; Added Known-Bug 2002-09-09 sjt
 332 ;; These are now fixed 2003-03-21 sjt
 333 (Assert (not (string-match "\\b" "")))
 334 (Assert (not (string-match " \\b" " ")))
 335 (Assert (not (string-match "\\b " " ")))
 336
 337 ;; Added 2002-12-27
 338 (if (featurep 'mule)
 339     ;; note: (int-to-char 65) => ?A
 340     (let ((ch0 (make-char 'japanese-jisx0208 52 65))
 341           (ch1 (make-char 'japanese-jisx0208 51 65)))
 342       (Assert (not (string-match "A" (string ch0))))
 343       (Assert (not (string-match "[A]" (string ch0))))
 344       (Assert (eq (string-match "[^A]" (string ch0)) 0))
 345       (Assert (not (string-match "@A" (string ?@ ch0))))
 346       (Assert (not (string-match "@[A]" (string ?@ ch0))))
 347       (Assert (eq (string-match "@[^A]" (string ?@ ch0)) 0))
 348       (Assert (not (string-match "@?A" (string ?@ ch0))))
 349       (Assert (not (string-match "A" (string ch1))))
 350       (Assert (not (string-match "[A]" (string ch1))))
 351       (Assert (eq (string-match "[^A]" (string ch1)) 0))
 352       (Assert (not (string-match "@A" (string ?@ ch1))))
 353       (Assert (not (string-match "@[A]" (string ?@ ch1))))
 354       (Assert (eq (string-match "@[^A]" (string ?@ ch1)) 0))
 355       (Assert (not (string-match "@?A" (string ?@ ch1))))))
 356
 357 ;; More stale match data tests.
 358 ;; Thanks to <bjacob@ca.metsci.com> for drawing attention to this issue.
 359 ;; Flying in the face of sanity, the Asserts with positive results below are
 360 ;; correct.  Too much code depends on failed matches preserving match-data.
 361 (let ((a "a"))
 362   (Assert (string= (progn (string-match "a" a)
 363                           (string-match "b" a)
 364                           (match-string 0 a))
 365                    a))
 366   (Assert (not (progn (string-match "a" a)
 367                       (string-match "b" a)
 368                       (match-string 1 a))))
 369   ;; test both for the second match is a plain string match and a regexp match
 370   (Assert (string= (progn (string-match "\\(a\\)" a)
 371                           (string-match "\\(b\\)" a)
 372                           (match-string 0 a))
 373                    a))
 374   (Assert (string= (progn (string-match "\\(a\\)" a)
 375                           (string-match "b" a)
 376                           (match-string 0 a))
 377                    a))
 378   (Assert (string= (progn (string-match "\\(a\\)" a)
 379                           (string-match "\\(b\\)" a)
 380                           (match-string 1 a))
 381                    a))
 382   (Assert (string= (progn (string-match "\\(a\\)" a)
 383                           (string-match "b" a)
 384                           (match-string 1 a))
 385                    a)))
 386
 387 ;; bug identified by Katsumi Yamaoka 2004-09-03 <b9ywtzbbpue.fsf_-_@jpl.org>
 388 ;; fix submitted by sjt 2004-09-08
 389 ;; trailing comments are values from buggy 21.4.15
 390 (let ((text "abc"))
 391   (Assert (eq 0 (string-match "\\(?:ab+\\)*c" text)))   ; 2
 392   (Assert (eq 0 (string-match "^\\(?:ab+\\)*c" text)))  ; nil
 393   (Assert (eq 0 (string-match "^\\(?:ab+\\)*" text)))   ; 0
 394   (Assert (eq 0 (string-match "^\\(?:ab+\\)c" text)))   ; 0
 395   (Assert (eq 0 (string-match "^\\(?:ab\\)*c" text)))   ; 0
 396   (Assert (eq 0 (string-match "^\\(?:a+\\)*b" text)))   ; nil
 397   (Assert (eq 0 (string-match "^\\(?:a\\)*b" text)))    ; 0
 398 )
 399
 400 ;; per Steve Youngs 2004-09-30 <microsoft-free.87ekkjhj7t.fsf@youngs.au.com>
 401 ;; fix submitted by sjt 2004-10-07
 402 ;; trailing comments are values from buggy 21.4.pre16
 403 (let ((text "abc"))
 404   (Assert (eq 0 (string-match "\\(?:a\\(b\\)\\)" text)))        ; 0
 405   (Assert (string= (match-string 1 text) "b"))                  ; ab
 406   (Assert (null (match-string 2 text)))                         ; b
 407   (Assert (null (match-string 3 text)))                         ; nil
 408   (Assert (eq 0 (string-match "\\(?:a\\(?:b\\(c\\)\\)\\)" text)))       ; 0
 409   (Assert (string= (match-string 1 text) "c"))                  ; abc
 410   (Assert (null (match-string 2 text)))                         ; ab
 411   (Assert (null (match-string 3 text)))                         ; c
 412   (Assert (null (match-string 4 text)))                         ; nil
 413 )
 414
 415 ;; trivial subpatterns and backreferences with shy groups
 416 (let ((text1 "abb")
 417       (text2 "aba")
 418       (re0 "\\(a\\)\\(b\\)\\2")
 419       (re1 "\\(?:a\\)\\(b\\)\\2")
 420       (re2 "\\(?:a\\)\\(b\\)\\1")
 421       (re3 "\\(a\\)\\(?:b\\)\\1"))
 422
 423   (Assert (eq 0 (string-match re0 text1)))
 424   (Assert (string= text1 (match-string 0 text1)))
 425   (Assert (string= "a" (match-string 1 text1)))
 426   (Assert (string= "b" (match-string 2 text1)))
 427   (Assert (null (string-match re0 text2)))
 428
 429   (Check-Error-Message 'invalid-regexp "Invalid back reference"
 430                        (string-match re1 text1))
 431
 432   (Assert (eq 0 (string-match re2 text1)))
 433   (Assert (string= text1 (match-string 0 text1)))
 434   (Assert (string= "b" (match-string 1 text1)))
 435   (Assert (null (match-string 2 text1)))
 436   (Assert (null (string-match re2 text2)))
 437
 438   (Assert (null (string-match re3 text1)))
 439   (Assert (eq 0 (string-match re3 text2)))
 440   (Assert (string= text2 (match-string 0 text2)))
 441   (Assert (string= "a" (match-string 1 text2)))
 442   (Assert (null (match-string 2 text2)))
 443   )