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 (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