comparison tests/automated/case-tests.el @ 4415:bceb3e285ae7

case-tests.el: fix it on non-DEBUG_XEMACS; save standard-case-table, use it 2008-01-30 Aidan Kehoe <kehoea@parhasard.net> * automated/case-tests.el (pristine-case-table): New var, reflecting the standard case table before case-table.el messes with it. * automated/case-tests.el: Call Skip-Test-Unless correctly, following Vin's report of 20a807210801300635v7533d26rdb32a8d82fb4239b@mail.gmail.com . Use pristine-case-table, add in a couple more tests. * automated/test-harness.el (test-harness-from-buffer): Update the error message in the light of tests skipped for other reasons (not to do with absent packages). In this case, because we're exposing diagnostics in a DEBUG_XEMACS build that are no appropriate to expose to non-DEBUG_XEMACS builds.
author Aidan Kehoe <kehoea@parhasard.net>
date Wed, 30 Jan 2008 22:33:29 +0100
parents df576f30c1d8
children 69b803c646cd
comparison
equal deleted inserted replaced
4414:df576f30c1d8 4415:bceb3e285ae7
27 ;;; Synched up with: Not in FSF. 27 ;;; Synched up with: Not in FSF.
28 28
29 ;;; Commentary: 29 ;;; Commentary:
30 30
31 ;; Test case-table related functionality. 31 ;; Test case-table related functionality.
32
33 (defvar pristine-case-table nil
34 "The standard case table, without manipulation from case-tests.el")
35
36 (setq pristine-case-table (or
37 ;; This is the compiled run; we've retained
38 ;; it from the interpreted run.
39 pristine-case-table
40 ;; This is the interpreted run; set it.
41 (copy-case-table (standard-case-table))))
32 42
33 (Assert (case-table-p (standard-case-table))) 43 (Assert (case-table-p (standard-case-table)))
34 ;; Old case table test. 44 ;; Old case table test.
35 (Assert (case-table-p (list 45 (Assert (case-table-p (list
36 (make-string 256 ?a) 46 (make-string 256 ?a)
275 (Assert (search-forward "Flei\xdf"))) 285 (Assert (search-forward "Flei\xdf")))
276 286
277 (Skip-Test-Unless 287 (Skip-Test-Unless
278 (boundp 'debug-xemacs-searches) ; normal when we have DEBUG_XEMACS 288 (boundp 'debug-xemacs-searches) ; normal when we have DEBUG_XEMACS
279 "not a DEBUG_XEMACS build" 289 "not a DEBUG_XEMACS build"
290 "checks that the algorithm chosen by #'search-forward is relatively sane"
280 (let ((debug-xemacs-searches 1)) 291 (let ((debug-xemacs-searches 1))
281 (with-temp-buffer 292 (with-temp-buffer
293 (set-case-table pristine-case-table)
282 (insert "\n\nDer beruhmte deutsche Fleiss\n\n") 294 (insert "\n\nDer beruhmte deutsche Fleiss\n\n")
283 (goto-char (point-min)) 295 (goto-char (point-min))
284 (search-forward "Fleiss") 296 (Assert (search-forward "Fleiss"))
285 (delete-region (point-min) (point-max)) 297 (delete-region (point-min) (point-max))
286 (insert "\n\nDer beruhmte deutsche Flei\xdf\n\n") 298 (insert "\n\nDer beruhmte deutsche Flei\xdf\n\n")
287 (goto-char (point-min)) 299 (goto-char (point-min))
288 (search-forward "Flei\xdf") 300 (Assert (search-forward "Flei\xdf"))
289 (Assert (eq 'boyer-moore search-algorithm-used)) 301 (Assert (eq 'boyer-moore search-algorithm-used))
290 (delete-region (point-min) (point-max)) 302 (delete-region (point-min) (point-max))
291 (when (featurep 'mule) 303 (when (featurep 'mule)
292 (insert "\n\nDer beruhmte deutsche Flei\xdf\n\n") 304 (insert "\n\nDer beruhmte deutsche Flei\xdf\n\n")
293 (goto-char (point-min)) 305 (goto-char (point-min))
295 (search-forward (format "Fle%c\xdf" 307 (search-forward (format "Fle%c\xdf"
296 (make-char 'latin-iso8859-9 #xfd)))) 308 (make-char 'latin-iso8859-9 #xfd))))
297 (Assert (eq 'boyer-moore search-algorithm-used)) 309 (Assert (eq 'boyer-moore search-algorithm-used))
298 (insert (make-char 'latin-iso8859-9 #xfd)) 310 (insert (make-char 'latin-iso8859-9 #xfd))
299 (goto-char (point-min)) 311 (goto-char (point-min))
300 (Assert 312 (Assert (search-forward "Flei\xdf"))
301 (search-forward (format "Fle%c\xdf" 313 (Assert (eq 'simple-search search-algorithm-used))
302 (make-char 'latin-iso8859-9 #xfd)))) 314 (goto-char (point-min))
315 (Assert (search-forward (format "Fle%c\xdf"
316 (make-char 'latin-iso8859-9 #xfd))))
303 (Assert (eq 'simple-search search-algorithm-used)))))) 317 (Assert (eq 'simple-search search-algorithm-used))))))
304 318