4:37 a.m.
The code below the "--- Cut Here ---" line, a slightly edited form of
the 21.4 version of tests/automated/mule-tests.el, contains 433 open
parens and 433 close parens but XEmacs thinks the parens are
mismatched.
Here's a formula to reproduce this error:
1. xemacs -vanilla
2. M-x paren-activate
3. insert the text below into a buffer
4. Move the cursor to the paren before the first "when" and you'll get
the following error message: No closing parenthesis found.
I tried cutting this test case down by removing balanced parens, but
I couldn't get it down further. For instance, if you remove this
sexp:
(Assert (coding-system-p (find-coding-system 'binary)))
then the matching parens are found. This error occurs for me in
current 21.4 and 21.5, MULE or no MULE.
Does anyone else see this? Here is my Installation file for the 21.4
non-MULE build.
Cheers,
Vin
--- Cut Here ---
;;-----------------------------------------------------------------
;; Test string modification functions that modify the length of a char.
;;-----------------------------------------------------------------
(when (featurep 'mule)
;;---------------------------------------------------------------
;; Test fillarray
;;---------------------------------------------------------------
;; Test aset
(let ((string (string (make-char 'ascii 69) (make-char 'latin-iso8859-2 69))))
(aset string 0 (make-char 'latin-iso8859-2 42))
(Assert (eq (aref string 1) (make-char 'latin-iso8859-2 69))))
;;---------------------------------------------------------------
;; Test coding system functions
;;---------------------------------------------------------------
;; Create alias for coding system without subsidiaries
(Assert (coding-system-p (find-coding-system 'binary)))
(Assert (coding-system-canonical-name-p 'binary))
(Assert (not (coding-system-alias-p 'binary)))
(Assert (not (coding-system-alias-p 'mule-tests-alias)))
(Assert (not (coding-system-canonical-name-p 'mule-tests-alias)))
(Check-Error-Message
error "Symbol is the canonical name of a coding system and cannot be
redefined"
(define-coding-system-alias 'binary 'iso8859-2))
(Check-Error-Message
error "Symbol is not a coding system alias"
(coding-system-aliasee 'binary))
(define-coding-system-alias 'mule-tests-alias 'binary)
(Assert (coding-system-alias-p 'mule-tests-alias))
(Assert (not (coding-system-canonical-name-p 'mule-tests-alias)))
(Assert (eq (get-coding-system 'binary) (get-coding-system 'mule-tests-alias)))
(Assert (eq 'binary (coding-system-aliasee 'mule-tests-alias)))
(Assert (not (coding-system-alias-p 'mule-tests-alias-unix)))
(Assert (not (coding-system-alias-p 'mule-tests-alias-dos)))
(Assert (not (coding-system-alias-p 'mule-tests-alias-mac)))
(define-coding-system-alias 'mule-tests-alias (get-coding-system 'binary))
(Assert (coding-system-alias-p 'mule-tests-alias))
(Assert (not (coding-system-canonical-name-p 'mule-tests-alias)))
(Assert (eq (get-coding-system 'binary) (get-coding-system 'mule-tests-alias)))
(Assert (eq 'binary (coding-system-aliasee 'mule-tests-alias)))
(Assert (not (coding-system-alias-p 'mule-tests-alias-unix)))
(Assert (not (coding-system-alias-p 'mule-tests-alias-dos)))
(Assert (not (coding-system-alias-p 'mule-tests-alias-mac)))
(define-coding-system-alias 'nested-mule-tests-alias 'mule-tests-alias)
(Assert (coding-system-alias-p 'nested-mule-tests-alias))
(Assert (not (coding-system-canonical-name-p 'nested-mule-tests-alias)))
(Assert (eq (get-coding-system 'binary) (get-coding-system
'nested-mule-tests-alias)))
(Assert (eq (coding-system-aliasee 'nested-mule-tests-alias)
'mule-tests-alias))
(Assert (eq 'mule-tests-alias (coding-system-aliasee
'nested-mule-tests-alias)))
(Assert (not (coding-system-alias-p 'nested-mule-tests-alias-unix)))
(Assert (not (coding-system-alias-p 'nested-mule-tests-alias-dos)))
(Assert (not (coding-system-alias-p 'nested-mule-tests-alias-mac)))
(Check-Error-Message
error "Attempt to create a coding system alias loop"
(define-coding-system-alias 'mule-tests-alias 'nested-mule-tests-alias))
(Check-Error-Message
error "No such coding system"
(define-coding-system-alias 'no-such-coding-system 'no-such-coding-system))
(Check-Error-Message
error "Attempt to create a coding system alias loop"
(define-coding-system-alias 'mule-tests-alias 'mule-tests-alias))
(define-coding-system-alias 'nested-mule-tests-alias nil)
(define-coding-system-alias 'mule-tests-alias nil)
(Assert (coding-system-p (find-coding-system 'binary)))
(Assert (coding-system-canonical-name-p 'binary))
(Assert (not (coding-system-alias-p 'binary)))
(Assert (not (coding-system-alias-p 'mule-tests-alias)))
(Assert (not (coding-system-canonical-name-p 'mule-tests-alias)))
(Check-Error-Message
error "Symbol is the canonical name of a coding system and cannot be
redefined"
(define-coding-system-alias 'binary 'iso8859-2))
(Check-Error-Message
error "Symbol is not a coding system alias"
(coding-system-aliasee 'binary))
(define-coding-system-alias 'nested-mule-tests-alias nil)
(define-coding-system-alias 'mule-tests-alias nil)
;; Create alias for coding system with subsidiaries
(define-coding-system-alias 'mule-tests-alias 'iso-8859-7)
(Assert (coding-system-alias-p 'mule-tests-alias))
(Assert (not (coding-system-canonical-name-p 'mule-tests-alias)))
(Assert (eq (get-coding-system 'iso-8859-7) (get-coding-system
'mule-tests-alias)))
(Assert (eq 'iso-8859-7 (coding-system-aliasee 'mule-tests-alias)))
(Assert (coding-system-alias-p 'mule-tests-alias-unix))
(Assert (coding-system-alias-p 'mule-tests-alias-dos))
(Assert (coding-system-alias-p 'mule-tests-alias-mac))
(define-coding-system-alias 'mule-tests-alias (get-coding-system 'iso-8859-7))
(Assert (coding-system-alias-p 'mule-tests-alias))
(Assert (not (coding-system-canonical-name-p 'mule-tests-alias)))
(Assert (eq (get-coding-system 'iso-8859-7) (get-coding-system
'mule-tests-alias)))
(Assert (eq 'iso-8859-7 (coding-system-aliasee 'mule-tests-alias)))
(Assert (coding-system-alias-p 'mule-tests-alias-unix))
(Assert (coding-system-alias-p 'mule-tests-alias-dos))
(Assert (coding-system-alias-p 'mule-tests-alias-mac))
(Assert (eq (find-coding-system 'mule-tests-alias-mac)
(find-coding-system 'iso-8859-7-mac)))
(define-coding-system-alias 'nested-mule-tests-alias 'mule-tests-alias)
(Assert (coding-system-alias-p 'nested-mule-tests-alias))
(Assert (not (coding-system-canonical-name-p 'nested-mule-tests-alias)))
(Assert (eq (get-coding-system 'iso-8859-7)
(get-coding-system 'nested-mule-tests-alias)))
(Assert (eq (coding-system-aliasee 'nested-mule-tests-alias)
'mule-tests-alias))
(Assert (eq 'mule-tests-alias (coding-system-aliasee
'nested-mule-tests-alias)))
(Assert (coding-system-alias-p 'nested-mule-tests-alias-unix))
(Assert (coding-system-alias-p 'nested-mule-tests-alias-dos))
(Assert (coding-system-alias-p 'nested-mule-tests-alias-mac))
(Assert (eq (find-coding-system 'nested-mule-tests-alias-unix)
(find-coding-system 'iso-8859-7-unix)))
(Check-Error-Message
error "Attempt to create a coding system alias loop"
(define-coding-system-alias 'mule-tests-alias 'nested-mule-tests-alias))
(Check-Error-Message
error "No such coding system"
(define-coding-system-alias 'no-such-coding-system 'no-such-coding-system))
(Check-Error-Message
error "Attempt to create a coding system alias loop"
(define-coding-system-alias 'mule-tests-alias 'mule-tests-alias))
;;---------------------------------------------------------------
;; Test strings waxing and waning across the 8k BIG_STRING limit (see alloc.c)
;;---------------------------------------------------------------
(defun charset-char-string (charset)
(let (lo hi string n (gc-cons-threshold most-positive-fixnum))
(if (= (charset-chars charset) 94)
(setq lo 33 hi 126)
(setq lo 32 hi 127))
(if (= (charset-dimension charset) 1)
(progn
(setq string (make-string (1+ (- hi lo)) ??))
(setq n 0)
(loop for j from lo to hi do
(progn
(aset string n (make-char charset j))
(incf n)))
(garbage-collect)
string)
(progn
(setq string (make-string (* (1+ (- hi lo)) (1+ (- hi lo))) ??))
(setq n 0)
(loop for j from lo to hi do
(loop for k from lo to hi do
(progn
(aset string n (make-char charset j k))
(incf n))))
(garbage-collect)
string))))
;; The following two used to crash xemacs!
(Assert (charset-char-string 'japanese-jisx0208))
(aset (make-string 9003 ??) 1 (make-char 'latin-iso8859-1 77))
(let ((greek-string (charset-char-string 'greek-iso8859-7))
(string (make-string (* 96 60) ??)))
(loop for j from 0 below (length string) do
(aset string j (aref greek-string (mod j 96))))
(loop for k in '(0 1 58 59) do
(Assert (equal (substring string (* 96 k) (* 96 (1+ k))) greek-string))))
(let ((greek-string (charset-char-string 'greek-iso8859-7))
(string (make-string (* 96 60) ??)))
(loop for j from (1- (length string)) downto 0 do
(aset string j (aref greek-string (mod j 96))))
(loop for k in '(0 1 58 59) do
(Assert (equal (substring string (* 96 k) (* 96 (1+ k))) greek-string))))
(let ((ascii-string (charset-char-string 'ascii))
(string (make-string (* 94 60) (make-char 'greek-iso8859-7 57))))
(loop for j from 0 below (length string) do
(aset string j (aref ascii-string (mod j 94))))
(loop for k in '(0 1 58 59) do
(Assert (equal (substring string (* 94 k) (+ 94 (* 94 k))) ascii-string))))
(let ((ascii-string (charset-char-string 'ascii))
(string (make-string (* 94 60) (make-char 'greek-iso8859-7 57))))
(loop for j from (1- (length string)) downto 0 do
(aset string j (aref ascii-string (mod j 94))))
(loop for k in '(0 1 58 59) do
(Assert (equal (substring string (* 94 k) (* 94 (1+ k))) ascii-string))))
;;---------------------------------------------------------------
;; Test file-system character conversion (and, en passant, file ops)
;;---------------------------------------------------------------
(let* ((scaron (make-char 'latin-iso8859-2 57))
(latin2-string (make-string 4 scaron))
(prefix (concat (file-name-as-directory
(file-truename (temp-directory)))
latin2-string))
(name1 (make-temp-name prefix))
(name2 (make-temp-name prefix))
(file-name-coding-system 'iso-8859-2))
;; This is how you suppress output from `message', called by `write-region'
(flet ((append-message (&rest args) ()))
(Assert (not (equal name1 name2)))
;; Kludge to handle Mac OS X which groks only UTF-8.
(cond ((eq system-type 'darwin)
(Check-Error-Message 'file-error "Opening output file"
(write-region (point-min) (point-max) name1))
(require 'un-define)
(setq file-name-coding-system 'utf-8)))
(Assert (not (file-exists-p name1)))
(write-region (point-min) (point-max) name1)
(Assert (file-exists-p name1))
(when (fboundp 'make-symbolic-link)
(make-symbolic-link name1 name2)
(Assert (file-exists-p name2))
(Assert (equal (file-truename name2) name1))
(Assert (equal (file-truename name1) name1)))
(ignore-file-errors (delete-file name1) (delete-file name2))))
;; Is a non-Latin-1 directory name preserved for call-process?
(when (and
;; The bug should manifest itself on Windows, but I've no access
;; to a Windows machine to verify that any test works.
(eq directory-sep-char ?/)
;; file-name-coding-system on Darwin is _always_ UTF-8--the system
;; enforces this--which coding system we don't have available in
;; 21.4, outside of packages. I could jump through lots of hoops to
;; have the test work anyway, but I'm not really into that right
;; now.
(not (eq system-type 'darwin)))
(let ((process-coding-system-alist '((".*" . iso-8859-1)))
(file-name-coding-system 'iso-8859-1)
default-directory)
(make-directory (concat (temp-directory) "/\260\354"))
(setq file-name-coding-system 'euc-jp)
(setq default-directory (format "%s/%c/" (temp-directory)
(make-char 'japanese-jisx0208 48 108)))
(Assert (equal (shell-command-to-string "pwd")
(format "%s/\260\354\n" (temp-directory))))
(delete-directory default-directory)))
;; Add many more file operation tests here...
;;---------------------------------------------------------------
;; Test Unicode-related functions
;;---------------------------------------------------------------
(let* ((scaron (make-char 'latin-iso8859-2 57)))
(loop for code in '(#x0000 #x2222 #x4444 #xffff) do
(progn
(set-ucs-char code scaron)
(Assert (eq scaron (ucs-char code)))))
(Assert (eq nil (set-ucs-char #x1ffff scaron)))
(Check-Error wrong-type-argument (set-ucs-char -10000 scaron)))
)