xemacs-beta: tests/automated/mule-tests.el comparison

comparison tests/automated/mule-tests.el @ 4855:189fb67ca31a

Create Assert-eq, Assert-equal, etc. These are equivalent to (Assert (eq ...)) but display both the actual value and the expected value of the comparison. Use them throughout the test suite.

author	Ben Wing <ben@xemacs.org>
date	Thu, 14 Jan 2010 02:18:03 -0600
parents	b3ea9c582280
children	1f3ed6288996

comparison

equal deleted inserted replaced

-:95c4ced5c07c
+:189fb67ca31a
 (if for-test-harness
 	  ;; For use with test-harness, use Assert and a temporary
 	  ;; buffer.
 	  (with-temp-buffer
 	    (insert string)
-	    (Assert (equal (buffer-string) string)))
+	    (Assert-equal (buffer-string) string))
 	;; For use without test harness: use a normal buffer, so that
 	;; you can also test whether redisplay works.
 	(switch-to-buffer (get-buffer-create "test"))
 	(erase-buffer)
 	(buffer-disable-undo)
 (coding-system-type buffer-file-coding-system))))
 (kill-buffer nil)
 (dolist (coding-system '(utf-8 windows-1251 macintosh big5))
 (when (find-coding-system coding-system)
 (find-file existing-file-name coding-system)
-(Assert (eq (find-coding-system coding-system)
+(Assert-eq (find-coding-system coding-system)
-buffer-file-coding-system))
+buffer-file-coding-system)
 (kill-buffer nil)
 (find-file nonexistent-file-name coding-system)
-(Assert (eq (find-coding-system coding-system)
+(Assert-eq (find-coding-system coding-system)
-buffer-file-coding-system))
+buffer-file-coding-system)
 (set-buffer-modified-p nil)
 (kill-buffer nil)))
 (delete-file existing-file-name))
 ;;-----------------------------------------------------------------
 	(charset1 charset2)
 	(let ((char1 (make-char charset1 69))
 	      (char2 (make-char charset2 69)))
 	  `(let ((string (make-string 1000 ,char1)))
 	     (fillarray string ,char2)
-	     (Assert (eq (aref string 0) ,char2))
+	     (Assert-eq (aref string 0) ,char2)
-	     (Assert (eq (aref string (1- (length string))) ,char2))
+	     (Assert-eq (aref string (1- (length string))) ,char2)
-	     (Assert (eq (length string) 1000))))))
+	     (Assert-eq (length string) 1000)))))
 (fillarray-test ascii latin-iso8859-1)
 (fillarray-test ascii latin-iso8859-2)
 (fillarray-test latin-iso8859-1 ascii)
 (fillarray-test latin-iso8859-2 ascii))
 ;; 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))))
+(Assert-eq (aref string 1) (make-char 'latin-iso8859-2 69)))
 ;;---------------------------------------------------------------
 ;; Test coding system functions
 ;;---------------------------------------------------------------
 (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 (get-coding-system 'binary) (get-coding-system 'mule-tests-alias))
-(Assert (eq 'binary (coding-system-aliasee '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 (get-coding-system 'binary) (get-coding-system 'mule-tests-alias))
-(Assert (eq 'binary (coding-system-aliasee '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 (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 (coding-system-aliasee 'nested-mule-tests-alias) 'mule-tests-alias)
-(Assert (eq 'mule-tests-alias (coding-system-aliasee 'nested-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
 ;; 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 (get-coding-system 'iso-8859-7) (get-coding-system 'mule-tests-alias))
-(Assert (eq 'iso-8859-7 (coding-system-aliasee '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 (get-coding-system 'iso-8859-7) (get-coding-system 'mule-tests-alias))
-(Assert (eq 'iso-8859-7 (coding-system-aliasee '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)
+(Assert-eq (find-coding-system 'mule-tests-alias-mac)
-	      (find-coding-system 'iso-8859-7-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)
+(Assert-eq (get-coding-system 'iso-8859-7)
-	      (get-coding-system 'nested-mule-tests-alias)))
+	      (get-coding-system 'nested-mule-tests-alias))
-(Assert (eq (coding-system-aliasee 'nested-mule-tests-alias) '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-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)
+(Assert-eq (find-coding-system 'nested-mule-tests-alias-unix)
-	      (find-coding-system 'iso-8859-7-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
 (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))))
+(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))))
+(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))))
+(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))))
+(Assert-equal (substring string (* 94 k) (* 94 (1+ k))) ascii-string)))
 ;;---------------------------------------------------------------
 ;; Test file-system character conversion (and, en passant, file ops)
 ;;---------------------------------------------------------------
 (let* ((dstroke (make-char 'latin-iso8859-2 80))
 ;; name3 already exists and OK-IF-ALREADY-EXISTS was not specified.
 (setq working-symlinks t)))
 (when working-symlinks
 (make-symbolic-link name1 name2)
 (Assert (file-exists-p name2))
-(Assert (equal (file-truename name2) name1))
+(Assert-equal (file-truename name2) name1)
-(Assert (equal (file-truename name1) name1)))
+(Assert-equal (file-truename name1) name1))
 (ignore-file-errors (delete-file name1))
 (ignore-file-errors (delete-file name2))
 (ignore-file-errors (delete-file name3)))
 ;; Add many more file operation tests here...
 ;;---------------------------------------------------------------
 ;; Test Unicode-related functions
 ;;---------------------------------------------------------------
-(let* ((scaron (make-char 'latin-iso8859-2 57)))
+(let* ((scaron '(latin-iso8859-2 185)))
 ;; Used to try #x0000, but you can't change ASCII or Latin-1
 (loop
 for code in '(#x0100 #x2222 #x4444 #xffff)
-with initial-unicode = (char-to-unicode scaron)
+with initial-unicode = (unicode-to-charset-codepoint
+			      code '(latin-iso8859-2))
 do
 (progn
-	(set-unicode-conversion scaron code)
+	(apply 'set-unicode-conversion code scaron)
-	(Assert (eq code (char-to-unicode scaron)))
+	(Assert-eq code (apply 'charset-codepoint-to-unicode scaron))
-	(Assert (eq scaron (unicode-to-char code '(latin-iso8859-2)))))
+	(Assert-equal scaron (unicode-to-charset-codepoint
-finally (set-unicode-conversion scaron initial-unicode))
+			      code '(latin-iso8859-2)))
-(Check-Error wrong-type-argument (set-unicode-conversion scaron -10000)))
+	(apply 'set-unicode-conversion code initial-unicode)))
+(Check-Error 'invalid-argument (apply 'set-unicode-conversion -10000
+					  scaron)))
 (dolist (utf-8-char
 	   '("\xc6\x92"		  ;; U+0192 LATIN SMALL LETTER F WITH HOOK
 	     "\xe2\x81\x8a"	  ;; U+204A TIRONIAN SIGN ET
 	     "\xe2\x82\xae"	  ;; U+20AE TUGRIK SIGN
 	     "\xf0\xaf\xa8\x88"   ;; U+2FA08 CJK COMPATIBILITY FOR U+4BCE
 	     "\xf4\x8f\xbf\xbd")) ;; U+10FFFD <Plane 16 Private Use, Last>
 (let* ((xemacs-character (car (append
 				  (decode-coding-string utf-8-char 'utf-8)
 				  nil)))
-	   (xemacs-charset (car (split-char xemacs-character))))
+	   (xemacs-charset (char-charset xemacs-character)))
 ;; Trivial test of the UTF-8 support of the escape-quoted character set.
-(Assert (equal (decode-coding-string utf-8-char 'utf-8)
+(Assert-equal (decode-coding-string utf-8-char 'utf-8)
 		     (decode-coding-string (concat "\033%G" utf-8-char)
-					   'escape-quoted)))
+					   'escape-quoted))
 ;; Check that the reverse mapping holds.
-(Assert (equal (unicode-code-point-to-utf-8-string
+(Assert-equal (unicode-code-point-to-utf-8-string
 		      (encode-char xemacs-character 'ucs))
-		     utf-8-char))
+		     utf-8-char)
 ;; Check that, if this character has been JIT-allocated, it is encoded
 ;; in escape-quoted using the corresponding UTF-8 escape.
 (when (charset-property xemacs-charset 'encode-as-utf-8)
-	(Assert (equal (concat "\033%G" utf-8-char)
+	(Assert-equal (concat "\033%G" utf-8-char)
-		       (encode-coding-string xemacs-character 'escape-quoted)))
+		       (encode-coding-string xemacs-character 'escape-quoted))
-	(Assert (equal (concat "\033%G" utf-8-char)
+	(Assert-equal (concat "\033%G" utf-8-char)
-		       (encode-coding-string xemacs-character 'ctext))))))
+		       (encode-coding-string xemacs-character 'ctext)))))
 (loop
 for (code-point utf-16-big-endian utf-16-little-endian)
 in '((#x10000 "\xd8\x00\xdc\x00" "\x00\xd8\x00\xdc")
 (#x10FFFD "\xdb\xff\xdf\xfd" "\xff\xdb\xfd\xdf"))
 do
-(Assert (equal (encode-coding-string
+(Assert-equal (encode-coding-string
 (decode-char 'ucs code-point) 'utf-16)
-utf-16-big-endian))
+utf-16-big-endian)
-(Assert (equal (encode-coding-string
+(Assert-equal (encode-coding-string
 (decode-char 'ucs code-point) 'utf-16-le)
-utf-16-little-endian)))
+utf-16-little-endian))
 ;;---------------------------------------------------------------
 ;; Regression test for a couple of CCL-related bugs.
 ;;---------------------------------------------------------------
 	 (write-multibyte-character r0 r1)
 	 (r1 = 31)
 	 (write-multibyte-character r0 r1)))
 "CCL program that writes two control-1 multibyte characters.")
-(Assert (equal
+(Assert-equal
 	     (ccl-execute-on-string 'ccl-write-two-control-1-chars
 				    ccl-vector "")
 	     (format "%c%c" (make-char 'control-1 0)
-		     (make-char 'control-1 31))))
+		     (make-char 'control-1 31)))
 (define-ccl-program ccl-unicode-two-control-1-chars
 `(1
 	((r0 = ,(charset-id 'control-1))
 	 (r1 = 31)
 (when (and (eq 'fixed-width (coding-system-type coding-system))
 	       ;; Don't check the coding systems with odd line endings
 	       ;; (maybe we should):
 	       (eq 'lf (coding-system-eol-type coding-system)))
 ;; These coding systems are round-trip compatible with themselves.
-(Assert (equal (encode-coding-string
+(Assert-equal (encode-coding-string
 		      (decode-coding-string all-possible-octets
 					    coding-system)
 		      coding-system)
-		     all-possible-octets)
+		     all-possible-octets
 (format "checking %s is transparent" coding-system))))
 ;;---------------------------------------------------------------
 ;; Test charset-in-* functions
 ;;---------------------------------------------------------------
 (with-temp-buffer
 (insert-file-contents (locate-data-file "HELLO"))
-(Assert (equal
+(Assert-equal
 ;; The sort is to make the algorithm of charsets-in-region
 ;; irrelevant.
 (sort (charsets-in-region (point-min) (point-max))
 #'string<)
 '(ascii chinese-big5-1 chinese-gb2312 cyrillic-iso8859-5
 ethiopic greek-iso8859-7 hebrew-iso8859-8 japanese-jisx0208
 japanese-jisx0212 jit-ucs-charset-0 katakana-jisx0201
 korean-ksc5601 latin-iso8859-1 latin-iso8859-2 thai-xtis
-vietnamese-viscii-lower)))
+vietnamese-viscii-lower))
-(Assert (equal
+(Assert-equal
 (sort (charsets-in-string (buffer-substring (point-min)
 							 (point-max)))
 #'string<)
 '(ascii chinese-big5-1 chinese-gb2312 cyrillic-iso8859-5
 ethiopic greek-iso8859-7 hebrew-iso8859-8 japanese-jisx0208
 japanese-jisx0212 jit-ucs-charset-0 katakana-jisx0201
 korean-ksc5601 latin-iso8859-1 latin-iso8859-2 thai-xtis
-vietnamese-viscii-lower))))
+vietnamese-viscii-lower)))
 ;;---------------------------------------------------------------
 ;; Language environments, and whether the specified values are sane.
 ;;---------------------------------------------------------------
 (loop
 with native-coding-system = nil
 with original-language-environment = current-language-environment
 do
 ;; s-l-e can call #'require, which says "Loading ..."
 (Silence-Message (set-language-environment language))
-(Assert (equal language current-language-environment))
+(Assert-equal language current-language-environment)
 (setq language-input-method
 	  (get-language-info language 'input-method))
 (when (and language-input-method
 ;; #### Not robust, if more input methods besides canna are
 "input method unavailable"
 (format "check that IM %s can be activated" language-input-method)
 ;; s-i-m can load files.
 (Silence-Message
 	(set-input-method language-input-method))
-(Assert (equal language-input-method current-input-method))))
+(Assert-equal language-input-method current-input-method)))
 (dolist (charset (get-language-info language 'charset))
 (Assert (charsetp (find-charset charset))))
 (dolist (coding-system (get-language-info language 'coding-system))
 (Assert (coding-system-p (find-coding-system coding-system))))

Mercurial > hg > xemacs-beta

comparison tests/automated/mule-tests.el @ 4855:189fb67ca31a