Mercurial > hg > xemacs-beta

comparison tests/automated/case-tests.el @ 462:0784d089fdc9 r21-2-46

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-2-46
author cvs
date Mon, 13 Aug 2007 11:44:37 +0200
parents 1ccc32a20af4
children df576f30c1d8
comparison
equal deleted inserted replaced
461:120ed4009e51 462:0784d089fdc9
1 (binary file application/octet-stream, hash: 933bdc3ff6f52579b8fe88f3446f4a9e5991987a) 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 case-table related functionality.
32
33 (Assert (case-table-p (standard-case-table)))
34 ;; Old case table test.
35 (Assert (case-table-p (list
36 (make-string 256 ?a)
37 nil nil nil)))
38 (Assert (case-table-p (list
39 (make-string 256 ?a)
40 (make-string 256 ?b)
41 nil nil)))
42 (Assert (case-table-p (list
43 (make-string 256 ?a)
44 (make-string 256 ?b)
45 (make-string 256 ?c)
46 nil)))
47 (Assert (case-table-p (list
48 (make-string 256 ?a)
49 (make-string 256 ?b)
50 (make-string 256 ?c)
51 (make-string 256 ?d))))
52 (Assert (not (case-table-p (list (make-string 256 ?a)
53 (make-string 256 ?b)
54 (make-string 256 ?c)
55 (make-string 254 ?d)))))
56 (Assert (not (case-table-p (list (make-string 256 ?a)))))
57
58 (Assert (case-table-p (set-case-table (current-case-table))))
59
60 (defvar string-0-through-32
61 (let ((result (make-string 33 (int-to-char 0))))
62 (dotimes (i 33)
63 (aset result i (int-to-char i)))
64 result)
65 "String containing characters from code point 0 (NUL) through 32 (SPC).")
66
67 (defvar string-127-through-160
68 (let ((result (make-string 34 (int-to-char 0))))
69 (dotimes (i 34)
70 (aset result i (int-to-char (+ 127 i))))
71 result)
72 "String containing characters from code point 127 (DEL) through 160
73 \(no-break-space).")
74
75 ;; Case table sanity check.
76 (let ((downcase-string
77 (concat string-0-through-32
78 "!\"#$%&'()*+,-./0123456789:;<=>?@abcdefghijklmnopqrstuvwxyz[\\]^_`abcdefghijklmnopqrstuvwxyz{|}~"
79 string-127-through-160
80 "¡¢£¤¥¦§¨©ª«¬­®¯°±²³´µ¶·¸¹º»¼½¾¿àáâãäåæçèéêëìíîïðñòóôõö×øùúûüýþßàáâãäåæçèéêëìíîïðñòóôõö÷øùúûüýþÿ"))
81 (upcase-string
82 (concat string-0-through-32
83 "!\"#$%&'()*+,-./0123456789:;<=>?@abcdefghijklmnopqrstuvwxyz[\\]^_`ABCDEFGHIJKLMNOPQRSTUVWXYZ{|}~"
84 string-127-through-160
85 "¡¢£¤¥¦§¨©ª«¬­®¯°±²³´µ¶·¸¹º»¼½¾¿àáâãäåæçèéêëìíîïðñòóôõö×øùúûüýþßÀÁÂÃÄÅÆÇÈÉÊËÌÍÎÏÐÑÒÓÔÕÖ÷ØÙÚÛÜÝÞÿ"))
86 (table (standard-case-table)))
87 (dotimes (i 256)
88 (Assert (eq (get-case-table 'downcase (int-to-char i) table)
89 (aref downcase-string i)))
90 (Assert (eq (get-case-table 'upcase (int-to-char i) table)
91 (aref upcase-string i)))))
92
93 (Check-Error-Message error "Char case must be downcase or upcase"
94 (get-case-table 'foo ?a (standard-case-table)))
95
96 (Assert
97 (string=
98 (upcase "!\"#$%&'()*+,-./0123456789:;<=>?@abcdefghijklmnopqrstuvwxyz")
99 "!\"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ"))
100
101 (Assert
102 (string=
103 (upcase "!\"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ")
104 "!\"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ"))
105
106 (Assert
107 (string=
108 (upcase " ¡¢£¤¥¦§¨©ª«¬­®¯°±²³´µ¶·¸¹º»¼½¾¿àáâãäåæçèéêëìíîïðñòóôõö×øùúûüýþßàáâãäåæçèéêëìíîïðñòóôõö÷øùúûüýþÿ")
109 " ¡¢£¤¥¦§¨©ª«¬­®¯°±²³´µ¶·¸¹º»¼½¾¿ÀÁÂÃÄÅÆÇÈÉÊËÌÍÎÏÐÑÒÓÔÕÖ×ØÙÚÛÜÝÞßÀÁÂÃÄÅÆÇÈÉÊËÌÍÎÏÐÑÒÓÔÕÖ÷ØÙÚÛÜÝÞÿ"))
110
111 (Assert
112 (string=
113 (upcase " ¡¢£¤¥¦§¨©ª«¬­®¯°±²³´µ¶·¸¹º»¼½¾¿ÀÁÂÃÄÅÆÇÈÉÊËÌÍÎÏÐÑÒÓÔÕÖ×ØÙÚÛÜÝÞßÀÁÂÃÄÅÆÇÈÉÊËÌÍÎÏÐÑÒÓÔÕÖ÷ØÙÚÛÜÝÞÿ")
114 " ¡¢£¤¥¦§¨©ª«¬­®¯°±²³´µ¶·¸¹º»¼½¾¿ÀÁÂÃÄÅÆÇÈÉÊËÌÍÎÏÐÑÒÓÔÕÖ×ØÙÚÛÜÝÞßÀÁÂÃÄÅÆÇÈÉÊËÌÍÎÏÐÑÒÓÔÕÖ÷ØÙÚÛÜÝÞÿ"))
115
116 (Assert
117 (string=
118 (downcase "!\"#$%&'()*+,-./0123456789:;<=>?@abcdefghijklmnopqrstuvwxyz")
119 "!\"#$%&'()*+,-./0123456789:;<=>?@abcdefghijklmnopqrstuvwxyz"))
120
121 (Assert
122 (string=
123 (downcase "!\"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ")
124 "!\"#$%&'()*+,-./0123456789:;<=>?@abcdefghijklmnopqrstuvwxyz"))
125
126 (Assert
127 (string=
128 (downcase " ¡¢£¤¥¦§¨©ª«¬­®¯°±²³´µ¶·¸¹º»¼½¾¿àáâãäåæçèéêëìíîïðñòóôõö×øùúûüýþßàáâãäåæçèéêëìíîïðñòóôõö÷øùúûüýþÿ")
129 " ¡¢£¤¥¦§¨©ª«¬­®¯°±²³´µ¶·¸¹º»¼½¾¿àáâãäåæçèéêëìíîïðñòóôõö×øùúûüýþßàáâãäåæçèéêëìíîïðñòóôõö÷øùúûüýþÿ"))
130
131 (Assert
132 (string=
133 (downcase " ¡¢£¤¥¦§¨©ª«¬­®¯°±²³´µ¶·¸¹º»¼½¾¿ÀÁÂÃÄÅÆÇÈÉÊËÌÍÎÏÐÑÒÓÔÕÖ×ØÙÚÛÜÝÞßÀÁÂÃÄÅÆÇÈÉÊËÌÍÎÏÐÑÒÓÔÕÖ÷ØÙÚÛÜÝÞÿ")
134 " ¡¢£¤¥¦§¨©ª«¬­®¯°±²³´µ¶·¸¹º»¼½¾¿àáâãäåæçèéêëìíîïðñòóôõö×øùúûüýþßàáâãäåæçèéêëìíîïðñòóôõö÷øùúûüýþÿ"))
135
136 ;; Old case table format test.
137 (with-temp-buffer
138 (set-case-table
139 (list
140 (concat string-0-through-32
141 "!\"#$%&'()*+,-./0123456789:;<=>?@abcdefghijklmnopqrstuvwxyz[\\]^_`abcdefghijklmnopqrstuvwxyz{|}~"
142 string-127-through-160
143 "¡¢£¤¥¦§¨©ª«¬­®¯°±²³´µ¶·¸¹º»¼½¾¿àáâãäåæçèéêëìíîïðñòóôõö×øùúûüýþßàáâãäåæçèéêëìíîïðñòóôõö÷øùúûüýþÿ")
144 nil nil nil))
145 (Assert
146 (string=
147 (upcase "!\"#$%&'()*+,-./0123456789:;<=>?@abcdefghijklmnopqrstuvwxyz")
148 "!\"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ"))
149 (Assert
150 (string=
151 (downcase "!\"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ")
152 "!\"#$%&'()*+,-./0123456789:;<=>?@abcdefghijklmnopqrstuvwxyz")))
153
154 (with-temp-buffer
155 (insert "Test Buffer")
156 (let ((case-fold-search t))
157 (goto-char (point-min))
158 (Assert (eq (search-forward "test buffer" nil t) 12))
159 (goto-char (point-min))
160 (Assert (eq (search-forward "Test buffer" nil t) 12))
161 (goto-char (point-min))
162 (Assert (eq (search-forward "Test Buffer" nil t) 12))
163
164 (setq case-fold-search nil)
165 (goto-char (point-min))
166 (Assert (not (search-forward "test buffer" nil t)))
167 (goto-char (point-min))
168 (Assert (not (search-forward "Test buffer" nil t)))
169 (goto-char (point-min))
170 (Assert (eq (search-forward "Test Buffer" nil t) 12))))
171
172 (with-temp-buffer
173 (insert "abcdefghijklmnäopqrstuÄvwxyz")
174 ;; case insensitive
175 (Assert (not (search-forward "ö" nil t)))
176 (goto-char (point-min))
177 (Assert (eq 16 (search-forward "ä" nil t)))
178 (Assert (eq 24 (search-forward "ä" nil t)))
179 (goto-char (point-min))
180 (Assert (eq 16 (search-forward "Ä" nil t)))
181 (Assert (eq 24 (search-forward "Ä" nil t)))
182 (goto-char (point-max))
183 (Assert (eq 23 (search-backward "ä" nil t)))
184 (Assert (eq 15 (search-backward "ä" nil t)))
185 (goto-char (point-max))
186 (Assert (eq 23 (search-backward "Ä" nil t)))
187 (Assert (eq 15 (search-backward "Ä" nil t)))
188 ;; case sensitive
189 (setq case-fold-search nil)
190 (goto-char (point-min))
191 (Assert (not (search-forward "ö" nil t)))
192 (goto-char (point-min))
193 (Assert (eq 16 (search-forward "ä" nil t)))
194 (Assert (not (search-forward "ä" nil t)))
195 (goto-char (point-min))
196 (Assert (eq 24 (search-forward "Ä" nil t)))
197 (goto-char 16)
198 (Assert (eq 24 (search-forward "Ä" nil t)))
199 (goto-char (point-max))
200 (Assert (eq 15 (search-backward "ä" nil t)))
201 (goto-char 15)
202 (Assert (not (search-backward "ä" nil t)))
203 (goto-char (point-max))
204 (Assert (eq 23 (search-backward "Ä" nil t)))
205 (Assert (not (search-backward "Ä" nil t))))
206
207 (with-temp-buffer
208 (insert "aaaaäÄäÄäÄäÄäÄbbbb")
209 (goto-char (point-min))
210 (Assert (eq 15 (search-forward "ää" nil t 5)))
211 (goto-char (point-min))
212 (Assert (not (search-forward "ää" nil t 6)))
213 (goto-char (point-max))
214 (Assert (eq 5 (search-backward "ää" nil t 5)))
215 (goto-char (point-max))
216 (Assert (not (search-backward "ää" nil t 6))))
217
218 (when (featurep 'mule)
219 (let* ((hiragana-a (make-char 'japanese-jisx0208 36 34))
220 (a-diaeresis ?ä)
221 (case-table (copy-case-table (standard-case-table)))
222 (str-hiragana-a (char-to-string hiragana-a))
223 (str-a-diaeresis (char-to-string a-diaeresis))
224 (string (concat str-hiragana-a str-a-diaeresis)))
225 (put-case-table-pair hiragana-a a-diaeresis case-table)
226 (with-temp-buffer
227 (set-case-table case-table)
228 (insert hiragana-a "abcdefg" a-diaeresis)
229 ;; forward
230 (goto-char (point-min))
231 (Assert (not (search-forward "ö" nil t)))
232 (goto-char (point-min))
233 (Assert (eq 2 (search-forward str-hiragana-a nil t)))
234 (goto-char (point-min))
235 (Assert (eq 2 (search-forward str-a-diaeresis nil t)))
236 (goto-char (1+ (point-min)))
237 (Assert (eq (point-max)
238 (search-forward str-hiragana-a nil t)))
239 (goto-char (1+ (point-min)))
240 (Assert (eq (point-max)
241 (search-forward str-a-diaeresis nil t)))
242 ;; backward
243 (goto-char (point-max))
244 (Assert (not (search-backward "ö" nil t)))
245 (goto-char (point-max))
246 (Assert (eq (1- (point-max)) (search-backward str-hiragana-a nil t)))
247 (goto-char (point-max))
248 (Assert (eq (1- (point-max)) (search-backward str-a-diaeresis nil t)))
249 (goto-char (1- (point-max)))
250 (Assert (eq 1 (search-backward str-hiragana-a nil t)))
251 (goto-char (1- (point-max)))
252 (Assert (eq 1 (search-backward str-a-diaeresis nil t)))
253 (replace-match "a")
254 (Assert (looking-at (format "abcdefg%c" a-diaeresis))))
255 (with-temp-buffer
256 (set-case-table case-table)
257 (insert string)
258 (insert string)
259 (insert string)
260 (insert string)
261 (insert string)
262 (goto-char (point-min))
263 (Assert (eq 11 (search-forward string nil t 5)))
264 (goto-char (point-min))
265 (Assert (not (search-forward string nil t 6)))
266 (goto-char (point-max))
267 (Assert (eq 1 (search-backward string nil t 5)))
268 (goto-char (point-max))
269 (Assert (not (search-backward string nil t 6))))))
270