1 ;;; -*- coding: iso-8859-1 -*-
3 ;; Copyright (C) 2000 Free Software Foundation, Inc.
5 ;; Author: Yoshiki Hayashi <yoshiki@xemacs.org>
6 ;; Maintainer: Yoshiki Hayashi <yoshiki@xemacs.org>
10 ;; This file is part of SXEmacs.
12 ;; SXEmacs is free software: you can redistribute it and/or modify it
13 ;; under the terms of the GNU General Public License as published by the
14 ;; Free Software Foundation, either version 3 of the License, or (at your
15 ;; option) any later version.
17 ;; SXEmacs is distributed in the hope that it will be
18 ;; useful, but 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.
22 ;; You should have received a copy of the GNU General Public License
23 ;; along with this program. If not, see <http://www.gnu.org/licenses/>.
25 ;;; Synched up with: Not in FSF.
29 ;; Test case-table related functionality.
31 (Assert (case-table-p (standard-case-table)))
32 ;; Old case table test.
33 (Assert (case-table-p (list
36 (Assert (case-table-p (list
40 (Assert (case-table-p (list
45 (Assert (case-table-p (list
49 (make-string 256 ?d))))
50 (Assert (not (case-table-p (list (make-string 256 ?a)
53 (make-string 254 ?d)))))
54 (Assert (not (case-table-p (list (make-string 256 ?a)))))
56 (Assert (case-table-p (set-case-table (current-case-table))))
58 (defvar string-0-through-32
59 (let ((result (make-string 33 (int-to-char 0))))
61 (aset result i (int-to-char i)))
63 "String containing characters from code point 0 (NUL) through 32 (SPC).")
65 (defvar string-127-through-160
66 (let ((result (make-string 34 (int-to-char 0))))
68 (aset result i (int-to-char (+ 127 i))))
70 "String containing characters from code point 127 (DEL) through 160
73 ;; Case table sanity check.
74 (let ((downcase-string
75 (concat string-0-through-32
76 "!\"#$%&'()*+,-./0123456789:;<=>?@abcdefghijklmnopqrstuvwxyz[\\]^_`abcdefghijklmnopqrstuvwxyz{|}~"
77 string-127-through-160
78 "¡¢£¤¥¦§¨©ª«¬®¯°±²³´µ¶·¸¹º»¼½¾¿àáâãäåæçèéêëìíîïðñòóôõö×øùúûüýþßàáâãäåæçèéêëìíîïðñòóôõö÷øùúûüýþÿ"))
80 (concat string-0-through-32
81 "!\"#$%&'()*+,-./0123456789:;<=>?@abcdefghijklmnopqrstuvwxyz[\\]^_`ABCDEFGHIJKLMNOPQRSTUVWXYZ{|}~"
82 string-127-through-160
83 "¡¢£¤¥¦§¨©ª«¬®¯°±²³´µ¶·¸¹º»¼½¾¿àáâãäåæçèéêëìíîïðñòóôõö×øùúûüýþßÀÁÂÃÄÅÆÇÈÉÊËÌÍÎÏÐÑÒÓÔÕÖ÷ØÙÚÛÜÝÞÿ"))
84 (table (standard-case-table)))
86 (Assert (eq (get-case-table 'downcase (int-to-char i) table)
87 (aref downcase-string i)))
88 (Assert (eq (get-case-table 'upcase (int-to-char i) table)
89 (aref upcase-string i)))))
91 (Check-Error-Message error "Char case must be downcase or upcase"
92 (get-case-table 'foo ?a (standard-case-table)))
96 (upcase "!\"#$%&'()*+,-./0123456789:;<=>?@abcdefghijklmnopqrstuvwxyz")
97 "!\"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ"))
101 (upcase "!\"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ")
102 "!\"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ"))
106 (upcase " ¡¢£¤¥¦§¨©ª«¬®¯°±²³´µ¶·¸¹º»¼½¾¿àáâãäåæçèéêëìíîïðñòóôõö×øùúûüýþßàáâãäåæçèéêëìíîïðñòóôõö÷øùúûüýþÿ")
107 " ¡¢£¤¥¦§¨©ª«¬®¯°±²³´µ¶·¸¹º»¼½¾¿ÀÁÂÃÄÅÆÇÈÉÊËÌÍÎÏÐÑÒÓÔÕÖ×ØÙÚÛÜÝÞßÀÁÂÃÄÅÆÇÈÉÊËÌÍÎÏÐÑÒÓÔÕÖ÷ØÙÚÛÜÝÞÿ"))
111 (upcase " ¡¢£¤¥¦§¨©ª«¬®¯°±²³´µ¶·¸¹º»¼½¾¿ÀÁÂÃÄÅÆÇÈÉÊËÌÍÎÏÐÑÒÓÔÕÖ×ØÙÚÛÜÝÞßÀÁÂÃÄÅÆÇÈÉÊËÌÍÎÏÐÑÒÓÔÕÖ÷ØÙÚÛÜÝÞÿ")
112 " ¡¢£¤¥¦§¨©ª«¬®¯°±²³´µ¶·¸¹º»¼½¾¿ÀÁÂÃÄÅÆÇÈÉÊËÌÍÎÏÐÑÒÓÔÕÖ×ØÙÚÛÜÝÞßÀÁÂÃÄÅÆÇÈÉÊËÌÍÎÏÐÑÒÓÔÕÖ÷ØÙÚÛÜÝÞÿ"))
116 (downcase "!\"#$%&'()*+,-./0123456789:;<=>?@abcdefghijklmnopqrstuvwxyz")
117 "!\"#$%&'()*+,-./0123456789:;<=>?@abcdefghijklmnopqrstuvwxyz"))
121 (downcase "!\"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ")
122 "!\"#$%&'()*+,-./0123456789:;<=>?@abcdefghijklmnopqrstuvwxyz"))
126 (downcase " ¡¢£¤¥¦§¨©ª«¬®¯°±²³´µ¶·¸¹º»¼½¾¿àáâãäåæçèéêëìíîïðñòóôõö×øùúûüýþßàáâãäåæçèéêëìíîïðñòóôõö÷øùúûüýþÿ")
127 " ¡¢£¤¥¦§¨©ª«¬®¯°±²³´µ¶·¸¹º»¼½¾¿àáâãäåæçèéêëìíîïðñòóôõö×øùúûüýþßàáâãäåæçèéêëìíîïðñòóôõö÷øùúûüýþÿ"))
131 (downcase " ¡¢£¤¥¦§¨©ª«¬®¯°±²³´µ¶·¸¹º»¼½¾¿ÀÁÂÃÄÅÆÇÈÉÊËÌÍÎÏÐÑÒÓÔÕÖ×ØÙÚÛÜÝÞßÀÁÂÃÄÅÆÇÈÉÊËÌÍÎÏÐÑÒÓÔÕÖ÷ØÙÚÛÜÝÞÿ")
132 " ¡¢£¤¥¦§¨©ª«¬®¯°±²³´µ¶·¸¹º»¼½¾¿àáâãäåæçèéêëìíîïðñòóôõö×øùúûüýþßàáâãäåæçèéêëìíîïðñòóôõö÷øùúûüýþÿ"))
134 ;; Old case table format test.
138 (concat string-0-through-32
139 "!\"#$%&'()*+,-./0123456789:;<=>?@abcdefghijklmnopqrstuvwxyz[\\]^_`abcdefghijklmnopqrstuvwxyz{|}~"
140 string-127-through-160
141 "¡¢£¤¥¦§¨©ª«¬®¯°±²³´µ¶·¸¹º»¼½¾¿àáâãäåæçèéêëìíîïðñòóôõö×øùúûüýþßàáâãäåæçèéêëìíîïðñòóôõö÷øùúûüýþÿ")
145 (upcase "!\"#$%&'()*+,-./0123456789:;<=>?@abcdefghijklmnopqrstuvwxyz")
146 "!\"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ"))
149 (downcase "!\"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ")
150 "!\"#$%&'()*+,-./0123456789:;<=>?@abcdefghijklmnopqrstuvwxyz")))
153 (insert "Test Buffer")
154 (let ((case-fold-search t))
155 (goto-char (point-min))
156 (Assert (eq (search-forward "test buffer" nil t) 12))
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))
162 (setq case-fold-search nil)
163 (goto-char (point-min))
164 (Assert (not (search-forward "test buffer" nil t)))
165 (goto-char (point-min))
166 (Assert (not (search-forward "Test buffer" nil t)))
167 (goto-char (point-min))
168 (Assert (eq (search-forward "Test Buffer" nil t) 12))))
171 (insert "abcdefghijklmnäopqrstuÄvwxyz")
173 (Assert (not (search-forward "ö" nil t)))
174 (goto-char (point-min))
175 (Assert (eq 16 (search-forward "ä" nil t)))
176 (Assert (eq 24 (search-forward "ä" nil t)))
177 (goto-char (point-min))
178 (Assert (eq 16 (search-forward "Ä" nil t)))
179 (Assert (eq 24 (search-forward "Ä" nil t)))
180 (goto-char (point-max))
181 (Assert (eq 23 (search-backward "ä" nil t)))
182 (Assert (eq 15 (search-backward "ä" nil t)))
183 (goto-char (point-max))
184 (Assert (eq 23 (search-backward "Ä" nil t)))
185 (Assert (eq 15 (search-backward "Ä" nil t)))
187 (setq case-fold-search nil)
188 (goto-char (point-min))
189 (Assert (not (search-forward "ö" nil t)))
190 (goto-char (point-min))
191 (Assert (eq 16 (search-forward "ä" nil t)))
192 (Assert (not (search-forward "ä" nil t)))
193 (goto-char (point-min))
194 (Assert (eq 24 (search-forward "Ä" nil t)))
196 (Assert (eq 24 (search-forward "Ä" nil t)))
197 (goto-char (point-max))
198 (Assert (eq 15 (search-backward "ä" nil t)))
200 (Assert (not (search-backward "ä" nil t)))
201 (goto-char (point-max))
202 (Assert (eq 23 (search-backward "Ä" nil t)))
203 (Assert (not (search-backward "Ä" nil t))))
206 (insert "aaaaäÄäÄäÄäÄäÄbbbb")
207 (goto-char (point-min))
208 (Assert (eq 15 (search-forward "ää" nil t 5)))
209 (goto-char (point-min))
210 (Assert (not (search-forward "ää" nil t 6)))
211 (goto-char (point-max))
212 (Assert (eq 5 (search-backward "ää" nil t 5)))
213 (goto-char (point-max))
214 (Assert (not (search-backward "ää" nil t 6))))
216 (when (featurep 'mule)
217 (let* ((hiragana-a (make-char 'japanese-jisx0208 36 34))
219 (case-table (copy-case-table (standard-case-table)))
220 (str-hiragana-a (char-to-string hiragana-a))
221 (str-a-diaeresis (char-to-string a-diaeresis))
222 (string (concat str-hiragana-a str-a-diaeresis)))
223 (put-case-table-pair hiragana-a a-diaeresis case-table)
225 (set-case-table case-table)
226 (insert hiragana-a "abcdefg" a-diaeresis)
228 (goto-char (point-min))
229 (Assert (not (search-forward "ö" nil t)))
230 (goto-char (point-min))
231 (Assert (eq 2 (search-forward str-hiragana-a nil t)))
232 (goto-char (point-min))
233 (Assert (eq 2 (search-forward str-a-diaeresis nil t)))
234 (goto-char (1+ (point-min)))
235 (Assert (eq (point-max)
236 (search-forward str-hiragana-a nil t)))
237 (goto-char (1+ (point-min)))
238 (Assert (eq (point-max)
239 (search-forward str-a-diaeresis nil t)))
241 (goto-char (point-max))
242 (Assert (not (search-backward "ö" nil t)))
243 (goto-char (point-max))
244 (Assert (eq (1- (point-max)) (search-backward str-hiragana-a nil t)))
245 (goto-char (point-max))
246 (Assert (eq (1- (point-max)) (search-backward str-a-diaeresis nil t)))
247 (goto-char (1- (point-max)))
248 (Assert (eq 1 (search-backward str-hiragana-a nil t)))
249 (goto-char (1- (point-max)))
250 (Assert (eq 1 (search-backward str-a-diaeresis nil t)))
252 (Assert (looking-at (format "abcdefg%c" a-diaeresis))))
254 (set-case-table case-table)
260 (goto-char (point-min))
261 (Assert (eq 11 (search-forward string nil t 5)))
262 (goto-char (point-min))
263 (Assert (not (search-forward string nil t 6)))
264 (goto-char (point-max))
265 (Assert (eq 1 (search-backward string nil t 5)))
266 (goto-char (point-max))
267 (Assert (not (search-backward string nil t 6))))))