Mercurial > hg > xemacs-beta

comparison tests/automated/case-tests.el @ 4897:91a023144e72

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
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 1fbf8bffa545
children e91e3e353805 6ef8256a020a
comparison
equal deleted inserted replaced
4896:a7ab1d6ff301 4897:91a023144e72
29 29
30 ;;; Commentary: 30 ;;; Commentary:
31 31
32 ;; Test case-table related functionality. 32 ;; Test case-table related functionality.
33 33
34 (defvar pristine-case-table nil 34 ;; NOTE NOTE NOTE: See also:
35 "The standard case table, without manipulation from case-tests.el") 35 ;;
36 36 ;; (1) regexp-tests.el, for case-related regexp searching.
37 (setq pristine-case-table (or 37 ;; (2) search-tests.el, for case-related non-regexp searching.
38 ;; This is the compiled run; we've retained 38
39 ;; it from the interpreted run. 39 ;; NOTE NOTE NOTE: There is some domain overlap among regexp-tests.el,
40 pristine-case-table 40 ;; search-tests.el and case-tests.el. See search-tests.el.
41 ;; This is the interpreted run; set it. 41 ;;
42 (copy-case-table (standard-case-table)))) 42
43 ;; Ben thinks this is unnecessary. See comment in search-tests.el.
44
45 ;;(defvar pristine-case-table nil
46 ;; "The standard case table, without manipulation from case-tests.el")
47 ;;
48 ;;(setq pristine-case-table (or
49 ;; ;; This is the compiled run; we've retained
50 ;; ;; it from the interpreted run.
51 ;; pristine-case-table
52 ;; ;; This is the interpreted run; set it.
53 ;; (copy-case-table (standard-case-table))))
43 54
44 (Assert (case-table-p (standard-case-table))) 55 (Assert (case-table-p (standard-case-table)))
45 ;; Old case table test. 56 ;; Old case table test.
46 (Assert (case-table-p (list 57 (Assert (case-table-p (list
47 (make-string 256 ?a) 58 (make-string 256 ?a)
159 "!\"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ")) 170 "!\"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ"))
160 (Assert 171 (Assert
161 (string= 172 (string=
162 (downcase "!\"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ") 173 (downcase "!\"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ")
163 "!\"#$%&'()*+,-./0123456789:;<=>?@abcdefghijklmnopqrstuvwxyz"))) 174 "!\"#$%&'()*+,-./0123456789:;<=>?@abcdefghijklmnopqrstuvwxyz")))
164
165 (with-temp-buffer
166 (insert "Test Buffer")
167 (let ((case-fold-search t))
168 (goto-char (point-min))
169 (Assert-eq (search-forward "test buffer" nil t) 12)
170 (goto-char (point-min))
171 (Assert-eq (search-forward "Test buffer" nil t) 12)
172 (goto-char (point-min))
173 (Assert-eq (search-forward "Test Buffer" nil t) 12)
174
175 (setq case-fold-search nil)
176 (goto-char (point-min))
177 (Assert (not (search-forward "test buffer" nil t)))
178 (goto-char (point-min))
179 (Assert (not (search-forward "Test buffer" nil t)))
180 (goto-char (point-min))
181 (Assert-eq (search-forward "Test Buffer" nil t) 12)))
182
183 (with-temp-buffer
184 (insert "abcdefghijklmnäopqrstuÄvwxyz")
185 ;; case insensitive
186 (Assert (not (search-forward "ö" nil t)))
187 (goto-char (point-min))
188 (Assert-eq 16 (search-forward "ä" nil t))
189 (Assert-eq 24 (search-forward "ä" nil t))
190 (goto-char (point-min))
191 (Assert-eq 16 (search-forward "Ä" nil t))
192 (Assert-eq 24 (search-forward "Ä" nil t))
193 (goto-char (point-max))
194 (Assert-eq 23 (search-backward "ä" nil t))
195 (Assert-eq 15 (search-backward "ä" nil t))
196 (goto-char (point-max))
197 (Assert-eq 23 (search-backward "Ä" nil t))
198 (Assert-eq 15 (search-backward "Ä" nil t))
199 ;; case sensitive
200 (setq case-fold-search nil)
201 (goto-char (point-min))
202 (Assert (not (search-forward "ö" nil t)))
203 (goto-char (point-min))
204 (Assert-eq 16 (search-forward "ä" nil t))
205 (Assert (not (search-forward "ä" nil t)))
206 (goto-char (point-min))
207 (Assert-eq 24 (search-forward "Ä" nil t))
208 (goto-char 16)
209 (Assert-eq 24 (search-forward "Ä" nil t))
210 (goto-char (point-max))
211 (Assert-eq 15 (search-backward "ä" nil t))
212 (goto-char 15)
213 (Assert (not (search-backward "ä" nil t)))
214 (goto-char (point-max))
215 (Assert-eq 23 (search-backward "Ä" nil t))
216 (Assert (not (search-backward "Ä" nil t))))
217
218 (with-temp-buffer
219 (insert "aaaaäÄäÄäÄäÄäÄbbbb")
220 (goto-char (point-min))
221 (Assert-eq 15 (search-forward "ää" nil t 5))
222 (goto-char (point-min))
223 (Assert (not (search-forward "ää" nil t 6)))
224 (goto-char (point-max))
225 (Assert-eq 5 (search-backward "ää" nil t 5))
226 (goto-char (point-max))
227 (Assert (not (search-backward "ää" nil t 6))))
228
229 (when (featurep 'mule)
230 (let* ((hiragana-a (make-char 'japanese-jisx0208 36 34))
231 (a-diaeresis ?ä)
232 (case-table (copy-case-table (standard-case-table)))
233 (str-hiragana-a (char-to-string hiragana-a))
234 (str-a-diaeresis (char-to-string a-diaeresis))
235 (string (concat str-hiragana-a str-a-diaeresis)))
236 (put-case-table-pair hiragana-a a-diaeresis case-table)
237 (with-temp-buffer
238 (set-case-table case-table)
239 (insert hiragana-a "abcdefg" a-diaeresis)
240 ;; forward
241 (goto-char (point-min))
242 (Assert (not (search-forward "ö" nil t)))
243 (goto-char (point-min))
244 (Assert-eq 2 (search-forward str-hiragana-a nil t))
245 (goto-char (point-min))
246 (Assert-eq 2 (search-forward str-a-diaeresis nil t))
247 (goto-char (1+ (point-min)))
248 (Assert-eq (point-max)
249 (search-forward str-hiragana-a nil t))
250 (goto-char (1+ (point-min)))
251 (Assert-eq (point-max)
252 (search-forward str-a-diaeresis nil t))
253 ;; backward
254 (goto-char (point-max))
255 (Assert (not (search-backward "ö" nil t)))
256 (goto-char (point-max))
257 (Assert-eq (1- (point-max)) (search-backward str-hiragana-a nil t))
258 (goto-char (point-max))
259 (Assert-eq (1- (point-max)) (search-backward str-a-diaeresis nil t))
260 (goto-char (1- (point-max)))
261 (Assert-eq 1 (search-backward str-hiragana-a nil t))
262 (goto-char (1- (point-max)))
263 (Assert-eq 1 (search-backward str-a-diaeresis nil t))
264 (replace-match "a")
265 (Assert (looking-at (format "abcdefg%c" a-diaeresis))))
266 (with-temp-buffer
267 (set-case-table case-table)
268 (insert string)
269 (insert string)
270 (insert string)
271 (insert string)
272 (insert string)
273 (goto-char (point-min))
274 (Assert-eq 11 (search-forward string nil t 5))
275 (goto-char (point-min))
276 (Assert (not (search-forward string nil t 6)))
277 (goto-char (point-max))
278 (Assert-eq 1 (search-backward string nil t 5))
279 (goto-char (point-max))
280 (Assert (not (search-backward string nil t 6))))))
281
282 ;; Bug reported in http://mid.gmane.org/y9lk5lu5orq.fsf@deinprogramm.de from
283 ;; Michael Sperber. Fixed 2008-01-29.
284 (with-string-as-buffer-contents "\n\nDer beruhmte deutsche Flei\xdf\n\n"
285 (goto-char (point-min))
286 (Assert (search-forward "Flei\xdf")))
287
288 (with-temp-buffer
289 (let ((target "M\xe9zard")
290 (debug-xemacs-searches 1))
291 (Assert (not (search-forward target nil t)))
292 (insert target)
293 (goto-char (point-min))
294 ;; #### search-algorithm-used is simple-search after the following,
295 ;; which shouldn't be necessary; it should be possible to use
296 ;; Boyer-Moore.
297 ;;
298 ;; But searches for ASCII strings in buffers with nothing above ?\xFF
299 ;; use Boyer Moore with the current implementation, which is the
300 ;; important thing for the Gnus use case.
301 (Assert= (1+ (length target)) (search-forward target nil t))))
302
303 (Skip-Test-Unless
304 (boundp 'debug-xemacs-searches) ; normal when we have DEBUG_XEMACS
305 "not a DEBUG_XEMACS build"
306 "checks that the algorithm chosen by #'search-forward is relatively sane"
307 (let ((debug-xemacs-searches 1))
308 (with-temp-buffer
309 (set-case-table pristine-case-table)
310 (insert "\n\nDer beruhmte deutsche Fleiss\n\n")
311 (goto-char (point-min))
312 (Assert (search-forward "Fleiss"))
313 (delete-region (point-min) (point-max))
314 (insert "\n\nDer beruhmte deutsche Flei\xdf\n\n")
315 (goto-char (point-min))
316 (Assert (search-forward "Flei\xdf"))
317 (Assert-eq 'boyer-moore search-algorithm-used)
318 (delete-region (point-min) (point-max))
319 (when (featurep 'mule)
320 (insert "\n\nDer beruhmte deutsche Flei\xdf\n\n")
321 (goto-char (point-min))
322 (Assert
323 (search-forward (format "Fle%c\xdf"
324 (make-char 'latin-iso8859-9 #xfd))))
325 (Assert-eq 'boyer-moore search-algorithm-used)
326 (insert (make-char 'latin-iso8859-9 #xfd))
327 (goto-char (point-min))
328 (Assert (search-forward "Flei\xdf"))
329 (Assert-eq 'simple-search search-algorithm-used)
330 (goto-char (point-min))
331 (Assert (search-forward (format "Fle%c\xdf"
332 (make-char 'latin-iso8859-9 #xfd))))
333 (Assert-eq 'simple-search search-algorithm-used)))))
334 175
335 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 176 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
336 177
337 ;; Torture test, using all the non-"full" mappings from the Unicode case 178 ;; Torture test, using all the non-"full" mappings from the Unicode case
338 ;; tables. (Full mappings are those that involve sequences of more than one 179 ;; tables. (Full mappings are those that involve sequences of more than one
1650 (loop for (uc lc) in uni-mappings do 1491 (loop for (uc lc) in uni-mappings do
1651 (loop for (ch1 ch2) in `((,uc ,lc) 1492 (loop for (ch1 ch2) in `((,uc ,lc)
1652 (,lc ,uc)) 1493 (,lc ,uc))
1653 do 1494 do
1654 (erase-buffer) 1495 (erase-buffer)
1655 (insert ?a) 1496 (insert ?0)
1656 (insert ch1) 1497 (insert ch1)
1657 (insert ?b) 1498 (insert ?1)
1658 (goto-char (point-min)) 1499 (goto-char (point-min))
1659 (Assert-eql (search-forward (char-to-string ch2) nil t) 3 1500 (Assert-eql (search-forward (char-to-string ch2) nil t) 3
1660 (format "Case-folded searching doesn't equate %s and %s" 1501 (format "Case-folded searching doesn't equate %s and %s"
1661 (char-as-unicode-escape ch1) 1502 (char-as-unicode-escape ch1)
1662 (char-as-unicode-escape ch2)))))))) 1503 (char-as-unicode-escape ch2))))))))