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 XEmacs.
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)
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.
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
27 ;;; Synched up with: Not in FSF.
31 ;; Test case-table related functionality.
33 (Assert (case-table-p (standard-case-table)))
34 ;; Old case table test.
35 (Assert (case-table-p (list
38 (Assert (case-table-p (list
42 (Assert (case-table-p (list
47 (Assert (case-table-p (list
51 (make-string 256 ?d))))
52 (Assert (not (case-table-p (list (make-string 256 ?a)
55 (make-string 254 ?d)))))
56 (Assert (not (case-table-p (list (make-string 256 ?a)))))
58 (Assert (case-table-p (set-case-table (current-case-table))))
60 ;; Case table sanity check.
61 (let ((downcase-string "
\0\ 1\ 2\ 3\ 4\ 5\ 6\a\b
62 \v\f\r\ e\ f\10\11\12\13\14\15\16\17\18\19\1a\e\1c\1d\1e\1f !\"#$%&'()*+,-./0123456789:;<=>?@abcdefghijklmnopqrstuvwxyz[\\]^_`abcdefghijklmnopqrstuvwxyz{|}~
\7f\80\81\82\83\84\85\86\87\88\89\8a\8b\8c\8d\8e\8f\90\91\92\93\94\95\96\97\98\99\9a\9b\9c\9d\9e\9f ¡¢£¤¥¦§¨©ª«¬®¯°±²³´µ¶·¸¹º»¼½¾¿àáâãäåæçèéêëìíîïðñòóôõö×øùúûüýþßàáâãäåæçèéêëìíîïðñòóôõö÷øùúûüýþÿ")
63 (upcase-string "
\0\ 1\ 2\ 3\ 4\ 5\ 6\a\b
64 \v\f\r\ e\ f\10\11\12\13\14\15\16\17\18\19\1a\e\1c\1d\1e\1f !\"#$%&'()*+,-./0123456789:;<=>?@abcdefghijklmnopqrstuvwxyz[\\]^_`ABCDEFGHIJKLMNOPQRSTUVWXYZ{|}~
\7f\80\81\82\83\84\85\86\87\88\89\8a\8b\8c\8d\8e\8f\90\91\92\93\94\95\96\97\98\99\9a\9b\9c\9d\9e\9f ¡¢£¤¥¦§¨©ª«¬®¯°±²³´µ¶·¸¹º»¼½¾¿àáâãäåæçèéêëìíîïðñòóôõö×øùúûüýþßÀÁÂÃÄÅÆÇÈÉÊËÌÍÎÏÐÑÒÓÔÕÖ÷ØÙÚÛÜÝÞÿ")
65 (table (standard-case-table)))
67 (Assert (eq (get-case-table 'downcase (int-to-char i) table)
68 (aref downcase-string i)))
69 (Assert (eq (get-case-table 'upcase (int-to-char i) table)
70 (aref upcase-string i)))))
72 (Check-Error-Message error "Char case must be downcase or upcase"
73 (get-case-table 'foo ?a (standard-case-table)))
77 (upcase "!\"#$%&'()*+,-./0123456789:;<=>?@abcdefghijklmnopqrstuvwxyz")
78 "!\"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ"))
82 (upcase "!\"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ")
83 "!\"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ"))
87 (upcase " ¡¢£¤¥¦§¨©ª«¬®¯°±²³´µ¶·¸¹º»¼½¾¿àáâãäåæçèéêëìíîïðñòóôõö×øùúûüýþßàáâãäåæçèéêëìíîïðñòóôõö÷øùúûüýþÿ")
88 " ¡¢£¤¥¦§¨©ª«¬®¯°±²³´µ¶·¸¹º»¼½¾¿ÀÁÂÃÄÅÆÇÈÉÊËÌÍÎÏÐÑÒÓÔÕÖ×ØÙÚÛÜÝÞßÀÁÂÃÄÅÆÇÈÉÊËÌÍÎÏÐÑÒÓÔÕÖ÷ØÙÚÛÜÝÞÿ"))
92 (upcase " ¡¢£¤¥¦§¨©ª«¬®¯°±²³´µ¶·¸¹º»¼½¾¿ÀÁÂÃÄÅÆÇÈÉÊËÌÍÎÏÐÑÒÓÔÕÖ×ØÙÚÛÜÝÞßÀÁÂÃÄÅÆÇÈÉÊËÌÍÎÏÐÑÒÓÔÕÖ÷ØÙÚÛÜÝÞÿ")
93 " ¡¢£¤¥¦§¨©ª«¬®¯°±²³´µ¶·¸¹º»¼½¾¿ÀÁÂÃÄÅÆÇÈÉÊËÌÍÎÏÐÑÒÓÔÕÖ×ØÙÚÛÜÝÞßÀÁÂÃÄÅÆÇÈÉÊËÌÍÎÏÐÑÒÓÔÕÖ÷ØÙÚÛÜÝÞÿ"))
97 (downcase "!\"#$%&'()*+,-./0123456789:;<=>?@abcdefghijklmnopqrstuvwxyz")
98 "!\"#$%&'()*+,-./0123456789:;<=>?@abcdefghijklmnopqrstuvwxyz"))
102 (downcase "!\"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ")
103 "!\"#$%&'()*+,-./0123456789:;<=>?@abcdefghijklmnopqrstuvwxyz"))
107 (downcase " ¡¢£¤¥¦§¨©ª«¬®¯°±²³´µ¶·¸¹º»¼½¾¿àáâãäåæçèéêëìíîïðñòóôõö×øùúûüýþßàáâãäåæçèéêëìíîïðñòóôõö÷øùúûüýþÿ")
108 " ¡¢£¤¥¦§¨©ª«¬®¯°±²³´µ¶·¸¹º»¼½¾¿àáâãäåæçèéêëìíîïðñòóôõö×øùúûüýþßàáâãäåæçèéêëìíîïðñòóôõö÷øùúûüýþÿ"))
112 (downcase " ¡¢£¤¥¦§¨©ª«¬®¯°±²³´µ¶·¸¹º»¼½¾¿ÀÁÂÃÄÅÆÇÈÉÊËÌÍÎÏÐÑÒÓÔÕÖ×ØÙÚÛÜÝÞßÀÁÂÃÄÅÆÇÈÉÊËÌÍÎÏÐÑÒÓÔÕÖ÷ØÙÚÛÜÝÞÿ")
113 " ¡¢£¤¥¦§¨©ª«¬®¯°±²³´µ¶·¸¹º»¼½¾¿àáâãäåæçèéêëìíîïðñòóôõö×øùúûüýþßàáâãäåæçèéêëìíîïðñòóôõö÷øùúûüýþÿ"))
115 ;; Old case table format test.
118 '("
\0\ 1\ 2\ 3\ 4\ 5\ 6\a\b
119 \v\f\r\ e\ f\10\11\12\13\14\15\16\17\18\19\1a\e\1c\1d\1e\1f !\"#$%&'()*+,-./0123456789:;<=>?@abcdefghijklmnopqrstuvwxyz[\\]^_`abcdefghijklmnopqrstuvwxyz{|}~
\7f\80\81\82\83\84\85\86\87\88\89\8a\8b\8c\8d\8e\8f\90\91\92\93\94\95\96\97\98\99\9a\9b\9c\9d\9e\9f ¡¢£¤¥¦§¨©ª«¬®¯°±²³´µ¶·¸¹º»¼½¾¿àáâãäåæçèéêëìíîïðñòóôõö×øùúûüýþßàáâãäåæçèéêëìíîïðñòóôõö÷øùúûüýþÿ"
123 (upcase "!\"#$%&'()*+,-./0123456789:;<=>?@abcdefghijklmnopqrstuvwxyz")
124 "!\"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ"))
127 (downcase "!\"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ")
128 "!\"#$%&'()*+,-./0123456789:;<=>?@abcdefghijklmnopqrstuvwxyz")))
131 (insert "Test Buffer")
132 (let ((case-fold-search t))
133 (goto-char (point-min))
134 (Assert (eq (search-forward "test buffer" nil t) 12))
135 (goto-char (point-min))
136 (Assert (eq (search-forward "Test buffer" nil t) 12))
137 (goto-char (point-min))
138 (Assert (eq (search-forward "Test Buffer" nil t) 12))
140 (setq case-fold-search nil)
141 (goto-char (point-min))
142 (Assert (not (search-forward "test buffer" nil t)))
143 (goto-char (point-min))
144 (Assert (not (search-forward "Test buffer" nil t)))
145 (goto-char (point-min))
146 (Assert (eq (search-forward "Test Buffer" nil t) 12))))
149 (insert "abcdefghijklmnäopqrstuÄvwxyz")
151 (Assert (not (search-forward "ö" nil t)))
152 (goto-char (point-min))
153 (Assert (eq 16 (search-forward "ä" nil t)))
154 (Assert (eq 24 (search-forward "ä" nil t)))
155 (goto-char (point-min))
156 (Assert (eq 16 (search-forward "Ä" nil t)))
157 (Assert (eq 24 (search-forward "Ä" nil t)))
158 (goto-char (point-max))
159 (Assert (eq 23 (search-backward "ä" nil t)))
160 (Assert (eq 15 (search-backward "ä" nil t)))
161 (goto-char (point-max))
162 (Assert (eq 23 (search-backward "Ä" nil t)))
163 (Assert (eq 15 (search-backward "Ä" nil t)))
165 (setq case-fold-search nil)
166 (goto-char (point-min))
167 (Assert (not (search-forward "ö" nil t)))
168 (goto-char (point-min))
169 (Assert (eq 16 (search-forward "ä" nil t)))
170 (Assert (not (search-forward "ä" nil t)))
171 (goto-char (point-min))
172 (Assert (eq 24 (search-forward "Ä" nil t)))
174 (Assert (eq 24 (search-forward "Ä" nil t)))
175 (goto-char (point-max))
176 (Assert (eq 15 (search-backward "ä" nil t)))
178 (Assert (not (search-backward "ä" nil t)))
179 (goto-char (point-max))
180 (Assert (eq 23 (search-backward "Ä" nil t)))
181 (Assert (not (search-backward "Ä" nil t))))
184 (insert "aaaaäÄäÄäÄäÄäÄbbbb")
185 (goto-char (point-min))
186 (Assert (eq 15 (search-forward "ää" nil t 5)))
187 (goto-char (point-min))
188 (Assert (not (search-forward "ää" nil t 6)))
189 (goto-char (point-max))
190 (Assert (eq 5 (search-backward "ää" nil t 5)))
191 (goto-char (point-max))
192 (Assert (not (search-backward "ää" nil t 6))))
194 (when (featurep 'mule)
195 (let* ((hiragana-a (make-char 'japanese-jisx0208 36 34))
197 (case-table (copy-case-table (standard-case-table)))
198 (str-hiragana-a (char-to-string hiragana-a))
199 (str-a-diaeresis (char-to-string a-diaeresis))
200 (string (concat str-hiragana-a str-a-diaeresis)))
201 (put-case-table-pair hiragana-a a-diaeresis case-table)
203 (set-case-table case-table)
204 (insert hiragana-a "abcdefg" a-diaeresis)
206 (goto-char (point-min))
207 (Assert (not (search-forward "ö" nil t)))
208 (goto-char (point-min))
209 (Assert (eq 2 (search-forward str-hiragana-a nil t)))
210 (goto-char (point-min))
211 (Assert (eq 2 (search-forward str-a-diaeresis nil t)))
212 (goto-char (1+ (point-min)))
213 (Assert (eq (point-max)
214 (search-forward str-hiragana-a nil t)))
215 (goto-char (1+ (point-min)))
216 (Assert (eq (point-max)
217 (search-forward str-a-diaeresis nil t)))
219 (goto-char (point-max))
220 (Assert (not (search-backward "ö" nil t)))
221 (goto-char (point-max))
222 (Assert (eq (1- (point-max)) (search-backward str-hiragana-a nil t)))
223 (goto-char (point-max))
224 (Assert (eq (1- (point-max)) (search-backward str-a-diaeresis nil t)))
225 (goto-char (1- (point-max)))
226 (Assert (eq 1 (search-backward str-hiragana-a nil t)))
227 (goto-char (1- (point-max)))
228 (Assert (eq 1 (search-backward str-a-diaeresis nil t)))
230 (Assert (looking-at (format "abcdefg%c" a-diaeresis))))
232 (set-case-table case-table)
238 (goto-char (point-min))
239 (Assert (eq 11 (search-forward string nil t 5)))
240 (goto-char (point-min))
241 (Assert (not (search-forward string nil t 6)))
242 (goto-char (point-max))
243 (Assert (eq 1 (search-backward string nil t 5)))
244 (goto-char (point-max))
245 (Assert (not (search-backward string nil t 6))))))