git.chise.org Git - chise/xemacs-chise.git.1/blob - tests/automated/case-tests.el

   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 ;; 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)))
  66   (dotimes (i 256)
  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)))))
  71
  72 (Check-Error-Message error "Char case must be downcase or upcase"
  73                      (get-case-table 'foo ?a (standard-case-table)))
  74
  75 (Assert
  76  (string=
  77   (upcase "!\"#$%&'()*+,-./0123456789:;<=>?@abcdefghijklmnopqrstuvwxyz")
  78   "!\"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ"))
  79
  80 (Assert
  81  (string=
  82   (upcase "!\"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ")
  83   "!\"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ"))
  84
  85 (Assert
  86  (string=
  87   (upcase " ¡¢£¤¥¦§¨©ª«¬®¯°±²³´µ¶·¸¹º»¼½¾¿àáâãäåæçèéêëìíîïðñòóôõö×øùúûüýþßàáâãäåæçèéêëìíîïðñòóôõö÷øùúûüýþÿ")
  88   " ¡¢£¤¥¦§¨©ª«¬®¯°±²³´µ¶·¸¹º»¼½¾¿ÀÁÂÃÄÅÆÇÈÉÊËÌÍÎÏÐÑÒÓÔÕÖ×ØÙÚÛÜÝÞßÀÁÂÃÄÅÆÇÈÉÊËÌÍÎÏÐÑÒÓÔÕÖ÷ØÙÚÛÜÝÞÿ"))
  89
  90 (Assert
  91  (string=
  92   (upcase " ¡¢£¤¥¦§¨©ª«¬®¯°±²³´µ¶·¸¹º»¼½¾¿ÀÁÂÃÄÅÆÇÈÉÊËÌÍÎÏÐÑÒÓÔÕÖ×ØÙÚÛÜÝÞßÀÁÂÃÄÅÆÇÈÉÊËÌÍÎÏÐÑÒÓÔÕÖ÷ØÙÚÛÜÝÞÿ")
  93   " ¡¢£¤¥¦§¨©ª«¬®¯°±²³´µ¶·¸¹º»¼½¾¿ÀÁÂÃÄÅÆÇÈÉÊËÌÍÎÏÐÑÒÓÔÕÖ×ØÙÚÛÜÝÞßÀÁÂÃÄÅÆÇÈÉÊËÌÍÎÏÐÑÒÓÔÕÖ÷ØÙÚÛÜÝÞÿ"))
  94
  95 (Assert
  96  (string=
  97   (downcase "!\"#$%&'()*+,-./0123456789:;<=>?@abcdefghijklmnopqrstuvwxyz")
  98   "!\"#$%&'()*+,-./0123456789:;<=>?@abcdefghijklmnopqrstuvwxyz"))
  99
 100 (Assert
 101  (string=
 102   (downcase "!\"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ")
 103   "!\"#$%&'()*+,-./0123456789:;<=>?@abcdefghijklmnopqrstuvwxyz"))
 104
 105 (Assert
 106  (string=
 107   (downcase " ¡¢£¤¥¦§¨©ª«¬®¯°±²³´µ¶·¸¹º»¼½¾¿àáâãäåæçèéêëìíîïðñòóôõö×øùúûüýþßàáâãäåæçèéêëìíîïðñòóôõö÷øùúûüýþÿ")
 108   " ¡¢£¤¥¦§¨©ª«¬®¯°±²³´µ¶·¸¹º»¼½¾¿àáâãäåæçèéêëìíîïðñòóôõö×øùúûüýþßàáâãäåæçèéêëìíîïðñòóôõö÷øùúûüýþÿ"))
 109
 110 (Assert
 111  (string=
 112   (downcase " ¡¢£¤¥¦§¨©ª«¬®¯°±²³´µ¶·¸¹º»¼½¾¿ÀÁÂÃÄÅÆÇÈÉÊËÌÍÎÏÐÑÒÓÔÕÖ×ØÙÚÛÜÝÞßÀÁÂÃÄÅÆÇÈÉÊËÌÍÎÏÐÑÒÓÔÕÖ÷ØÙÚÛÜÝÞÿ")
 113   " ¡¢£¤¥¦§¨©ª«¬®¯°±²³´µ¶·¸¹º»¼½¾¿àáâãäåæçèéêëìíîïðñòóôõö×øùúûüýþßàáâãäåæçèéêëìíîïðñòóôõö÷øùúûüýþÿ"))
 114
 115 ;; Old case table format test.
 116 (with-temp-buffer
 117   (set-case-table
 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 ¡¢£¤¥¦§¨©ª«¬®¯°±²³´µ¶·¸¹º»¼½¾¿àáâãäåæçèéêëìíîïðñòóôõö×øùúûüýþßàáâãäåæçèéêëìíîïðñòóôõö÷øùúûüýþÿ"
 120      nil nil nil))
 121   (Assert
 122    (string=
 123     (upcase "!\"#$%&'()*+,-./0123456789:;<=>?@abcdefghijklmnopqrstuvwxyz")
 124     "!\"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ"))
 125   (Assert
 126    (string=
 127     (downcase "!\"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ")
 128     "!\"#$%&'()*+,-./0123456789:;<=>?@abcdefghijklmnopqrstuvwxyz")))
 129
 130 (with-temp-buffer
 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))
 139
 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))))
 147
 148 (with-temp-buffer
 149   (insert "abcdefghijklmnäopqrstuÄvwxyz")
 150   ;; case insensitive
 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)))
 164   ;; case sensitive
 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)))
 173   (goto-char 16)
 174   (Assert (eq 24 (search-forward "Ä" nil t)))
 175   (goto-char (point-max))
 176   (Assert (eq 15 (search-backward "ä" nil t)))
 177   (goto-char 15)
 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))))
 182
 183 (with-temp-buffer
 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))))
 193
 194 (when (featurep 'mule)
 195   (let* ((hiragana-a (make-char 'japanese-jisx0208 36 34))
 196          (a-diaeresis ?ä)
 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)
 202     (with-temp-buffer
 203       (set-case-table case-table)
 204       (insert hiragana-a "abcdefg" a-diaeresis)
 205       ;; forward
 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)))
 218       ;; backward
 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)))
 229       (replace-match "a")
 230       (Assert (looking-at (format "abcdefg%c" a-diaeresis))))
 231     (with-temp-buffer
 232       (set-case-table case-table)
 233       (insert string)
 234       (insert string)
 235       (insert string)
 236       (insert string)
 237       (insert string)
 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))))))
 246