carbon2-commit: fix longstanding search bug involving searching for Control-1 chars
Ben Wing
ben at xemacs.org
Sun Feb 7 12:39:48 EST 2010
changeset: 4945:91a023144e72
user: Ben Wing <ben at xemacs.org>
date: Fri Jan 29 20:57:42 2010 -0600
files: src/ChangeLog src/search.c tests/ChangeLog tests/automated/case-tests.el tests/automated/lisp-tests.el tests/automated/regexp-tests.el tests/automated/search-tests.el
description:
fix longstanding search bug involving searching for Control-1 chars
-------------------- ChangeLog entries follow: --------------------
src/ChangeLog addition:
2010-01-29 Ben Wing <ben at xemacs.org>
* search.c (boyer_moore): Fix longstanding bug involving
searching for Control-1 chars; code was trying to directly
extract the last byte in the textual representation of a char
from an Ichar (and doing it in a buggy fashion) rather than
just converting the Ichar to text and looking at the last byte.
tests/ChangeLog addition:
2010-01-29 Ben Wing <ben at xemacs.org>
* automated/search-tests.el:
New file.
* automated/search-tests.el:
* automated/case-tests.el:
* automated/case-tests.el (pristine-case-table): Removed.
* automated/case-tests.el (uni-mappings):
* automated/lisp-tests.el:
* automated/regexp-tests.el:
Extract some search-related code from case-tests and regexp-tests
and move to search-tests. Move some regexp-related code from
lisp-tests to regexp-tests.
Write a comment trying to express the proper division of labor
between case-tests, search-tests and regexp-tests.
Add a new test for the Control-1 search bug.
Fix a buggy test in the Unicode torture-test section of case-tests.el.
diff -r a7ab1d6ff301 -r 91a023144e72 src/ChangeLog
--- a/src/ChangeLog Fri Jan 29 20:49:50 2010 -0600
+++ b/src/ChangeLog Fri Jan 29 20:57:42 2010 -0600
@@ -1,3 +1,11 @@
+2010-01-29 Ben Wing <ben at xemacs.org>
+
+ * search.c (boyer_moore): Fix longstanding bug involving
+ searching for Control-1 chars; code was trying to directly
+ extract the last byte in the textual representation of a char
+ from an Ichar (and doing it in a buggy fashion) rather than
+ just converting the Ichar to text and looking at the last byte.
+
2010-01-28 Ben Wing <ben at xemacs.org>
* syswindows.h:
diff -r a7ab1d6ff301 -r 91a023144e72 src/search.c
--- a/src/search.c Fri Jan 29 20:49:50 2010 -0600
+++ b/src/search.c Fri Jan 29 20:57:42 2010 -0600
@@ -1779,7 +1779,8 @@
if (!NILP (trt))
{
#ifdef MULE
- Ichar ch, untranslated;
+ Ichar ch = -1, untranslated;
+ Ibyte byte;
int this_translated = 1;
/* Is *PTR the last byte of a character? */
@@ -1829,16 +1830,23 @@
for charset_base.) */
assert (1 == count || starting_ch != ch);
}
+ {
+ Ibyte tmp[MAX_ICHAR_LEN];
+ Bytecount chlen;
+
+ chlen = set_itext_ichar (tmp, ch);
+ byte = tmp[chlen - 1];
+ }
}
else
{
- ch = *ptr;
+ byte = *ptr;
this_translated = 0;
+ ch = -1;
}
- if (ch > 0400)
- j = ((unsigned char) ch | 0200);
- else
- j = (unsigned char) ch;
+
+ /* BYTE = last byte of character CH when represented as text */
+ j = byte;
if (i == infinity)
stride_for_teases = BM_tab[j];
@@ -1849,6 +1857,8 @@
{
Ichar starting_ch = ch;
EMACS_INT starting_j = j;
+
+ text_checking_assert (valid_ichar_p (ch));
do
{
ch = TRANSLATE (inverse_trt, ch);
@@ -1859,20 +1869,27 @@
if (ch > 0xFF && buffer_nothing_greater_than_0xff)
continue;
- if (ch > 0400)
- j = ((unsigned char) ch | 0200);
- else
- j = (unsigned char) ch;
+ /* Retrieve last byte of character CH when represented as
+ text */
+ {
+ Ibyte tmp[MAX_ICHAR_LEN];
+ Bytecount chlen;
+
+ chlen = set_itext_ichar (tmp, ch);
+ j = tmp[chlen - 1];
+ }
+
/* For all the characters that map into CH, set up
simple_translate to map the last byte into
STARTING_J. */
simple_translate[j] = (Ibyte) starting_j;
BM_tab[j] = dirlen - i;
- } while (ch != starting_ch);
+ }
+ while (ch != starting_ch);
}
-#else
+#else /* not MULE */
EMACS_INT k;
j = *ptr;
k = (j = TRANSLATE (trt, j));
@@ -1886,7 +1903,7 @@
simple_translate[j] = (Ibyte) k;
BM_tab[j] = dirlen - i;
}
-#endif
+#endif /* (not) MULE */
}
else
{
diff -r a7ab1d6ff301 -r 91a023144e72 tests/ChangeLog
--- a/tests/ChangeLog Fri Jan 29 20:49:50 2010 -0600
+++ b/tests/ChangeLog Fri Jan 29 20:57:42 2010 -0600
@@ -1,3 +1,25 @@
+2010-01-29 Ben Wing <ben at xemacs.org>
+
+ * automated/search-tests.el:
+ New file.
+
+ * automated/search-tests.el:
+ * automated/case-tests.el:
+ * automated/case-tests.el (pristine-case-table): Removed.
+ * automated/case-tests.el (uni-mappings):
+ * automated/lisp-tests.el:
+ * automated/regexp-tests.el:
+ Extract some search-related code from case-tests and regexp-tests
+ and move to search-tests. Move some regexp-related code from
+ lisp-tests to regexp-tests.
+
+ Write a comment trying to express the proper division of labor
+ between case-tests, search-tests and regexp-tests.
+
+ Add a new test for the Control-1 search bug.
+
+ Fix a buggy test in the Unicode torture-test section of case-tests.el.
+
2010-01-27 Ben Wing <ben at xemacs.org>
* automated/test-harness.el (test-harness-from-buffer):
diff -r a7ab1d6ff301 -r 91a023144e72 tests/automated/case-tests.el
--- a/tests/automated/case-tests.el Fri Jan 29 20:49:50 2010 -0600
+++ b/tests/automated/case-tests.el Fri Jan 29 20:57:42 2010 -0600
@@ -31,15 +31,26 @@
;; Test case-table related functionality.
-(defvar pristine-case-table nil
- "The standard case table, without manipulation from case-tests.el")
+;; NOTE NOTE NOTE: See also:
+;;
+;; (1) regexp-tests.el, for case-related regexp searching.
+;; (2) search-tests.el, for case-related non-regexp searching.
-(setq pristine-case-table (or
- ;; This is the compiled run; we've retained
- ;; it from the interpreted run.
- pristine-case-table
- ;; This is the interpreted run; set it.
- (copy-case-table (standard-case-table))))
+;; NOTE NOTE NOTE: There is some domain overlap among regexp-tests.el,
+;; search-tests.el and case-tests.el. See search-tests.el.
+;;
+
+;; Ben thinks this is unnecessary. See comment in search-tests.el.
+
+;;(defvar pristine-case-table nil
+;; "The standard case table, without manipulation from case-tests.el")
+;;
+;;(setq pristine-case-table (or
+;; ;; This is the compiled run; we've retained
+;; ;; it from the interpreted run.
+;; pristine-case-table
+;; ;; This is the interpreted run; set it.
+;; (copy-case-table (standard-case-table))))
(Assert (case-table-p (standard-case-table)))
;; Old case table test.
@@ -161,176 +172,6 @@
(string=
(downcase "!\"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ")
"!\"#$%&'()*+,-./0123456789:;<=>?@abcdefghijklmnopqrstuvwxyz")))
-
-(with-temp-buffer
- (insert "Test Buffer")
- (let ((case-fold-search t))
- (goto-char (point-min))
- (Assert-eq (search-forward "test buffer" nil t) 12)
- (goto-char (point-min))
- (Assert-eq (search-forward "Test buffer" nil t) 12)
- (goto-char (point-min))
- (Assert-eq (search-forward "Test Buffer" nil t) 12)
-
- (setq case-fold-search nil)
- (goto-char (point-min))
- (Assert (not (search-forward "test buffer" nil t)))
- (goto-char (point-min))
- (Assert (not (search-forward "Test buffer" nil t)))
- (goto-char (point-min))
- (Assert-eq (search-forward "Test Buffer" nil t) 12)))
-
-(with-temp-buffer
- (insert "abcdefghijklmnäopqrstuÄvwxyz")
- ;; case insensitive
- (Assert (not (search-forward "ö" nil t)))
- (goto-char (point-min))
- (Assert-eq 16 (search-forward "ä" nil t))
- (Assert-eq 24 (search-forward "ä" nil t))
- (goto-char (point-min))
- (Assert-eq 16 (search-forward "Ä" nil t))
- (Assert-eq 24 (search-forward "Ä" nil t))
- (goto-char (point-max))
- (Assert-eq 23 (search-backward "ä" nil t))
- (Assert-eq 15 (search-backward "ä" nil t))
- (goto-char (point-max))
- (Assert-eq 23 (search-backward "Ä" nil t))
- (Assert-eq 15 (search-backward "Ä" nil t))
- ;; case sensitive
- (setq case-fold-search nil)
- (goto-char (point-min))
- (Assert (not (search-forward "ö" nil t)))
- (goto-char (point-min))
- (Assert-eq 16 (search-forward "ä" nil t))
- (Assert (not (search-forward "ä" nil t)))
- (goto-char (point-min))
- (Assert-eq 24 (search-forward "Ä" nil t))
- (goto-char 16)
- (Assert-eq 24 (search-forward "Ä" nil t))
- (goto-char (point-max))
- (Assert-eq 15 (search-backward "ä" nil t))
- (goto-char 15)
- (Assert (not (search-backward "ä" nil t)))
- (goto-char (point-max))
- (Assert-eq 23 (search-backward "Ä" nil t))
- (Assert (not (search-backward "Ä" nil t))))
-
-(with-temp-buffer
- (insert "aaaaäÄäÄäÄäÄäÄbbbb")
- (goto-char (point-min))
- (Assert-eq 15 (search-forward "ää" nil t 5))
- (goto-char (point-min))
- (Assert (not (search-forward "ää" nil t 6)))
- (goto-char (point-max))
- (Assert-eq 5 (search-backward "ää" nil t 5))
- (goto-char (point-max))
- (Assert (not (search-backward "ää" nil t 6))))
-
-(when (featurep 'mule)
- (let* ((hiragana-a (make-char 'japanese-jisx0208 36 34))
- (a-diaeresis ?ä)
- (case-table (copy-case-table (standard-case-table)))
- (str-hiragana-a (char-to-string hiragana-a))
- (str-a-diaeresis (char-to-string a-diaeresis))
- (string (concat str-hiragana-a str-a-diaeresis)))
- (put-case-table-pair hiragana-a a-diaeresis case-table)
- (with-temp-buffer
- (set-case-table case-table)
- (insert hiragana-a "abcdefg" a-diaeresis)
- ;; forward
- (goto-char (point-min))
- (Assert (not (search-forward "ö" nil t)))
- (goto-char (point-min))
- (Assert-eq 2 (search-forward str-hiragana-a nil t))
- (goto-char (point-min))
- (Assert-eq 2 (search-forward str-a-diaeresis nil t))
- (goto-char (1+ (point-min)))
- (Assert-eq (point-max)
- (search-forward str-hiragana-a nil t))
- (goto-char (1+ (point-min)))
- (Assert-eq (point-max)
- (search-forward str-a-diaeresis nil t))
- ;; backward
- (goto-char (point-max))
- (Assert (not (search-backward "ö" nil t)))
- (goto-char (point-max))
- (Assert-eq (1- (point-max)) (search-backward str-hiragana-a nil t))
- (goto-char (point-max))
- (Assert-eq (1- (point-max)) (search-backward str-a-diaeresis nil t))
- (goto-char (1- (point-max)))
- (Assert-eq 1 (search-backward str-hiragana-a nil t))
- (goto-char (1- (point-max)))
- (Assert-eq 1 (search-backward str-a-diaeresis nil t))
- (replace-match "a")
- (Assert (looking-at (format "abcdefg%c" a-diaeresis))))
- (with-temp-buffer
- (set-case-table case-table)
- (insert string)
- (insert string)
- (insert string)
- (insert string)
- (insert string)
- (goto-char (point-min))
- (Assert-eq 11 (search-forward string nil t 5))
- (goto-char (point-min))
- (Assert (not (search-forward string nil t 6)))
- (goto-char (point-max))
- (Assert-eq 1 (search-backward string nil t 5))
- (goto-char (point-max))
- (Assert (not (search-backward string nil t 6))))))
-
-;; Bug reported in http://mid.gmane.org/y9lk5lu5orq.fsf@deinprogramm.de from
-;; Michael Sperber. Fixed 2008-01-29.
-(with-string-as-buffer-contents "\n\nDer beruhmte deutsche Flei\xdf\n\n"
- (goto-char (point-min))
- (Assert (search-forward "Flei\xdf")))
-
-(with-temp-buffer
- (let ((target "M\xe9zard")
- (debug-xemacs-searches 1))
- (Assert (not (search-forward target nil t)))
- (insert target)
- (goto-char (point-min))
- ;; #### search-algorithm-used is simple-search after the following,
- ;; which shouldn't be necessary; it should be possible to use
- ;; Boyer-Moore.
- ;;
- ;; But searches for ASCII strings in buffers with nothing above ?\xFF
- ;; use Boyer Moore with the current implementation, which is the
- ;; important thing for the Gnus use case.
- (Assert= (1+ (length target)) (search-forward target nil t))))
-
-(Skip-Test-Unless
- (boundp 'debug-xemacs-searches) ; normal when we have DEBUG_XEMACS
- "not a DEBUG_XEMACS build"
- "checks that the algorithm chosen by #'search-forward is relatively sane"
- (let ((debug-xemacs-searches 1))
- (with-temp-buffer
- (set-case-table pristine-case-table)
- (insert "\n\nDer beruhmte deutsche Fleiss\n\n")
- (goto-char (point-min))
- (Assert (search-forward "Fleiss"))
- (delete-region (point-min) (point-max))
- (insert "\n\nDer beruhmte deutsche Flei\xdf\n\n")
- (goto-char (point-min))
- (Assert (search-forward "Flei\xdf"))
- (Assert-eq 'boyer-moore search-algorithm-used)
- (delete-region (point-min) (point-max))
- (when (featurep 'mule)
- (insert "\n\nDer beruhmte deutsche Flei\xdf\n\n")
- (goto-char (point-min))
- (Assert
- (search-forward (format "Fle%c\xdf"
- (make-char 'latin-iso8859-9 #xfd))))
- (Assert-eq 'boyer-moore search-algorithm-used)
- (insert (make-char 'latin-iso8859-9 #xfd))
- (goto-char (point-min))
- (Assert (search-forward "Flei\xdf"))
- (Assert-eq 'simple-search search-algorithm-used)
- (goto-char (point-min))
- (Assert (search-forward (format "Fle%c\xdf"
- (make-char 'latin-iso8859-9 #xfd))))
- (Assert-eq 'simple-search search-algorithm-used)))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -1652,9 +1493,9 @@
(,lc ,uc))
do
(erase-buffer)
- (insert ?a)
+ (insert ?0)
(insert ch1)
- (insert ?b)
+ (insert ?1)
(goto-char (point-min))
(Assert-eql (search-forward (char-to-string ch2) nil t) 3
(format "Case-folded searching doesn't equate %s and %s"
diff -r a7ab1d6ff301 -r 91a023144e72 tests/automated/lisp-tests.el
--- a/tests/automated/lisp-tests.el Fri Jan 29 20:49:50 2010 -0600
+++ b/tests/automated/lisp-tests.el Fri Jan 29 20:57:42 2010 -0600
@@ -1069,17 +1069,6 @@
'("foo" "bar" ""))
(Assert-equal (split-string "foobar" split-string-default-separators)
'("foobar"))
-
-(Assert (not (string-match "\\(\\.\\=\\)" ".")))
-(Assert (string= "" (let ((str "test string"))
- (if (string-match "^.*$" str)
- (replace-match "\\U" t nil str)))))
-(with-temp-buffer
- (erase-buffer)
- (insert "test string")
- (re-search-backward "^.*$")
- (replace-match "\\U" t)
- (Assert (and (bobp) (eobp))))
;;-----------------------------------------------------
;; Test near-text buffer functions.
diff -r a7ab1d6ff301 -r 91a023144e72 tests/automated/regexp-tests.el
--- a/tests/automated/regexp-tests.el Fri Jan 29 20:49:50 2010 -0600
+++ b/tests/automated/regexp-tests.el Fri Jan 29 20:57:42 2010 -0600
@@ -28,7 +28,11 @@
;;; Commentary:
-;; Test regular expression.
+;; Test regular expressions.
+
+;; NOTE NOTE NOTE: There is some domain overlap among regexp-tests.el,
+;; search-tests.el and case-tests.el. See search-tests.el.
+;;
(Check-Error-Message error "Trailing backslash"
(string-match "\\" "a"))
@@ -563,3 +567,18 @@
(Assert= (re-search-forward "\\=") 4))
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Tests involving case-changing replace-match ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(Assert (not (string-match "\\(\\.\\=\\)" ".")))
+(Assert (string= "" (let ((str "test string"))
+ (if (string-match "^.*$" str)
+ (replace-match "\\U" t nil str)))))
+(with-temp-buffer
+ (erase-buffer)
+ (insert "test string")
+ (re-search-backward "^.*$")
+ (replace-match "\\U" t)
+ (Assert (and (bobp) (eobp))))
+
diff -r a7ab1d6ff301 -r 91a023144e72 tests/automated/search-tests.el
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/tests/automated/search-tests.el Fri Jan 29 20:57:42 2010 -0600
@@ -0,0 +1,231 @@
+;;; -*- coding: iso-8859-1 -*-
+
+;; Copyright (C) 2000 Free Software Foundation, Inc.
+;; Copyright (C) 2010 Ben Wing.
+
+;; Author: Yoshiki Hayashi <yoshiki at xemacs.org>
+;; Maintainer: Yoshiki Hayashi <yoshiki at xemacs.org>
+;; Created: 2000
+;; Keywords: tests
+
+;; This file is part of XEmacs.
+
+;; XEmacs is free software; you can redistribute it and/or modify it
+;; under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; XEmacs is distributed in the hope that it will be useful, but
+;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;; General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with XEmacs; see the file COPYING. If not, write to the Free
+;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+;; 02111-1307, USA.
+
+;;; Synched up with: Not in FSF.
+
+;;; Commentary:
+
+;; Test of non-regexp searching.
+
+;; Split out of case-tests.el.
+
+;; NOTE NOTE NOTE: See also:
+;;
+;; (1) regexp-tests.el, for regexp searching.
+;; (2) case-tests.el, for some case-related searches.
+
+;; NOTE NOTE NOTE: There is some domain overlap among regexp-tests.el,
+;; search-tests.el and case-tests.el. The current rule for what goes where
+;; is:
+;;
+;; (1) Anything regexp-related goes in regexp-tests.el, including searches.
+;; (2) Non-regexp searches go in search-tests.el. This includes case-folding
+;; searches in the situation where the test tests both folding and
+;; non-folding behavior.
+;; (3) If it tests specifically case-folding search behavior, it may go in
+;; case-tets.el, especially if it is testing something non-search-related
+;; at the same time (e.g. the Unicode case map torture tests).
+
+(with-temp-buffer
+ (insert "Test Buffer")
+ (let ((case-fold-search t))
+ (goto-char (point-min))
+ (Assert-eq (search-forward "test buffer" nil t) 12)
+ (goto-char (point-min))
+ (Assert-eq (search-forward "Test buffer" nil t) 12)
+ (goto-char (point-min))
+ (Assert-eq (search-forward "Test Buffer" nil t) 12)
+
+ (setq case-fold-search nil)
+ (goto-char (point-min))
+ (Assert (not (search-forward "test buffer" nil t)))
+ (goto-char (point-min))
+ (Assert (not (search-forward "Test buffer" nil t)))
+ (goto-char (point-min))
+ (Assert-eq (search-forward "Test Buffer" nil t) 12)))
+
+(with-temp-buffer
+ (insert "abcdefghijklmnäopqrstuÄvwxyz")
+ ;; case insensitive
+ (Assert (not (search-forward "ö" nil t)))
+ (goto-char (point-min))
+ (Assert-eq 16 (search-forward "ä" nil t))
+ (Assert-eq 24 (search-forward "ä" nil t))
+ (goto-char (point-min))
+ (Assert-eq 16 (search-forward "Ä" nil t))
+ (Assert-eq 24 (search-forward "Ä" nil t))
+ (goto-char (point-max))
+ (Assert-eq 23 (search-backward "ä" nil t))
+ (Assert-eq 15 (search-backward "ä" nil t))
+ (goto-char (point-max))
+ (Assert-eq 23 (search-backward "Ä" nil t))
+ (Assert-eq 15 (search-backward "Ä" nil t))
+ ;; case sensitive
+ (setq case-fold-search nil)
+ (goto-char (point-min))
+ (Assert (not (search-forward "ö" nil t)))
+ (goto-char (point-min))
+ (Assert-eq 16 (search-forward "ä" nil t))
+ (Assert (not (search-forward "ä" nil t)))
+ (goto-char (point-min))
+ (Assert-eq 24 (search-forward "Ä" nil t))
+ (goto-char 16)
+ (Assert-eq 24 (search-forward "Ä" nil t))
+ (goto-char (point-max))
+ (Assert-eq 15 (search-backward "ä" nil t))
+ (goto-char 15)
+ (Assert (not (search-backward "ä" nil t)))
+ (goto-char (point-max))
+ (Assert-eq 23 (search-backward "Ä" nil t))
+ (Assert (not (search-backward "Ä" nil t))))
+
+(with-temp-buffer
+ (insert "aaaaäÄäÄäÄäÄäÄbbbb")
+ (goto-char (point-min))
+ (Assert-eq 15 (search-forward "ää" nil t 5))
+ (goto-char (point-min))
+ (Assert (not (search-forward "ää" nil t 6)))
+ (goto-char (point-max))
+ (Assert-eq 5 (search-backward "ää" nil t 5))
+ (goto-char (point-max))
+ (Assert (not (search-backward "ää" nil t 6))))
+
+(when (featurep 'mule)
+ (let* ((hiragana-a (make-char 'japanese-jisx0208 36 34))
+ (a-diaeresis ?ä)
+ (case-table (copy-case-table (standard-case-table)))
+ (str-hiragana-a (char-to-string hiragana-a))
+ (str-a-diaeresis (char-to-string a-diaeresis))
+ (string (concat str-hiragana-a str-a-diaeresis)))
+ (put-case-table-pair hiragana-a a-diaeresis case-table)
+ (with-temp-buffer
+ (set-case-table case-table)
+ (insert hiragana-a "abcdefg" a-diaeresis)
+ ;; forward
+ (goto-char (point-min))
+ (Assert (not (search-forward "ö" nil t)))
+ (goto-char (point-min))
+ (Assert-eq 2 (search-forward str-hiragana-a nil t))
+ (goto-char (point-min))
+ (Assert-eq 2 (search-forward str-a-diaeresis nil t))
+ (goto-char (1+ (point-min)))
+ (Assert-eq (point-max)
+ (search-forward str-hiragana-a nil t))
+ (goto-char (1+ (point-min)))
+ (Assert-eq (point-max)
+ (search-forward str-a-diaeresis nil t))
+ ;; backward
+ (goto-char (point-max))
+ (Assert (not (search-backward "ö" nil t)))
+ (goto-char (point-max))
+ (Assert-eq (1- (point-max)) (search-backward str-hiragana-a nil t))
+ (goto-char (point-max))
+ (Assert-eq (1- (point-max)) (search-backward str-a-diaeresis nil t))
+ (goto-char (1- (point-max)))
+ (Assert-eq 1 (search-backward str-hiragana-a nil t))
+ (goto-char (1- (point-max)))
+ (Assert-eq 1 (search-backward str-a-diaeresis nil t))
+ (replace-match "a")
+ (Assert (looking-at (format "abcdefg%c" a-diaeresis))))
+ (with-temp-buffer
+ (set-case-table case-table)
+ (insert string)
+ (insert string)
+ (insert string)
+ (insert string)
+ (insert string)
+ (goto-char (point-min))
+ (Assert-eq 11 (search-forward string nil t 5))
+ (goto-char (point-min))
+ (Assert (not (search-forward string nil t 6)))
+ (goto-char (point-max))
+ (Assert-eq 1 (search-backward string nil t 5))
+ (goto-char (point-max))
+ (Assert (not (search-backward string nil t 6))))))
+
+;; Bug reported in http://mid.gmane.org/y9lk5lu5orq.fsf@deinprogramm.de from
+;; Michael Sperber. Fixed 2008-01-29.
+(with-string-as-buffer-contents "\n\nDer beruhmte deutsche Flei\xdf\n\n"
+ (goto-char (point-min))
+ (Assert (search-forward "Flei\xdf")))
+
+(with-temp-buffer
+ (let ((target "M\xe9zard")
+ (debug-xemacs-searches 1))
+ (Assert (not (search-forward target nil t)))
+ (insert target)
+ (goto-char (point-min))
+ ;; #### search-algorithm-used is simple-search after the following,
+ ;; which shouldn't be necessary; it should be possible to use
+ ;; Boyer-Moore.
+ ;;
+ ;; But searches for ASCII strings in buffers with nothing above ?\xFF
+ ;; use Boyer Moore with the current implementation, which is the
+ ;; important thing for the Gnus use case.
+ (Assert= (1+ (length target)) (search-forward target nil t))))
+
+(Skip-Test-Unless
+ (boundp 'debug-xemacs-searches) ; normal when we have DEBUG_XEMACS
+ "not a DEBUG_XEMACS build"
+ "checks that the algorithm chosen by #'search-forward is relatively sane"
+ (let ((debug-xemacs-searches 1))
+ (with-temp-buffer
+ ;;#### Ben thinks this is unnecessary. with-temp-buffer creates
+ ;;a new buffer, which automatically inherits the standard case table.
+ ;;(set-case-table pristine-case-table)
+ (insert "\n\nDer beruhmte deutsche Fleiss\n\n")
+ (goto-char (point-min))
+ (Assert (search-forward "Fleiss"))
+ (delete-region (point-min) (point-max))
+ (insert "\n\nDer beruhmte deutsche Flei\xdf\n\n")
+ (goto-char (point-min))
+ (Assert (search-forward "Flei\xdf"))
+ (Assert-eq 'boyer-moore search-algorithm-used)
+ (delete-region (point-min) (point-max))
+ (when (featurep 'mule)
+ (insert "\n\nDer beruhmte deutsche Flei\xdf\n\n")
+ (goto-char (point-min))
+ (Assert
+ (search-forward (format "Fle%c\xdf"
+ (make-char 'latin-iso8859-9 #xfd))))
+ (Assert-eq 'boyer-moore search-algorithm-used)
+ (insert (make-char 'latin-iso8859-9 #xfd))
+ (goto-char (point-min))
+ (Assert (search-forward "Flei\xdf"))
+ (Assert-eq 'simple-search search-algorithm-used)
+ (goto-char (point-min))
+ (Assert (search-forward (format "Fle%c\xdf"
+ (make-char 'latin-iso8859-9 #xfd))))
+ (Assert-eq 'simple-search search-algorithm-used)))))
+
+
+;; XEmacs bug of long standing.
+
+(with-temp-buffer
+ (insert "foo\201bar")
+ (goto-char (point-min))
+ (Assert-eq (search-forward "\201" nil t) 5))
More information about the XEmacs-Patches
mailing list