Mercurial > hg > xemacs-beta
changeset 4897:91a023144e72
fix longstanding search bug involving searching for Control-1 chars
-------------------- ChangeLog entries follow: --------------------
src/ChangeLog addition:
2010-01-29 Ben Wing <ben@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@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.
author | Ben Wing <ben@xemacs.org> |
---|---|
date | Fri, 29 Jan 2010 20:57:42 -0600 |
parents | a7ab1d6ff301 |
children | 9a6c3653f58e |
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 |
diffstat | 7 files changed, 333 insertions(+), 206 deletions(-) [+] |
line wrap: on
line diff
--- 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@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@xemacs.org> * syswindows.h:
--- 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 {
--- 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@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@xemacs.org> * automated/test-harness.el (test-harness-from-buffer):
--- 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. + +;; NOTE NOTE NOTE: There is some domain overlap among regexp-tests.el, +;; search-tests.el and case-tests.el. See search-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)))) +;; 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. @@ -162,176 +173,6 @@ (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))))) - ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Torture test, using all the non-"full" mappings from the Unicode case @@ -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"
--- 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 @@ -1070,17 +1070,6 @@ (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. ;;-----------------------------------------------------
--- 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)))) +
--- /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@xemacs.org> +;; Maintainer: Yoshiki Hayashi <yoshiki@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))