Mercurial > hg > xemacs-beta
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))))))