view tests/automated/case-tests.el @ 558:ed498ef2108b

[xemacs-hg @ 2001-05-23 09:59:33 by ben] xemacs.mak: call `ver' to get the exact os version and put it in the installation; suggestion from adrian. behavior-defs.el: Add scroll-in-place, jka-compr, efs, fix up some things. pop.c: Remove BROKEN_CYGWIN. etc\sample.init.el: Rewrite to be much more careful about loading features -- now it decays gracefully even in the complete absence of packages. Also avoid doing obnoxious things when loading efs. configure.in: add some support for eventually turning on file coding by default. Fix numerous places where AC_MSG_WARN had quotes around its arg, which is bad. Replace with []. Same for AC_MSG_ERROR. s\cygwin32.h, s\mingw32.h: remove support for way old beta versions of cygwin. don't put -Wno-sign-compare in the system switches; this isn't a system issue. define BROKEN_SIGIO for cygwin to get C-g support. device-msw.c: signal an error rather than crash with an unavailable network printer (from Mike Alexander). event-msw.c: cleanup headers. fix (hopefully) an error with data corruption when sending to a network connection. fileio.c: Fix evil code that attempts to handle the ~user prefix by (a) always assuming we're referencing ourselves and not even verifying the user -- hence any file with a tilde as its first char is invalid! (b) if there wasn't a slash following the filename, the pointer was set *past* the end of file and we started reading from uninitialized memory. Now we simply treat these as files, always. optionally for 21.4 (doc fix): lread.c: cambia de pas_de_lache_ici -- al minimo usa la palabra certa. frame.c: fix warnings. emacs.c, nt.c, ntproc.c, process-nt.c, realpath.c, unexnt.c: rename MAX_PATH to standard PATH_MAX. process-nt.c, realpath.c: cleanup headers. process-unix.c, sysdep.c, systime.h, syswindows.h: kill BROKEN_CYGWIN and support for way old beta versions of cygwin. sysfile.h: use _MAX_PATH (Windows) preferentially for PATH_MAX if defined. include io.h on Cygwin (we need get_osfhandle()). include sys/fcntl.h always, since we were including it in various header files anyway. unexcw.c: fix up style to conform to standard. remove duplicate definition of PERROR. buffer.c: comment change. database.c, debug.h, device-tty.c, dired-msw.c, glyphs-msw.c: header cleanups (remove places that directly include a system header file, because we have our own layer to do this more cleanly and portably); indentation fixes.
author ben
date Wed, 23 May 2001 09:59:48 +0000 (2001-05-23)
parents 0784d089fdc9
children df576f30c1d8
line wrap: on
line source
;;; -*- coding: iso-8859-1 -*-

;; Copyright (C) 2000 Free Software Foundation, Inc.

;; Author: Yoshiki Hayashi  <yoshiki@xemacs.org>
;; Maintainer: Yoshiki Hayashi  <yoshiki@xemacs.org>
;; Created: 2000
;; Keywords: tests

;; This file is part of XEmacs.

;; XEmacs is free software; you can redistribute it and/or modify it
;; under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.

;; XEmacs is distributed in the hope that it will be useful, but
;; WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
;; General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with XEmacs; see the file COPYING.  If not, write to the Free
;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
;; 02111-1307, USA.

;;; Synched up with: Not in FSF.

;;; Commentary:

;; Test case-table related functionality.

(Assert (case-table-p (standard-case-table)))
;; Old case table test.
(Assert (case-table-p (list
		       (make-string 256 ?a)
		       nil nil nil)))
(Assert (case-table-p (list
		       (make-string 256 ?a)
		       (make-string 256 ?b)
		       nil nil)))
(Assert (case-table-p (list
		       (make-string 256 ?a)
		       (make-string 256 ?b)
		       (make-string 256 ?c)
		       nil)))
(Assert (case-table-p (list
		       (make-string 256 ?a)
		       (make-string 256 ?b)
		       (make-string 256 ?c)
		       (make-string 256 ?d))))
(Assert (not (case-table-p (list (make-string 256 ?a)
				 (make-string 256 ?b)
				 (make-string 256 ?c)
				 (make-string 254 ?d)))))
(Assert (not (case-table-p (list (make-string 256 ?a)))))

(Assert (case-table-p (set-case-table (current-case-table))))

(defvar string-0-through-32
  (let ((result (make-string 33 (int-to-char 0))))
    (dotimes (i 33)
      (aset result i (int-to-char i)))
    result)
  "String containing characters from code point 0 (NUL) through 32 (SPC).")

(defvar string-127-through-160
  (let ((result (make-string 34 (int-to-char 0))))
    (dotimes (i 34)
      (aset result i (int-to-char (+ 127 i))))
    result)
  "String containing characters from code point 127 (DEL) through 160
\(no-break-space).")

;; Case table sanity check.
(let ((downcase-string
       (concat string-0-through-32
	       "!\"#$%&'()*+,-./0123456789:;<=>?@abcdefghijklmnopqrstuvwxyz[\\]^_`abcdefghijklmnopqrstuvwxyz{|}~"
	       string-127-through-160
		"�����������������������������������������������������������������������������������������������"))
       (upcase-string
	(concat string-0-through-32
		"!\"#$%&'()*+,-./0123456789:;<=>?@abcdefghijklmnopqrstuvwxyz[\\]^_`ABCDEFGHIJKLMNOPQRSTUVWXYZ{|}~"
		string-127-through-160
		"�����������������������������������������������������������������������������������������������"))
       (table (standard-case-table)))
  (dotimes (i 256)
    (Assert (eq (get-case-table 'downcase (int-to-char i) table)
		(aref downcase-string i)))
    (Assert (eq (get-case-table 'upcase (int-to-char i) table)
		(aref upcase-string i)))))

(Check-Error-Message error "Char case must be downcase or upcase"
		     (get-case-table 'foo ?a (standard-case-table)))

(Assert
 (string=
  (upcase "!\"#$%&'()*+,-./0123456789:;<=>?@abcdefghijklmnopqrstuvwxyz")
  "!\"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ"))

(Assert
 (string=
  (upcase "!\"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ")
  "!\"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ"))

(Assert
 (string=
  (upcase "������������������������������������������������������������������������������������������������")
  "������������������������������������������������������������������������������������������������"))

(Assert
 (string=
  (upcase "������������������������������������������������������������������������������������������������")
  "������������������������������������������������������������������������������������������������"))

(Assert
 (string=
  (downcase "!\"#$%&'()*+,-./0123456789:;<=>?@abcdefghijklmnopqrstuvwxyz")
  "!\"#$%&'()*+,-./0123456789:;<=>?@abcdefghijklmnopqrstuvwxyz"))

(Assert
 (string=
  (downcase "!\"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ")
  "!\"#$%&'()*+,-./0123456789:;<=>?@abcdefghijklmnopqrstuvwxyz"))

(Assert
 (string=
  (downcase "������������������������������������������������������������������������������������������������")
  "������������������������������������������������������������������������������������������������"))

(Assert
 (string=
  (downcase "������������������������������������������������������������������������������������������������")
  "������������������������������������������������������������������������������������������������"))

;; Old case table format test.
(with-temp-buffer
  (set-case-table
   (list
    (concat string-0-through-32
	     "!\"#$%&'()*+,-./0123456789:;<=>?@abcdefghijklmnopqrstuvwxyz[\\]^_`abcdefghijklmnopqrstuvwxyz{|}~"
	     string-127-through-160
	     "�����������������������������������������������������������������������������������������������")
     nil nil nil))
  (Assert
   (string=
    (upcase "!\"#$%&'()*+,-./0123456789:;<=>?@abcdefghijklmnopqrstuvwxyz")
    "!\"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ"))
  (Assert
   (string=
    (downcase "!\"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ")
    "!\"#$%&'()*+,-./0123456789:;<=>?@abcdefghijklmnopqrstuvwxyz")))

(with-temp-buffer
  (insert "Test Buffer")
  (let ((case-fold-search t))
    (goto-char (point-min))
    (Assert (eq (search-forward "test buffer" nil t) 12))
    (goto-char (point-min))
    (Assert (eq (search-forward "Test buffer" nil t) 12))
    (goto-char (point-min))
    (Assert (eq (search-forward "Test Buffer" nil t) 12))

    (setq case-fold-search nil)
    (goto-char (point-min))
    (Assert (not (search-forward "test buffer" nil t)))
    (goto-char (point-min))
    (Assert (not (search-forward "Test buffer" nil t)))
    (goto-char (point-min))
    (Assert (eq (search-forward "Test Buffer" nil t) 12))))

(with-temp-buffer
  (insert "abcdefghijklmn�opqrstu�vwxyz")
  ;; case insensitive
  (Assert (not (search-forward "�" nil t)))
  (goto-char (point-min))
  (Assert (eq 16 (search-forward "�" nil t)))
  (Assert (eq 24 (search-forward "�" nil t)))
  (goto-char (point-min))
  (Assert (eq 16 (search-forward "�" nil t)))
  (Assert (eq 24 (search-forward "�" nil t)))
  (goto-char (point-max))
  (Assert (eq 23 (search-backward "�" nil t)))
  (Assert (eq 15 (search-backward "�" nil t)))
  (goto-char (point-max))
  (Assert (eq 23 (search-backward "�" nil t)))
  (Assert (eq 15 (search-backward "�" nil t)))
  ;; case sensitive
  (setq case-fold-search nil)
  (goto-char (point-min))
  (Assert (not (search-forward "�" nil t)))
  (goto-char (point-min))
  (Assert (eq 16 (search-forward "�" nil t)))
  (Assert (not (search-forward "�" nil t)))
  (goto-char (point-min))
  (Assert (eq 24 (search-forward "�" nil t)))
  (goto-char 16)
  (Assert (eq 24 (search-forward "�" nil t)))
  (goto-char (point-max))
  (Assert (eq 15 (search-backward "�" nil t)))
  (goto-char 15)
  (Assert (not (search-backward "�" nil t)))
  (goto-char (point-max))
  (Assert (eq 23 (search-backward "�" nil t)))
  (Assert (not (search-backward "�" nil t))))

(with-temp-buffer
  (insert "aaaa����������bbbb")
  (goto-char (point-min))
  (Assert (eq 15 (search-forward "��" nil t 5)))
  (goto-char (point-min))
  (Assert (not (search-forward "��" nil t 6)))
  (goto-char (point-max))
  (Assert (eq 5 (search-backward "��" nil t 5)))
  (goto-char (point-max))
  (Assert (not (search-backward "��" nil t 6))))

(when (featurep 'mule)
  (let* ((hiragana-a (make-char 'japanese-jisx0208 36 34))
	 (a-diaeresis ?�)
	 (case-table (copy-case-table (standard-case-table)))
	 (str-hiragana-a (char-to-string hiragana-a))
	 (str-a-diaeresis (char-to-string a-diaeresis))
	 (string (concat str-hiragana-a str-a-diaeresis)))
    (put-case-table-pair hiragana-a a-diaeresis case-table)
    (with-temp-buffer
      (set-case-table case-table)
      (insert hiragana-a "abcdefg" a-diaeresis)
      ;; forward
      (goto-char (point-min))
      (Assert (not (search-forward "�" nil t)))
      (goto-char (point-min))
      (Assert (eq 2 (search-forward str-hiragana-a nil t)))
      (goto-char (point-min))
      (Assert (eq 2 (search-forward str-a-diaeresis nil t)))
      (goto-char (1+ (point-min)))
      (Assert (eq (point-max)
		  (search-forward str-hiragana-a nil t)))
      (goto-char (1+ (point-min)))
      (Assert (eq (point-max)
		  (search-forward str-a-diaeresis nil t)))
      ;; backward
      (goto-char (point-max))
      (Assert (not (search-backward "�" nil t)))
      (goto-char (point-max))
      (Assert (eq (1- (point-max)) (search-backward str-hiragana-a nil t)))
      (goto-char (point-max))
      (Assert (eq (1- (point-max)) (search-backward str-a-diaeresis nil t)))
      (goto-char (1- (point-max)))
      (Assert (eq 1 (search-backward str-hiragana-a nil t)))
      (goto-char (1- (point-max)))
      (Assert (eq 1 (search-backward str-a-diaeresis nil t)))
      (replace-match "a")
      (Assert (looking-at (format "abcdefg%c" a-diaeresis))))
    (with-temp-buffer
      (set-case-table case-table)
      (insert string)
      (insert string)
      (insert string)
      (insert string)
      (insert string)
      (goto-char (point-min))
      (Assert (eq 11 (search-forward string nil t 5)))
      (goto-char (point-min))
      (Assert (not (search-forward string nil t 6)))
      (goto-char (point-max))
      (Assert (eq 1 (search-backward string nil t 5)))
      (goto-char (point-max))
      (Assert (not (search-backward string nil t 6))))))