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