cgit.sxemacs.org Git - sxemacs/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 SXEmacs.
  11
  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.
  16
  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.
  21
  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/>.
  24
  25 ;;; Synched up with: Not in FSF.
  26
  27 ;;; Commentary:
  28
  29 ;; Test case-table related functionality.
  30
  31 (Assert (case-table-p (standard-case-table)))
  32 ;; Old case table test.
  33 (Assert (case-table-p (list
  34                        (make-string 256 ?a)
  35                        nil nil nil)))
  36 (Assert (case-table-p (list
  37                        (make-string 256 ?a)
  38                        (make-string 256 ?b)
  39                        nil nil)))
  40 (Assert (case-table-p (list
  41                        (make-string 256 ?a)
  42                        (make-string 256 ?b)
  43                        (make-string 256 ?c)
  44                        nil)))
  45 (Assert (case-table-p (list
  46                        (make-string 256 ?a)
  47                        (make-string 256 ?b)
  48                        (make-string 256 ?c)
  49                        (make-string 256 ?d))))
  50 (Assert (not (case-table-p (list (make-string 256 ?a)
  51                                  (make-string 256 ?b)
  52                                  (make-string 256 ?c)
  53                                  (make-string 254 ?d)))))
  54 (Assert (not (case-table-p (list (make-string 256 ?a)))))
  55
  56 (Assert (case-table-p (set-case-table (current-case-table))))
  57
  58 (defvar string-0-through-32
  59   (let ((result (make-string 33 (int-to-char 0))))
  60     (dotimes (i 33)
  61       (aset result i (int-to-char i)))
  62     result)
  63   "String containing characters from code point 0 (NUL) through 32 (SPC).")
  64
  65 (defvar string-127-through-160
  66   (let ((result (make-string 34 (int-to-char 0))))
  67     (dotimes (i 34)
  68       (aset result i (int-to-char (+ 127 i))))
  69     result)
  70   "String containing characters from code point 127 (DEL) through 160
  71 \(no-break-space).")
  72
  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                 "¡¢£¤¥¦§¨©ª«¬®¯°±²³´µ¶·¸¹º»¼½¾¿àáâãäåæçèéêëìíîïðñòóôõö×øùúûüýþßàáâãäåæçèéêëìíîïðñòóôõö÷øùúûüýþÿ"))
  79        (upcase-string
  80         (concat string-0-through-32
  81                 "!\"#$%&'()*+,-./0123456789:;<=>?@abcdefghijklmnopqrstuvwxyz[\\]^_`ABCDEFGHIJKLMNOPQRSTUVWXYZ{|}~"
  82                 string-127-through-160
  83                 "¡¢£¤¥¦§¨©ª«¬®¯°±²³´µ¶·¸¹º»¼½¾¿àáâãäåæçèéêëìíîïðñòóôõö×øùúûüýþßÀÁÂÃÄÅÆÇÈÉÊËÌÍÎÏÐÑÒÓÔÕÖ÷ØÙÚÛÜÝÞÿ"))
  84        (table (standard-case-table)))
  85   (dotimes (i 256)
  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)))))
  90
  91 (Check-Error-Message error "Char case must be downcase or upcase"
  92                      (get-case-table 'foo ?a (standard-case-table)))
  93
  94 (Assert
  95  (string=
  96   (upcase "!\"#$%&'()*+,-./0123456789:;<=>?@abcdefghijklmnopqrstuvwxyz")
  97   "!\"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ"))
  98
  99 (Assert
 100  (string=
 101   (upcase "!\"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ")
 102   "!\"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ"))
 103
 104 (Assert
 105  (string=
 106   (upcase " ¡¢£¤¥¦§¨©ª«¬®¯°±²³´µ¶·¸¹º»¼½¾¿àáâãäåæçèéêëìíîïðñòóôõö×øùúûüýþßàáâãäåæçèéêëìíîïðñòóôõö÷øùúûüýþÿ")
 107   " ¡¢£¤¥¦§¨©ª«¬®¯°±²³´µ¶·¸¹º»¼½¾¿ÀÁÂÃÄÅÆÇÈÉÊËÌÍÎÏÐÑÒÓÔÕÖ×ØÙÚÛÜÝÞßÀÁÂÃÄÅÆÇÈÉÊËÌÍÎÏÐÑÒÓÔÕÖ÷ØÙÚÛÜÝÞÿ"))
 108
 109 (Assert
 110  (string=
 111   (upcase " ¡¢£¤¥¦§¨©ª«¬®¯°±²³´µ¶·¸¹º»¼½¾¿ÀÁÂÃÄÅÆÇÈÉÊËÌÍÎÏÐÑÒÓÔÕÖ×ØÙÚÛÜÝÞßÀÁÂÃÄÅÆÇÈÉÊËÌÍÎÏÐÑÒÓÔÕÖ÷ØÙÚÛÜÝÞÿ")
 112   " ¡¢£¤¥¦§¨©ª«¬®¯°±²³´µ¶·¸¹º»¼½¾¿ÀÁÂÃÄÅÆÇÈÉÊËÌÍÎÏÐÑÒÓÔÕÖ×ØÙÚÛÜÝÞßÀÁÂÃÄÅÆÇÈÉÊËÌÍÎÏÐÑÒÓÔÕÖ÷ØÙÚÛÜÝÞÿ"))
 113
 114 (Assert
 115  (string=
 116   (downcase "!\"#$%&'()*+,-./0123456789:;<=>?@abcdefghijklmnopqrstuvwxyz")
 117   "!\"#$%&'()*+,-./0123456789:;<=>?@abcdefghijklmnopqrstuvwxyz"))
 118
 119 (Assert
 120  (string=
 121   (downcase "!\"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ")
 122   "!\"#$%&'()*+,-./0123456789:;<=>?@abcdefghijklmnopqrstuvwxyz"))
 123
 124 (Assert
 125  (string=
 126   (downcase " ¡¢£¤¥¦§¨©ª«¬®¯°±²³´µ¶·¸¹º»¼½¾¿àáâãäåæçèéêëìíîïðñòóôõö×øùúûüýþßàáâãäåæçèéêëìíîïðñòóôõö÷øùúûüýþÿ")
 127   " ¡¢£¤¥¦§¨©ª«¬®¯°±²³´µ¶·¸¹º»¼½¾¿àáâãäåæçèéêëìíîïðñòóôõö×øùúûüýþßàáâãäåæçèéêëìíîïðñòóôõö÷øùúûüýþÿ"))
 128
 129 (Assert
 130  (string=
 131   (downcase " ¡¢£¤¥¦§¨©ª«¬®¯°±²³´µ¶·¸¹º»¼½¾¿ÀÁÂÃÄÅÆÇÈÉÊËÌÍÎÏÐÑÒÓÔÕÖ×ØÙÚÛÜÝÞßÀÁÂÃÄÅÆÇÈÉÊËÌÍÎÏÐÑÒÓÔÕÖ÷ØÙÚÛÜÝÞÿ")
 132   " ¡¢£¤¥¦§¨©ª«¬®¯°±²³´µ¶·¸¹º»¼½¾¿àáâãäåæçèéêëìíîïðñòóôõö×øùúûüýþßàáâãäåæçèéêëìíîïðñòóôõö÷øùúûüýþÿ"))
 133
 134 ;; Old case table format test.
 135 (with-temp-buffer
 136   (set-case-table
 137    (list
 138     (concat string-0-through-32
 139              "!\"#$%&'()*+,-./0123456789:;<=>?@abcdefghijklmnopqrstuvwxyz[\\]^_`abcdefghijklmnopqrstuvwxyz{|}~"
 140              string-127-through-160
 141              "¡¢£¤¥¦§¨©ª«¬®¯°±²³´µ¶·¸¹º»¼½¾¿àáâãäåæçèéêëìíîïðñòóôõö×øùúûüýþßàáâãäåæçèéêëìíîïðñòóôõö÷øùúûüýþÿ")
 142      nil nil nil))
 143   (Assert
 144    (string=
 145     (upcase "!\"#$%&'()*+,-./0123456789:;<=>?@abcdefghijklmnopqrstuvwxyz")
 146     "!\"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ"))
 147   (Assert
 148    (string=
 149     (downcase "!\"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ")
 150     "!\"#$%&'()*+,-./0123456789:;<=>?@abcdefghijklmnopqrstuvwxyz")))
 151
 152 (with-temp-buffer
 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))
 161
 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))))
 169
 170 (with-temp-buffer
 171   (insert "abcdefghijklmnäopqrstuÄvwxyz")
 172   ;; case insensitive
 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)))
 186   ;; case sensitive
 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)))
 195   (goto-char 16)
 196   (Assert (eq 24 (search-forward "Ä" nil t)))
 197   (goto-char (point-max))
 198   (Assert (eq 15 (search-backward "ä" nil t)))
 199   (goto-char 15)
 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))))
 204
 205 (with-temp-buffer
 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))))
 215
 216 (when (featurep 'mule)
 217   (let* ((hiragana-a (make-char 'japanese-jisx0208 36 34))
 218          (a-diaeresis ?ä)
 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)
 224     (with-temp-buffer
 225       (set-case-table case-table)
 226       (insert hiragana-a "abcdefg" a-diaeresis)
 227       ;; forward
 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)))
 240       ;; backward
 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)))
 251       (replace-match "a")
 252       (Assert (looking-at (format "abcdefg%c" a-diaeresis))))
 253     (with-temp-buffer
 254       (set-case-table case-table)
 255       (insert string)
 256       (insert string)
 257       (insert string)
 258       (insert string)
 259       (insert string)
 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))))))