|
446
|
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
|
|
462
|
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
|
|
446
|
75 ;; Case table sanity check.
|
|
462
|
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)))
|
|
446
|
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
|
|
462
|
139 (list
|
|
|
140 (concat string-0-through-32
|
|
|
141 "!\"#$%&'()*+,-./0123456789:;<=>?@abcdefghijklmnopqrstuvwxyz[\\]^_`abcdefghijklmnopqrstuvwxyz{|}~"
|
|
|
142 string-127-through-160
|
|
|
143 "¡¢£¤¥¦§¨©ª«¬®¯°±²³´µ¶·¸¹º»¼½¾¿àáâãäåæçèéêëìíîïðñòóôõö×øùúûüýþßàáâãäåæçèéêëìíîïðñòóôõö÷øùúûüýþÿ")
|
|
446
|
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
|
