Mercurial > hg > xemacs-beta
changeset 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 | 95c4ced5c07c |
| children | 9bf09492cff7 |
| files | tests/automated/base64-tests.el tests/automated/byte-compiler-tests.el tests/automated/case-tests.el tests/automated/ccl-tests.el tests/automated/database-tests.el tests/automated/extent-tests.el tests/automated/hash-table-tests.el tests/automated/lisp-tests.el tests/automated/md5-tests.el tests/automated/mule-tests.el tests/automated/query-coding-tests.el tests/automated/regexp-tests.el tests/automated/region-tests.el tests/automated/symbol-tests.el tests/automated/syntax-tests.el tests/automated/tag-tests.el tests/automated/test-harness.el tests/automated/weak-tests.el |
| diffstat | 18 files changed, 1091 insertions(+), 1012 deletions(-) [+] |
line wrap: on
line diff
--- a/tests/automated/base64-tests.el Thu Jan 14 01:25:16 2010 -0600 +++ b/tests/automated/base64-tests.el Thu Jan 14 02:18:03 2010 -0600 @@ -52,8 +52,8 @@ (erase-buffer) (insert string) (setq length (base64-encode-region (point-min) (point-max) no-line-break)) - (Assert (eq length (- (point-max) (point-min)))) - (Assert (equal (buffer-string) string-result)) + (Assert-eq length (- (point-max) (point-min))) + (Assert-equal (buffer-string) string-result) ;; partial (erase-buffer) (insert "random junk........\0\0';'eqwrkw[erpqf") @@ -62,8 +62,8 @@ (setq p2 (point-marker)) (insert "...more random junk.q,f3/.qrm314.r,m2typ' 2436T@W$^@$#^T@") (setq length (base64-encode-region p1 p2 no-line-break)) - (Assert (eq length (- p2 p1))) - (Assert (equal (buffer-substring p1 p2) string-result)))) + (Assert-eq length (- p2 p1)) + (Assert-equal (buffer-substring p1 p2) string-result))) string-result)) (defun bt-base64-decode-string (string) @@ -75,12 +75,12 @@ (insert string) (setq length (base64-decode-region (point-min) (point-max))) (cond (string-result - (Assert (eq length (- (point-max) (point-min)))) - (Assert (equal (buffer-string) string-result))) + (Assert-eq length (- (point-max) (point-min))) + (Assert-equal (buffer-string) string-result)) (t (Assert (null length)) ;; The buffer should not have been modified. - (Assert (equal (buffer-string) string)))) + (Assert-equal (buffer-string) string))) ;; partial (erase-buffer) (insert "random junk........\0\0';'eqwrkw[erpqf") @@ -90,12 +90,12 @@ (insert "...more random junk.q,f3/.qrm314.\0\0r,m2typ' 2436T@W$^@$#T@") (setq length (base64-decode-region p1 p2)) (cond (string-result - (Assert (eq length (- p2 p1))) - (Assert (equal (buffer-substring p1 p2) string-result))) + (Assert-eq length (- p2 p1)) + (Assert-equal (buffer-substring p1 p2) string-result)) (t (Assert (null length)) ;; The buffer should not have been modified. - (Assert (equal (buffer-substring p1 p2) string)))))) + (Assert-equal (buffer-substring p1 p2) string))))) string-result)) (defun bt-remove-newlines (str) @@ -126,9 +126,9 @@ ;;----------------------------------------------------- (loop for (raw encoded) in bt-test-strings do - (Assert (equal (bt-base64-encode-string raw) encoded)) + (Assert-equal (bt-base64-encode-string raw) encoded) ;; test the NO-LINE-BREAK flag - (Assert (equal (bt-base64-encode-string raw t) (bt-remove-newlines encoded)))) + (Assert-equal (bt-base64-encode-string raw t) (bt-remove-newlines encoded))) ;; When Mule is around, Lisp programmers should make sure that the ;; buffer contains only characters whose `char-int' is in the [0, 256) @@ -150,8 +150,8 @@ ;;----------------------------------------------------- (loop for (raw encoded) in bt-test-strings do - (Assert (equal (bt-base64-decode-string encoded) raw)) - (Assert (equal (bt-base64-decode-string (bt-remove-newlines encoded)) raw))) + (Assert-equal (bt-base64-decode-string encoded) raw) + (Assert-equal (bt-base64-decode-string (bt-remove-newlines encoded)) raw)) ;; Test errors (dolist (str `("foo" "AAC" "foo\0bar" "====" "Zm=9v" ,bt-allchars)) @@ -182,7 +182,7 @@ ;; Whitespace at the beginning, end, and middle. (let ((mangled (concat bt-nonbase64-chars left bt-nonbase64-chars right bt-nonbase64-chars))) - (Assert (equal (bt-base64-decode-string mangled) raw))) + (Assert-equal (bt-base64-decode-string mangled) raw)) ;; Whitespace between every char. (let ((mangled (concat bt-nonbase64-chars @@ -191,7 +191,7 @@ (mapconcat #'char-to-string encoded (apply #'string bt-nonbase64-chars)) bt-nonbase64-chars))) - (Assert (equal (bt-base64-decode-string mangled) raw)))))) + (Assert-equal (bt-base64-decode-string mangled) raw))))) ;;----------------------------------------------------- ;; Mixed... @@ -205,22 +205,22 @@ ;; practically all aspects of the encoding and decoding process. (loop for (raw ignored) in bt-test-strings do - (Assert (equal (bt-base64-decode-string + (Assert-equal (bt-base64-decode-string (bt-base64-encode-string raw)) - raw)) - (Assert (equal (bt-base64-decode-string + raw) + (Assert-equal (bt-base64-decode-string (bt-base64-decode-string (bt-base64-encode-string (bt-base64-encode-string raw)))) - raw)) - (Assert (equal (bt-base64-decode-string + raw) + (Assert-equal (bt-base64-decode-string (bt-base64-decode-string (bt-base64-decode-string (bt-base64-encode-string (bt-base64-encode-string (bt-base64-encode-string raw)))))) - raw)) - (Assert (equal (bt-base64-decode-string + raw) + (Assert-equal (bt-base64-decode-string (bt-base64-decode-string (bt-base64-decode-string (bt-base64-decode-string @@ -228,8 +228,8 @@ (bt-base64-encode-string (bt-base64-encode-string (bt-base64-encode-string raw)))))))) - raw)) - (Assert (equal (bt-base64-decode-string + raw) + (Assert-equal (bt-base64-decode-string (bt-base64-decode-string (bt-base64-decode-string (bt-base64-decode-string @@ -239,4 +239,4 @@ (bt-base64-encode-string (bt-base64-encode-string (bt-base64-encode-string raw)))))))))) - raw))) + raw))
--- a/tests/automated/byte-compiler-tests.el Thu Jan 14 01:25:16 2010 -0600 +++ b/tests/automated/byte-compiler-tests.el Thu Jan 14 02:18:03 2010 -0600 @@ -92,8 +92,8 @@ (eval '(let* ((x 1 2)) 3))) (defmacro before-and-after-compile-equal (&rest form) - `(Assert (equal (funcall (quote (lambda () ,@form))) - (funcall (byte-compile (quote (lambda () ,@form))))))) + `(Assert-equal (funcall (quote (lambda () ,@form))) + (funcall (byte-compile (quote (lambda () ,@form)))))) (defvar simplyamarker (point-min-marker))
--- a/tests/automated/case-tests.el Thu Jan 14 01:25:16 2010 -0600 +++ b/tests/automated/case-tests.el Thu Jan 14 02:18:03 2010 -0600 @@ -95,10 +95,10 @@ "¡¢£¤¥¦§¨©ª«¬®¯°±²³´µ¶·¸¹º»¼½¾¿àáâãäåæçèéêëìíîïðñòóôõö×øùúûüýþßÀÁÂÃÄÅÆÇÈÉÊËÌÍÎÏÐÑÒÓÔÕÖ÷ØÙÚÛÜÝÞÿ")) (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))))) + (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))) @@ -165,11 +165,11 @@ (insert "Test Buffer") (let ((case-fold-search t)) (goto-char (point-min)) - (Assert (eq (search-forward "test buffer" nil t) 12)) + (Assert-eq (search-forward "test buffer" nil t) 12) (goto-char (point-min)) - (Assert (eq (search-forward "Test buffer" nil t) 12)) + (Assert-eq (search-forward "Test buffer" nil t) 12) (goto-char (point-min)) - (Assert (eq (search-forward "Test Buffer" nil t) 12)) + (Assert-eq (search-forward "Test Buffer" nil t) 12) (setq case-fold-search nil) (goto-char (point-min)) @@ -177,51 +177,51 @@ (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)))) + (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))) + (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))) + (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))) + (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))) + (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-eq 16 (search-forward "ä" nil t)) (Assert (not (search-forward "ä" nil t))) (goto-char (point-min)) - (Assert (eq 24 (search-forward "Ä" nil t))) + (Assert-eq 24 (search-forward "Ä" nil t)) (goto-char 16) - (Assert (eq 24 (search-forward "Ä" nil t))) + (Assert-eq 24 (search-forward "Ä" nil t)) (goto-char (point-max)) - (Assert (eq 15 (search-backward "ä" nil t))) + (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-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))) + (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))) + (Assert-eq 5 (search-backward "ää" nil t 5)) (goto-char (point-max)) (Assert (not (search-backward "ää" nil t 6)))) @@ -240,26 +240,26 @@ (goto-char (point-min)) (Assert (not (search-forward "ö" nil t))) (goto-char (point-min)) - (Assert (eq 2 (search-forward str-hiragana-a nil t))) + (Assert-eq 2 (search-forward str-hiragana-a nil t)) (goto-char (point-min)) - (Assert (eq 2 (search-forward str-a-diaeresis nil t))) + (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))) + (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))) + (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))) + (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))) + (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))) + (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))) + (Assert-eq 1 (search-backward str-a-diaeresis nil t)) (replace-match "a") (Assert (looking-at (format "abcdefg%c" a-diaeresis)))) (with-temp-buffer @@ -270,11 +270,11 @@ (insert string) (insert string) (goto-char (point-min)) - (Assert (eq 11 (search-forward string nil t 5))) + (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))) + (Assert-eq 1 (search-backward string nil t 5)) (goto-char (point-max)) (Assert (not (search-backward string nil t 6)))))) @@ -297,7 +297,7 @@ ;; But searches for ASCII strings in buffers with nothing above ?\xFF ;; use Boyer Moore with the current implementation, which is the ;; important thing for the Gnus use case. - (Assert (= (1+ (length target)) (search-forward target nil t))))) + (Assert= (1+ (length target)) (search-forward target nil t)))) (Skip-Test-Unless (boundp 'debug-xemacs-searches) ; normal when we have DEBUG_XEMACS @@ -313,7 +313,7 @@ (insert "\n\nDer beruhmte deutsche Flei\xdf\n\n") (goto-char (point-min)) (Assert (search-forward "Flei\xdf")) - (Assert (eq 'boyer-moore search-algorithm-used)) + (Assert-eq 'boyer-moore search-algorithm-used) (delete-region (point-min) (point-max)) (when (featurep 'mule) (insert "\n\nDer beruhmte deutsche Flei\xdf\n\n") @@ -321,13 +321,13 @@ (Assert (search-forward (format "Fle%c\xdf" (make-char 'latin-iso8859-9 #xfd)))) - (Assert (eq 'boyer-moore search-algorithm-used)) + (Assert-eq 'boyer-moore search-algorithm-used) (insert (make-char 'latin-iso8859-9 #xfd)) (goto-char (point-min)) (Assert (search-forward "Flei\xdf")) - (Assert (eq 'simple-search search-algorithm-used)) + (Assert-eq 'simple-search search-algorithm-used) (goto-char (point-min)) (Assert (search-forward (format "Fle%c\xdf" (make-char 'latin-iso8859-9 #xfd)))) - (Assert (eq 'simple-search search-algorithm-used)))))) + (Assert-eq 'simple-search search-algorithm-used)))))
--- a/tests/automated/ccl-tests.el Thu Jan 14 01:25:16 2010 -0600 +++ b/tests/automated/ccl-tests.el Thu Jan 14 02:18:03 2010 -0600 @@ -141,9 +141,9 @@ (defun ccl-test-normal-expr () ;; normal-expr (let ((r0 0) (r1 10) (r2 20) (r3 21) (r4 7)) - (Assert (= (ccl-test '(0 ((r0 = ((((r1 * r2) + r3) % r4) << 2)))) + (Assert= (ccl-test '(0 ((r0 = ((((r1 * r2) + r3) % r4) << 2)))) (list r0 r1 r2 r3 r4)) - (ash (% (+ (* r1 r2) r3) r4) 2)))) + (ash (% (+ (* r1 r2) r3) r4) 2))) (Assert (\= (ccl-test '(0 ((r2 = (r1 < 10)) (r0 = (r2 > 10)))) @@ -151,9 +151,9 @@ 0)) (let ((r0 0) (r1 #x10FF) (r2 #xCC) (r3 #xE0)) - (Assert (= (ccl-test '(0 ((r0 = (((r1 & #xFF) ^ r2) | r3)))) + (Assert= (ccl-test '(0 ((r0 = (((r1 & #xFF) ^ r2) | r3)))) (list r0 r1 r2 r3)) - (logior (logxor (logand r1 #xFF) r2) r3)))) + (logior (logxor (logand r1 #xFF) r2) r3))) ;; checking range of SJIS ;; 81(40-7E, 80-FC), 82, 9F, E0, E1, EF @@ -187,16 +187,16 @@ (setq low (1+ low))))) ;; self-expr - (Assert (= (ccl-test '(0 ((r0 += 20) + (Assert= (ccl-test '(0 ((r0 += 20) (r0 *= 40) (r0 -= 15))) '(100)) - (- (* (+ 100 20) 40) 15))) + (- (* (+ 100 20) 40) 15)) ;; ref. array - (Assert (= (ccl-test '(0 ((r0 = r0 [100 101 102 103 104]))) + (Assert= (ccl-test '(0 ((r0 = r0 [100 101 102 103 104]))) '(3)) - 103))) + 103)) ;;; Section 2. Simple read and write (defun ccl-test-simple-read-and-write () @@ -360,7 +360,7 @@ ((r0 = -1)))) ;; 1-level normal 1 mapping - (Assert (equal + (Assert-equal (mapcar (lambda (val) (ccl-test-map-multiple @@ -369,9 +369,9 @@ '(0 99 100 101 102 103 104 105 106 107)) '((0 . -1) (99 . -1) (1 . 0) (2 . 0) (3 . 0) (4 . 0) (5 . 0) - (105 . -1) (106 . -1) (107 . -1)))) + (105 . -1) (106 . -1) (107 . -1))) - (Assert (equal + (Assert-equal (mapcar (lambda (val) (ccl-test-iterate-multiple-map @@ -380,10 +380,10 @@ '(0 99 100 101 102 103 104 105 106 107)) '((0 . -1) (99 . -1) (1 . 0) (2 . 0) (3 . 0) (4 . 0) (5 . 0) - (105 . -1) (106 . -1) (107 . -1)))) + (105 . -1) (106 . -1) (107 . -1))) ;; 1-level normal 2 mappings - (Assert (equal + (Assert-equal (mapcar (lambda (val) (ccl-test-map-multiple @@ -393,9 +393,9 @@ '(0 99 100 101 102 103 104 105 106 107)) '((0 . -1) (99 . -1) (1 . 0) (2 . 0) (13 . 1) (4 . 0) (5 . 0) (16 . 1) (17 . 1) - (107 . -1)))) + (107 . -1))) - (Assert (equal + (Assert-equal (mapcar (lambda (val) (ccl-test-iterate-multiple-map @@ -404,11 +404,11 @@ [101 12 13 14 15 16 17]))) '(0 99 100 101 102 103 104 105 106 107)) '((0 . -1) (99 . -1) (1 . 0) (2 . 0) (3 . 0) - (4 . 0) (5 . 0) (16 . 1) (17 . 1) (107 . -1)))) + (4 . 0) (5 . 0) (16 . 1) (17 . 1) (107 . -1))) ;; 1-level normal 7 mappings - (Assert (equal + (Assert-equal (mapcar (lambda (val) (ccl-test-map-multiple @@ -432,9 +432,9 @@ (105 . 2) (106 . 2) (1007 . 3) (108 . 2) (9999 . -1) (10000 . -1) (10001 . -1) (10002 . -1) (10003 . -1) (10004 . -1) (19999 . -1) (20000 . 5) (20001 . 5) - (20002 . 5) (30000 . 6) (20004 . 5) (20005 . 5) (20006 . 5)))) + (20002 . 5) (30000 . 6) (20004 . 5) (20005 . 5) (20006 . 5))) - (Assert (equal + (Assert-equal (mapcar (lambda (val) (ccl-test-iterate-multiple-map @@ -458,11 +458,11 @@ (105 . 2) (106 . 2) (1007 . 3) (108 . 2) (9999 . -1) (10000 . -1) (10001 . -1) (10002 . -1) (10003 . -1) (10004 . -1) (19999 . -1) (20000 . 5) (20001 . 5) - (20002 . 5)(30000 . 6)(20004 . 5)(20005 . 5)(20006 . 5)))) + (20002 . 5)(30000 . 6)(20004 . 5)(20005 . 5)(20006 . 5))) ;; 1-level 7 mappings including CCL call - (Assert (equal + (Assert-equal (mapcar (lambda (val) (ccl-test-map-multiple @@ -487,9 +487,9 @@ (1009 . 3) (1009 . 3) (9999 . -1) (10000 . -1) (10001 . -1) (10002 . -1) (10003 . -1) (10004 . -1) (19999 . -1) (20000 . 5) (20001 . 5) (20002 . 5) - (30000 . 6)(20004 . 5)(20005 . 5)(20006 . 5)))) + (30000 . 6)(20004 . 5)(20005 . 5)(20006 . 5))) - (Assert (equal + (Assert-equal (mapcar (lambda (val) (ccl-test-iterate-multiple-map @@ -514,10 +514,10 @@ (1009 . 3) (-3 . 0) (9999 . -1) (10000 . -1) (10001 . -1) (10002 . -1) (10003 . -1) (10004 . -1) (19999 . -1) (20000 . 5) (20001 . 5) (20002 . 5) - (30000 . 6) (20004 . 5) (20005 . 5) (20006 . 5)))) + (30000 . 6) (20004 . 5) (20005 . 5) (20006 . 5))) ;; 3-level mappings - (Assert (equal + (Assert-equal (mapcar (lambda (val) (ccl-test-map-multiple @@ -550,11 +550,11 @@ (30040 . 10) (30050 . 10) (10008 . 11) (10009 . 11) (10010 . 11) (19999 . 11) (20000 . 11) (20001 . 11) (20002 . 11) (20003 . 11) (20004 . 11) (20005 . 11) - (20006 . 11)))) + (20006 . 11))) ;; 3-level mappings including CCL call - (Assert (equal + (Assert-equal (mapcar (lambda (val) (ccl-test-map-multiple @@ -592,7 +592,7 @@ (10005 . 14) (30040 . 12) (1020008 . 12) (10008 . 14) (10009 . 14) (10010 . 14) (19999 . 14) (20000 . 14) (20001 . 14) (20002 . 14) (20003 . 14) (20004 . 14) - (20005 . 14) (20006 . 14)))) + (20005 . 14) (20006 . 14))) ;; All map-instruction tests ends here. )
--- a/tests/automated/database-tests.el Thu Jan 14 01:25:16 2010 -0600 +++ b/tests/automated/database-tests.el Thu Jan 14 02:18:03 2010 -0600 @@ -46,9 +46,9 @@ (test-database (db) (Assert (databasep db)) (put-database "key1" "val1" db) - (Assert (equal "val1" (get-database "key1" db))) + (Assert-equal "val1" (get-database "key1" db)) (remove-database "key1" db) - (Assert (equal nil (get-database "key1" db))) + (Assert-equal nil (get-database "key1" db)) (close-database db) (Assert (not (database-live-p db))) (Assert (databasep db))))
--- a/tests/automated/extent-tests.el Thu Jan 14 01:25:16 2010 -0600 +++ b/tests/automated/extent-tests.el Thu Jan 14 02:18:03 2010 -0600 @@ -52,12 +52,12 @@ ;; Put it in a buffer. (set-extent-endpoints extent 1 1 (current-buffer)) - (Assert (eq (extent-object extent) (current-buffer))) + (Assert-eq (extent-object extent) (current-buffer)) ;; And then into another buffer. (with-temp-buffer (set-extent-endpoints extent 1 1 (current-buffer)) - (Assert (eq (extent-object extent) (current-buffer)))) + (Assert-eq (extent-object extent) (current-buffer))) ;; Now that the buffer doesn't exist, extent should be detached ;; again. @@ -65,39 +65,39 @@ ;; This line crashes XEmacs 21.2.46 and prior. (set-extent-endpoints extent 1 (length string) string) - (Assert (eq (extent-object extent) string)) + (Assert-eq (extent-object extent) string) ) (let ((extent (make-extent 1 1))) ;; By default, extent should be closed-open - (Assert (eq (get extent 'start-closed) t)) - (Assert (eq (get extent 'start-open) nil)) - (Assert (eq (get extent 'end-open) t)) - (Assert (eq (get extent 'end-closed) nil)) + (Assert-eq (get extent 'start-closed) t) + (Assert-eq (get extent 'start-open) nil) + (Assert-eq (get extent 'end-open) t) + (Assert-eq (get extent 'end-closed) nil) ;; Make it closed-closed. (set-extent-property extent 'end-closed t) - (Assert (eq (get extent 'start-closed) t)) - (Assert (eq (get extent 'start-open) nil)) - (Assert (eq (get extent 'end-open) nil)) - (Assert (eq (get extent 'end-closed) t)) + (Assert-eq (get extent 'start-closed) t) + (Assert-eq (get extent 'start-open) nil) + (Assert-eq (get extent 'end-open) nil) + (Assert-eq (get extent 'end-closed) t) ;; open-closed (set-extent-property extent 'start-open t) - (Assert (eq (get extent 'start-closed) nil)) - (Assert (eq (get extent 'start-open) t)) - (Assert (eq (get extent 'end-open) nil)) - (Assert (eq (get extent 'end-closed) t)) + (Assert-eq (get extent 'start-closed) nil) + (Assert-eq (get extent 'start-open) t) + (Assert-eq (get extent 'end-open) nil) + (Assert-eq (get extent 'end-closed) t) ;; open-open (set-extent-property extent 'end-open t) - (Assert (eq (get extent 'start-closed) nil)) - (Assert (eq (get extent 'start-open) t)) - (Assert (eq (get extent 'end-open) t)) - (Assert (eq (get extent 'end-closed) nil))) + (Assert-eq (get extent 'start-closed) nil) + (Assert-eq (get extent 'start-open) t) + (Assert-eq (get extent 'end-open) t) + (Assert-eq (get extent 'end-closed) nil)) ) @@ -125,25 +125,25 @@ (let ((e (make-extent 4 7))) ;; current state: "###[eee)###" ;; 123 456 789 - (Assert (equal (et-range e) '(4 7))) + (Assert-equal (et-range e) '(4 7)) (et-insert-at "xxx" 4) ;; current state: "###[xxxeee)###" ;; 123 456789 012 - (Assert (equal (et-range e) '(4 10))) + (Assert-equal (et-range e) '(4 10)) (et-insert-at "yyy" 7) ;; current state: "###[xxxyyyeee)###" ;; 123 456789012 345 - (Assert (equal (et-range e) '(4 13))) + (Assert-equal (et-range e) '(4 13)) (et-insert-at "zzz" 13) ;; current state: "###[xxxyyyeee)zzz###" ;; 123 456789012 345678 - (Assert (equal (et-range e) '(4 13))) + (Assert-equal (et-range e) '(4 13)) )) ;; closed-closed @@ -155,25 +155,25 @@ ;; current state: "###[eee]###" ;; 123 456 789 - (Assert (equal (et-range e) '(4 7))) + (Assert-equal (et-range e) '(4 7)) (et-insert-at "xxx" 4) ;; current state: "###[xxxeee]###" ;; 123 456789 012 - (Assert (equal (et-range e) '(4 10))) + (Assert-equal (et-range e) '(4 10)) (et-insert-at "yyy" 7) ;; current state: "###[xxxyyyeee]###" ;; 123 456789012 345 - (Assert (equal (et-range e) '(4 13))) + (Assert-equal (et-range e) '(4 13)) (et-insert-at "zzz" 13) ;; current state: "###[xxxyyyeeezzz]###" ;; 123 456789012345 678 - (Assert (equal (et-range e) '(4 16))) + (Assert-equal (et-range e) '(4 16)) )) ;; open-closed @@ -186,25 +186,25 @@ ;; current state: "###(eee]###" ;; 123 456 789 - (Assert (equal (et-range e) '(4 7))) + (Assert-equal (et-range e) '(4 7)) (et-insert-at "xxx" 4) ;; current state: "###xxx(eee]###" ;; 123456 789 012 - (Assert (equal (et-range e) '(7 10))) + (Assert-equal (et-range e) '(7 10)) (et-insert-at "yyy" 8) ;; current state: "###xxx(eyyyee]###" ;; 123456 789012 345 - (Assert (equal (et-range e) '(7 13))) + (Assert-equal (et-range e) '(7 13)) (et-insert-at "zzz" 13) ;; current state: "###xxx(eyyyeezzz]###" ;; 123456 789012345 678 - (Assert (equal (et-range e) '(7 16))) + (Assert-equal (et-range e) '(7 16)) )) ;; open-open @@ -216,25 +216,25 @@ ;; current state: "###(eee)###" ;; 123 456 789 - (Assert (equal (et-range e) '(4 7))) + (Assert-equal (et-range e) '(4 7)) (et-insert-at "xxx" 4) ;; current state: "###xxx(eee)###" ;; 123456 789 012 - (Assert (equal (et-range e) '(7 10))) + (Assert-equal (et-range e) '(7 10)) (et-insert-at "yyy" 8) ;; current state: "###xxx(eyyyee)###" ;; 123456 789012 345 - (Assert (equal (et-range e) '(7 13))) + (Assert-equal (et-range e) '(7 13)) (et-insert-at "zzz" 13) ;; current state: "###xxx(eyyyee)zzz###" ;; 123456 789012 345678 - (Assert (equal (et-range e) '(7 13))) + (Assert-equal (et-range e) '(7 13)) )) @@ -256,31 +256,31 @@ ;; current state: xx[xxxxxx]xx ;; 12 345678 90 - (Assert (equal (et-range e) '(3 9))) + (Assert-equal (et-range e) '(3 9)) (delete-region 1 2) ;; current state: x[xxxxxx]xx ;; 1 234567 89 - (Assert (equal (et-range e) '(2 8))) + (Assert-equal (et-range e) '(2 8)) (delete-region 2 4) ;; current state: x[xxxx]xx ;; 1 2345 67 - (Assert (equal (et-range e) '(2 6))) + (Assert-equal (et-range e) '(2 6)) (delete-region 1 3) ;; current state: [xxx]xx ;; 123 45 - (Assert (equal (et-range e) '(1 4))) + (Assert-equal (et-range e) '(1 4)) (delete-region 3 5) ;; current state: [xx]x ;; 12 3 - (Assert (equal (et-range e) '(1 3))) + (Assert-equal (et-range e) '(1 3)) ))) @@ -329,7 +329,7 @@ (delete-region 4 6) ;; ###[]### (Assert (not (extent-detached-p e))) - (Assert (equal (et-range e) '(4 4))) + (Assert-equal (et-range e) '(4 4)) )) ) @@ -343,7 +343,7 @@ (insert "######") (let ((e (make-extent 4 4))) (et-insert-at "foo" 4) - (Assert (equal (et-range e) '(4 4))))) + (Assert-equal (et-range e) '(4 4)))) ;; open-closed (should move) (with-temp-buffer @@ -352,7 +352,7 @@ (put e 'start-open t) (put e 'end-closed t) (et-insert-at "foo" 4) - (Assert (equal (et-range e) '(7 7))))) + (Assert-equal (et-range e) '(7 7)))) ;; closed-closed (should extend) (with-temp-buffer @@ -360,7 +360,7 @@ (let ((e (make-extent 4 4))) (put e 'end-closed t) (et-insert-at "foo" 4) - (Assert (equal (et-range e) '(4 7))))) + (Assert-equal (et-range e) '(4 7)))) ;; open-open (illegal; forced to behave like closed-open) (with-temp-buffer @@ -368,4 +368,4 @@ (let ((e (make-extent 4 4))) (put e 'start-open t) (et-insert-at "foo" 4) - (Assert (equal (et-range e) '(4 4))))) + (Assert-equal (et-range e) '(4 4))))
--- a/tests/automated/hash-table-tests.el Thu Jan 14 01:25:16 2010 -0600 +++ b/tests/automated/hash-table-tests.el Thu Jan 14 02:18:03 2010 -0600 @@ -49,26 +49,26 @@ :rehash-size rehash-size :rehash-threshold rehash-threshold :weakness weakness))) - (Assert (equal ht (car (let ((print-readably t)) - (read-from-string (prin1-to-string ht)))))) - (Assert (eq test (hash-table-test ht))) + (Assert-equal ht (car (let ((print-readably t)) + (read-from-string (prin1-to-string ht))))) + (Assert-eq test (hash-table-test ht)) (Assert (<= size (hash-table-size ht))) - (Assert (eql rehash-size (hash-table-rehash-size ht))) - (Assert (eql rehash-threshold (hash-table-rehash-threshold ht))) - (Assert (eq weakness (hash-table-weakness ht)))))))))) + (Assert-eql rehash-size (hash-table-rehash-size ht)) + (Assert-eql rehash-threshold (hash-table-rehash-threshold ht)) + (Assert-eq weakness (hash-table-weakness ht))))))))) (loop for (fun weakness) in '((make-hashtable nil) (make-weak-hashtable key-and-value) (make-key-weak-hashtable key) (make-value-weak-hashtable value)) - do (Assert (eq weakness (hash-table-weakness (funcall fun 10))))) + do (Assert-eq weakness (hash-table-weakness (funcall fun 10)))) (loop for (type weakness) in '((non-weak nil) (weak key-and-value) (key-weak key) (value-weak value)) - do (Assert (equal (make-hash-table :type type) - (make-hash-table :weakness weakness)))) + do (Assert-equal (make-hash-table :type type) + (make-hash-table :weakness weakness))) (Assert (not (equal (make-hash-table :weakness nil) (make-hash-table :weakness t)))) @@ -77,86 +77,86 @@ (size 80)) (Assert (hashtablep ht)) (Assert (hash-table-p ht)) - (Assert (eq 'eq (hash-table-test ht))) - (Assert (eq 'non-weak (hash-table-type ht))) - (Assert (eq 'non-weak (hashtable-type ht))) - (Assert (eq 'nil (hash-table-weakness ht))) + (Assert-eq 'eq (hash-table-test ht)) + (Assert-eq 'non-weak (hash-table-type ht)) + (Assert-eq 'non-weak (hashtable-type ht)) + (Assert-eq 'nil (hash-table-weakness ht)) (dotimes (j size) (puthash j (- j) ht) - (Assert (eq (gethash j ht) (- j))) - (Assert (= (hash-table-count ht) (1+ j))) - (Assert (= (hashtable-fullness ht) (hash-table-count ht))) + (Assert-eq (gethash j ht) (- j)) + (Assert= (hash-table-count ht) (1+ j)) + (Assert= (hashtable-fullness ht) (hash-table-count ht)) (puthash j j ht) - (Assert (eq (gethash j ht 'foo) j)) - (Assert (= (hash-table-count ht) (1+ j))) + (Assert-eq (gethash j ht 'foo) j) + (Assert= (hash-table-count ht) (1+ j)) (setf (gethash j ht) (- j)) - (Assert (eq (gethash j ht) (- j))) - (Assert (= (hash-table-count ht) (1+ j)))) + (Assert-eq (gethash j ht) (- j)) + (Assert= (hash-table-count ht) (1+ j))) (clrhash ht) - (Assert (= 0 (hash-table-count ht))) + (Assert= 0 (hash-table-count ht)) (dotimes (j size) (puthash j (- j) ht) - (Assert (eq (gethash j ht) (- j))) - (Assert (= (hash-table-count ht) (1+ j)))) + (Assert-eq (gethash j ht) (- j)) + (Assert= (hash-table-count ht) (1+ j))) (let ((k-sum 0) (v-sum 0)) (maphash #'(lambda (k v) (incf k-sum k) (incf v-sum v)) ht) - (Assert (= k-sum (/ (* size (- size 1)) 2))) - (Assert (= v-sum (- k-sum)))) + (Assert= k-sum (/ (* size (- size 1)) 2)) + (Assert= v-sum (- k-sum))) (let ((count size)) (dotimes (j size) (remhash j ht) - (Assert (eq (gethash j ht) nil)) - (Assert (eq (gethash j ht 'foo) 'foo)) - (Assert (= (hash-table-count ht) (decf count)))))) + (Assert-eq (gethash j ht) nil) + (Assert-eq (gethash j ht 'foo) 'foo) + (Assert= (hash-table-count ht) (decf count))))) (let ((ht (make-hash-table :size 30 :rehash-threshold .25 :test 'equal)) (size 70)) (Assert (hashtablep ht)) (Assert (hash-table-p ht)) (Assert (>= (hash-table-size ht) (/ 30 .25))) - (Assert (eql .25 (hash-table-rehash-threshold ht))) - (Assert (eq 'equal (hash-table-test ht))) - (Assert (eq (hash-table-test ht) (hashtable-test-function ht))) - (Assert (eq 'non-weak (hash-table-type ht))) + (Assert-eql .25 (hash-table-rehash-threshold ht)) + (Assert-eq 'equal (hash-table-test ht)) + (Assert-eq (hash-table-test ht) (hashtable-test-function ht)) + (Assert-eq 'non-weak (hash-table-type ht)) (dotimes (j size) (puthash (int-to-string j) (- j) ht) - (Assert (eq (gethash (int-to-string j) ht) (- j))) - (Assert (= (hash-table-count ht) (1+ j))) + (Assert-eq (gethash (int-to-string j) ht) (- j)) + (Assert= (hash-table-count ht) (1+ j)) (puthash (int-to-string j) j ht) - (Assert (eq (gethash (int-to-string j) ht 'foo) j)) - (Assert (= (hash-table-count ht) (1+ j)))) + (Assert-eq (gethash (int-to-string j) ht 'foo) j) + (Assert= (hash-table-count ht) (1+ j))) (clrhash ht) - (Assert (= 0 (hash-table-count ht))) - (Assert (equal ht (copy-hash-table ht))) + (Assert= 0 (hash-table-count ht)) + (Assert-equal ht (copy-hash-table ht)) (dotimes (j size) (setf (gethash (int-to-string j) ht) (- j)) - (Assert (eq (gethash (int-to-string j) ht) (- j))) - (Assert (= (hash-table-count ht) (1+ j)))) + (Assert-eq (gethash (int-to-string j) ht) (- j)) + (Assert= (hash-table-count ht) (1+ j))) (let ((count size)) (dotimes (j size) (remhash (int-to-string j) ht) - (Assert (eq (gethash (int-to-string j) ht) nil)) - (Assert (eq (gethash (int-to-string j) ht 'foo) 'foo)) - (Assert (= (hash-table-count ht) (decf count)))))) + (Assert-eq (gethash (int-to-string j) ht) nil) + (Assert-eq (gethash (int-to-string j) ht 'foo) 'foo) + (Assert= (hash-table-count ht) (decf count))))) (let ((iterations 5) (one 1.0) (two 2.0)) (flet ((check-copy (ht) (let ((copy-of-ht (copy-hash-table ht))) - (Assert (equal ht copy-of-ht)) + (Assert-equal ht copy-of-ht) (Assert (not (eq ht copy-of-ht))) - (Assert (eq (hash-table-count ht) (hash-table-count copy-of-ht))) - (Assert (eq (hash-table-type ht) (hash-table-type copy-of-ht))) - (Assert (eq (hash-table-size ht) (hash-table-size copy-of-ht))) - (Assert (eql (hash-table-rehash-size ht) (hash-table-rehash-size copy-of-ht))) - (Assert (eql (hash-table-rehash-threshold ht) (hash-table-rehash-threshold copy-of-ht)))))) + (Assert-eq (hash-table-count ht) (hash-table-count copy-of-ht)) + (Assert-eq (hash-table-type ht) (hash-table-type copy-of-ht)) + (Assert-eq (hash-table-size ht) (hash-table-size copy-of-ht)) + (Assert-eql (hash-table-rehash-size ht) (hash-table-rehash-size copy-of-ht)) + (Assert-eql (hash-table-rehash-threshold ht) (hash-table-rehash-threshold copy-of-ht))))) (let ((ht (make-hash-table :size 100 :rehash-threshold .6 :test 'eq))) (dotimes (j iterations) @@ -164,11 +164,11 @@ (puthash (+ two 0.0) t ht) (puthash (cons 1 2) t ht) (puthash (cons 3 4) t ht)) - (Assert (eq (hashtable-test-function ht) 'eq)) - (Assert (eq (hash-table-test ht) 'eq)) - (Assert (= (* iterations 4) (hash-table-count ht))) - (Assert (eq nil (gethash 1.0 ht))) - (Assert (eq nil (gethash '(1 . 2) ht))) + (Assert-eq (hashtable-test-function ht) 'eq) + (Assert-eq (hash-table-test ht) 'eq) + (Assert= (* iterations 4) (hash-table-count ht)) + (Assert-eq nil (gethash 1.0 ht)) + (Assert-eq nil (gethash '(1 . 2) ht)) (check-copy ht) ) @@ -178,11 +178,11 @@ (puthash (+ two 0.0) t ht) (puthash (cons 1 2) t ht) (puthash (cons 3 4) t ht)) - (Assert (eq (hashtable-test-function ht) 'eql)) - (Assert (eq (hash-table-test ht) 'eql)) - (Assert (= (+ 2 (* 2 iterations)) (hash-table-count ht))) - (Assert (eq t (gethash 1.0 ht))) - (Assert (eq nil (gethash '(1 . 2) ht))) + (Assert-eq (hashtable-test-function ht) 'eql) + (Assert-eq (hash-table-test ht) 'eql) + (Assert= (+ 2 (* 2 iterations)) (hash-table-count ht)) + (Assert-eq t (gethash 1.0 ht)) + (Assert-eq nil (gethash '(1 . 2) ht)) (check-copy ht) ) @@ -192,11 +192,11 @@ (puthash (+ two 0.0) t ht) (puthash (cons 1 2) t ht) (puthash (cons 3 4) t ht)) - (Assert (eq (hashtable-test-function ht) 'equal)) - (Assert (eq (hash-table-test ht) 'equal)) - (Assert (= 4 (hash-table-count ht))) - (Assert (eq t (gethash 1.0 ht))) - (Assert (eq t (gethash '(1 . 2) ht))) + (Assert-eq (hashtable-test-function ht) 'equal) + (Assert-eq (hash-table-test ht) 'equal) + (Assert= 4 (hash-table-count ht)) + (Assert-eq t (gethash 1.0 ht)) + (Assert-eq t (gethash '(1 . 2) ht)) (check-copy ht) ) @@ -223,18 +223,18 @@ (when (integerp k) (incf k-sum k)) (when (integerp v) (incf v-sum v))) ht) - (Assert (eq 38 k-sum)) - (Assert (eq 25 v-sum))) - (Assert (eq 6 (hash-table-count ht))) + (Assert-eq 38 k-sum) + (Assert-eq 25 v-sum)) + (Assert-eq 6 (hash-table-count ht)) (garbage-collect) - (Assert (eq expected-count (hash-table-count ht))) + (Assert-eq expected-count (hash-table-count ht)) (let ((k-sum 0) (v-sum 0)) (maphash #'(lambda (k v) (when (integerp k) (incf k-sum k)) (when (integerp v) (incf v-sum v))) ht) - (Assert (eq expected-k-sum k-sum)) - (Assert (eq expected-v-sum v-sum))))) + (Assert-eq expected-k-sum k-sum) + (Assert-eq expected-v-sum v-sum)))) ;;; Test the ability to puthash and remhash the current elt of a maphash (let ((ht (make-hash-table :test 'eql))) @@ -244,41 +244,41 @@ ht) (let ((k-sum 0) (v-sum 0)) (maphash #'(lambda (k v) (incf k-sum k) (incf v-sum v)) ht) - (Assert (= (* 50 49) k-sum)) - (Assert (= v-sum k-sum)))) + (Assert= (* 50 49) k-sum) + (Assert= v-sum k-sum))) ;;; Test reading and printing of hash-table objects (let ((h1 #s(hashtable weakness t rehash-size 3.0 rehash-threshold .2 test eq data (1 2 3 4))) (h2 #s(hash-table weakness t rehash-size 3.0 rehash-threshold .2 test eq data (1 2 3 4))) (h3 (make-hash-table :weakness t :rehash-size 3.0 :rehash-threshold .2 :test 'eq))) - (Assert (equal h1 h2)) + (Assert-equal h1 h2) (Assert (not (equal h1 h3))) (puthash 1 2 h3) (puthash 3 4 h3) - (Assert (equal h1 h3))) + (Assert-equal h1 h3)) ;;; Testing equality of hash tables -(Assert (equal (make-hash-table :test 'eql :size 300 :rehash-threshold .9 :rehash-size 3.0) - (make-hash-table :test 'eql))) +(Assert-equal (make-hash-table :test 'eql :size 300 :rehash-threshold .9 :rehash-size 3.0) + (make-hash-table :test 'eql)) (Assert (not (equal (make-hash-table :test 'eq) (make-hash-table :test 'equal)))) (let ((h1 (make-hash-table)) (h2 (make-hash-table))) - (Assert (equal h1 h2)) + (Assert-equal h1 h2) (Assert (not (eq h1 h2))) (puthash 1 2 h1) (Assert (not (equal h1 h2))) (puthash 1 2 h2) - (Assert (equal h1 h2)) + (Assert-equal h1 h2) (puthash 1 3 h2) (Assert (not (equal h1 h2))) (clrhash h1) (Assert (not (equal h1 h2))) (clrhash h2) - (Assert (equal h1 h2)) + (Assert-equal h1 h2) ) ;;; Test sxhash -(Assert (= (sxhash "foo") (sxhash "foo"))) -(Assert (= (sxhash '(1 2 3)) (sxhash '(1 2 3)))) +(Assert= (sxhash "foo") (sxhash "foo")) +(Assert= (sxhash '(1 2 3)) (sxhash '(1 2 3))) (Assert (/= (sxhash '(1 2 3)) (sxhash '(3 2 1))))
--- a/tests/automated/lisp-tests.el Thu Jan 14 01:25:16 2010 -0600 +++ b/tests/automated/lisp-tests.el Thu Jan 14 02:18:03 2010 -0600 @@ -42,19 +42,19 @@ (Check-Error wrong-number-of-arguments (setq setq-test-foo 1 setq-test-bar)) (Check-Error wrong-number-of-arguments (setq-default setq-test-foo)) (Check-Error wrong-number-of-arguments (setq-default setq-test-foo 1 setq-test-bar)) -(Assert (eq (setq) nil)) -(Assert (eq (setq-default) nil)) -(Assert (eq (setq setq-test-foo 42) 42)) -(Assert (eq (setq-default setq-test-foo 42) 42)) -(Assert (eq (setq setq-test-foo 42 setq-test-bar 99) 99)) -(Assert (eq (setq-default setq-test-foo 42 setq-test-bar 99) 99)) +(Assert-eq (setq) nil) +(Assert-eq (setq-default) nil) +(Assert-eq (setq setq-test-foo 42) 42) +(Assert-eq (setq-default setq-test-foo 42) 42) +(Assert-eq (setq setq-test-foo 42 setq-test-bar 99) 99) +(Assert-eq (setq-default setq-test-foo 42 setq-test-bar 99) 99) (macrolet ((test-setq (expected-result &rest body) `(progn (defun test-setq-fun () ,@body) - (Assert (eq ,expected-result (test-setq-fun))) + (Assert-eq ,expected-result (test-setq-fun)) (byte-compile 'test-setq-fun) - (Assert (eq ,expected-result (test-setq-fun)))))) + (Assert-eq ,expected-result (test-setq-fun))))) (test-setq nil (setq)) (test-setq nil (setq-default)) (test-setq 42 (setq test-setq-var 42)) @@ -69,38 +69,38 @@ (my-list '(1 2 3 4))) ;;(Assert (fooooo)) ;; Generate Other failure - ;;(Assert (eq 1 2)) ;; Generate Assertion failure + ;;(Assert-eq 1 2) ;; Generate Assertion failure (dolist (sequence (list my-vector my-bit-vector my-string my-list)) (Assert (sequencep sequence)) - (Assert (eq 4 (length sequence)))) + (Assert-eq 4 (length sequence))) (dolist (array (list my-vector my-bit-vector my-string)) (Assert (arrayp array))) - (Assert (eq (elt my-vector 0) 1)) - (Assert (eq (elt my-bit-vector 0) 1)) - (Assert (eq (elt my-string 0) ?1)) - (Assert (eq (elt my-list 0) 1)) + (Assert-eq (elt my-vector 0) 1) + (Assert-eq (elt my-bit-vector 0) 1) + (Assert-eq (elt my-string 0) ?1) + (Assert-eq (elt my-list 0) 1) (fillarray my-vector 5) (fillarray my-bit-vector 1) (fillarray my-string ?5) (dolist (array (list my-vector my-bit-vector)) - (Assert (eq 4 (length array)))) + (Assert-eq 4 (length array))) - (Assert (eq (elt my-vector 0) 5)) - (Assert (eq (elt my-bit-vector 0) 1)) - (Assert (eq (elt my-string 0) ?5)) + (Assert-eq (elt my-vector 0) 5) + (Assert-eq (elt my-bit-vector 0) 1) + (Assert-eq (elt my-string 0) ?5) - (Assert (eq (elt my-vector 3) 5)) - (Assert (eq (elt my-bit-vector 3) 1)) - (Assert (eq (elt my-string 3) ?5)) + (Assert-eq (elt my-vector 3) 5) + (Assert-eq (elt my-bit-vector 3) 1) + (Assert-eq (elt my-string 3) ?5) (fillarray my-bit-vector 0) - (Assert (eq 4 (length my-bit-vector))) - (Assert (eq (elt my-bit-vector 2) 0)) + (Assert-eq 4 (length my-bit-vector)) + (Assert-eq (elt my-bit-vector 2) 0) ) (defun make-circular-list (length) @@ -124,22 +124,22 @@ (Check-Error circular-list (nconc '(1 . 2) (make-circular-list length) 'foo)) (Check-Error circular-list (nconc '(1 . 2) '(3 . 4) (make-circular-list length) 'foo))) -(Assert (eq (nconc) nil)) -(Assert (eq (nconc nil) nil)) -(Assert (eq (nconc nil nil) nil)) -(Assert (eq (nconc nil nil nil) nil)) +(Assert-eq (nconc) nil) +(Assert-eq (nconc nil) nil) +(Assert-eq (nconc nil nil) nil) +(Assert-eq (nconc nil nil nil) nil) -(let ((x (make-list-012))) (Assert (eq (nconc nil x) x))) -(let ((x (make-list-012))) (Assert (eq (nconc x nil) x))) -(let ((x (make-list-012))) (Assert (eq (nconc nil x nil) x))) -(let ((x (make-list-012))) (Assert (eq (nconc x) x))) -(let ((x (make-list-012))) (Assert (eq (nconc x (make-circular-list 3)) x))) +(let ((x (make-list-012))) (Assert-eq (nconc nil x) x)) +(let ((x (make-list-012))) (Assert-eq (nconc x nil) x)) +(let ((x (make-list-012))) (Assert-eq (nconc nil x nil) x)) +(let ((x (make-list-012))) (Assert-eq (nconc x) x)) +(let ((x (make-list-012))) (Assert-eq (nconc x (make-circular-list 3)) x)) -(Assert (equal (nconc '(1 . 2) '(3 . 4) '(5 . 6)) '(1 3 5 . 6))) +(Assert-equal (nconc '(1 . 2) '(3 . 4) '(5 . 6)) '(1 3 5 . 6)) (let ((y (nconc (make-list-012) nil (list 3 4 5) nil))) - (Assert (eq (length y) 6)) - (Assert (eq (nth 3 y) 3))) + (Assert-eq (length y) 6) + (Assert-eq (nth 3 y) 3)) ;;----------------------------------------------------- ;; Test `last' @@ -150,15 +150,15 @@ (Check-Error circular-list (last (make-circular-list 1))) (Check-Error circular-list (last (make-circular-list 2000))) (let ((x (list 0 1 2 3))) - (Assert (eq (last nil) nil)) - (Assert (eq (last x 0) nil)) - (Assert (eq (last x ) (cdddr x))) - (Assert (eq (last x 1) (cdddr x))) - (Assert (eq (last x 2) (cddr x))) - (Assert (eq (last x 3) (cdr x))) - (Assert (eq (last x 4) x)) - (Assert (eq (last x 9) x)) - (Assert (eq (last '(1 . 2) 0) 2)) + (Assert-eq (last nil) nil) + (Assert-eq (last x 0) nil) + (Assert-eq (last x ) (cdddr x)) + (Assert-eq (last x 1) (cdddr x)) + (Assert-eq (last x 2) (cddr x)) + (Assert-eq (last x 3) (cdr x)) + (Assert-eq (last x 4) x) + (Assert-eq (last x 9) x) + (Assert-eq (last '(1 . 2) 0) 2) ) ;;----------------------------------------------------- @@ -178,31 +178,31 @@ (let* ((x (list 0 1 2 3)) (y (butlast x)) (z (nbutlast x))) - (Assert (eq z x)) + (Assert-eq z x) (Assert (not (eq y x))) - (Assert (equal y '(0 1 2))) - (Assert (equal z y))) + (Assert-equal y '(0 1 2)) + (Assert-equal z y)) (let* ((x (list 0 1 2 3 4)) (y (butlast x 2)) (z (nbutlast x 2))) - (Assert (eq z x)) + (Assert-eq z x) (Assert (not (eq y x))) - (Assert (equal y '(0 1 2))) - (Assert (equal z y))) + (Assert-equal y '(0 1 2)) + (Assert-equal z y)) (let* ((x (list 0 1 2 3)) (y (butlast x 0)) (z (nbutlast x 0))) - (Assert (eq z x)) + (Assert-eq z x) (Assert (not (eq y x))) - (Assert (equal y '(0 1 2 3))) - (Assert (equal z y))) + (Assert-equal y '(0 1 2 3)) + (Assert-equal z y)) -(Assert (eq (butlast '(x)) nil)) -(Assert (eq (nbutlast '(x)) nil)) -(Assert (eq (butlast '()) nil)) -(Assert (eq (nbutlast '()) nil)) +(Assert-eq (butlast '(x)) nil) +(Assert-eq (nbutlast '(x)) nil) +(Assert-eq (butlast '()) nil) +(Assert-eq (nbutlast '()) nil) ;;----------------------------------------------------- ;; Test `copy-list' @@ -212,7 +212,7 @@ (Check-Error wrong-number-of-arguments (copy-list '(1 2) 1)) (Check-Error circular-list (copy-list (make-circular-list 1))) (Check-Error circular-list (copy-list (make-circular-list 2000))) -(Assert (eq '() (copy-list '()))) +(Assert-eq '() (copy-list '())) (dolist (x '((1) (1 2) (1 2 3) (1 2 . 3))) (let ((y (copy-list x))) (Assert (and (equal x y) (not (eq x y)))))) @@ -222,24 +222,24 @@ ;;----------------------------------------------------- ;; Test `+' -(Assert (eq (+ 1 1) 2)) -(Assert (= (+ 1.0 1.0) 2.0)) -(Assert (= (+ 1.0 3.0 0.0) 4.0)) -(Assert (= (+ 1 1.0) 2.0)) -(Assert (= (+ 1.0 1) 2.0)) -(Assert (= (+ 1.0 1 1) 3.0)) -(Assert (= (+ 1 1 1.0) 3.0)) +(Assert-eq (+ 1 1) 2) +(Assert= (+ 1.0 1.0) 2.0) +(Assert= (+ 1.0 3.0 0.0) 4.0) +(Assert= (+ 1 1.0) 2.0) +(Assert= (+ 1.0 1) 2.0) +(Assert= (+ 1.0 1 1) 3.0) +(Assert= (+ 1 1 1.0) 3.0) (if (featurep 'bignum) (progn (Assert (bignump (1+ most-positive-fixnum))) - (Assert (eq most-positive-fixnum (1- (1+ most-positive-fixnum)))) + (Assert-eq most-positive-fixnum (1- (1+ most-positive-fixnum))) (Assert (bignump (+ most-positive-fixnum 1))) - (Assert (eq most-positive-fixnum (- (+ most-positive-fixnum 1) 1))) - (Assert (= (1+ most-positive-fixnum) (- most-negative-fixnum))) + (Assert-eq most-positive-fixnum (- (+ most-positive-fixnum 1) 1)) + (Assert= (1+ most-positive-fixnum) (- most-negative-fixnum)) (Assert (zerop (+ (* 3 most-negative-fixnum) (* 3 most-positive-fixnum) 3)))) - (Assert (eq (1+ most-positive-fixnum) most-negative-fixnum)) - (Assert (eq (+ most-positive-fixnum 1) most-negative-fixnum))) + (Assert-eq (1+ most-positive-fixnum) most-negative-fixnum) + (Assert-eq (+ most-positive-fixnum 1) most-negative-fixnum)) (when (featurep 'ratio) (let ((threefourths (read "3/4")) @@ -247,47 +247,47 @@ (bigpos (div (+ most-positive-fixnum 2) (1+ most-positive-fixnum))) (bigneg (div (+ most-positive-fixnum 2) most-negative-fixnum)) (negone (div (1+ most-positive-fixnum) most-negative-fixnum))) - (Assert (= negone -1)) - (Assert (= threehalfs (+ threefourths threefourths))) + (Assert= negone -1) + (Assert= threehalfs (+ threefourths threefourths)) (Assert (zerop (+ bigpos bigneg))))) ;; Test `-' (Check-Error wrong-number-of-arguments (-)) -(Assert (eq (- 0) 0)) -(Assert (eq (- 1) -1)) +(Assert-eq (- 0) 0) +(Assert-eq (- 1) -1) (dolist (one `(1 1.0 ?\1 ,(Int-to-Marker 1))) - (Assert (= (+ 1 one) 2)) - (Assert (= (+ one) 1)) - (Assert (= (+ one) one)) - (Assert (= (- one) -1)) - (Assert (= (- one one) 0)) - (Assert (= (- one one one) -1)) - (Assert (= (- 0 one) -1)) - (Assert (= (- 0 one one) -2)) - (Assert (= (+ one 1) 2)) + (Assert= (+ 1 one) 2) + (Assert= (+ one) 1) + (Assert= (+ one) one) + (Assert= (- one) -1) + (Assert= (- one one) 0) + (Assert= (- one one one) -1) + (Assert= (- 0 one) -1) + (Assert= (- 0 one one) -2) + (Assert= (+ one 1) 2) (dolist (zero '(0 0.0 ?\0)) - (Assert (= (+ 1 zero) 1) zero) - (Assert (= (+ zero 1) 1) zero) - (Assert (= (- zero) zero) zero) - (Assert (= (- zero) 0) zero) - (Assert (= (- zero zero) 0) zero) - (Assert (= (- zero one one) -2) zero))) + (Assert= (+ 1 zero) 1 zero) + (Assert= (+ zero 1) 1 zero) + (Assert= (- zero) zero zero) + (Assert= (- zero) 0 zero) + (Assert= (- zero zero) 0 zero) + (Assert= (- zero one one) -2 zero))) -(Assert (= (- 1.5 1) .5)) -(Assert (= (- 1 1.5) (- .5))) +(Assert= (- 1.5 1) .5) +(Assert= (- 1 1.5) (- .5)) (if (featurep 'bignum) (progn (Assert (bignump (1- most-negative-fixnum))) - (Assert (eq most-negative-fixnum (1+ (1- most-negative-fixnum)))) + (Assert-eq most-negative-fixnum (1+ (1- most-negative-fixnum))) (Assert (bignump (- most-negative-fixnum 1))) - (Assert (eq most-negative-fixnum (+ (- most-negative-fixnum 1) 1))) - (Assert (= (1- most-negative-fixnum) (- 0 most-positive-fixnum 2))) - (Assert (eq (- (- most-positive-fixnum most-negative-fixnum) + (Assert-eq most-negative-fixnum (+ (- most-negative-fixnum 1) 1)) + (Assert= (1- most-negative-fixnum) (- 0 most-positive-fixnum 2)) + (Assert-eq (- (- most-positive-fixnum most-negative-fixnum) (* 2 most-positive-fixnum)) - 1))) - (Assert (eq (1- most-negative-fixnum) most-positive-fixnum)) - (Assert (eq (- most-negative-fixnum 1) most-positive-fixnum))) + 1)) + (Assert-eq (1- most-negative-fixnum) most-positive-fixnum) + (Assert-eq (- most-negative-fixnum 1) most-positive-fixnum)) (when (featurep 'ratio) (let ((threefourths (read "3/4")) @@ -295,9 +295,9 @@ (bigpos (div (+ most-positive-fixnum 2) (1+ most-positive-fixnum))) (bigneg (div most-positive-fixnum most-negative-fixnum)) (negone (div (1+ most-positive-fixnum) most-negative-fixnum))) - (Assert (= (- negone) 1)) - (Assert (= threefourths (- threehalfs threefourths))) - (Assert (= (- bigpos bigneg) 2)))) + (Assert= (- negone) 1) + (Assert= threefourths (- threehalfs threefourths)) + (Assert= (- bigpos bigneg) 2))) ;; Test `/' @@ -312,180 +312,180 @@ ;; Other tests for `/' (Check-Error wrong-number-of-arguments (/)) (let (x) - (Assert (= (/ (setq x 2)) 0)) - (Assert (= (/ (setq x 2.0)) 0.5))) + (Assert= (/ (setq x 2)) 0) + (Assert= (/ (setq x 2.0)) 0.5)) (dolist (six '(6 6.0 ?\06)) (dolist (two '(2 2.0 ?\02)) (dolist (three '(3 3.0 ?\03)) - (Assert (= (/ six two) three) (list six two three))))) + (Assert= (/ six two) three (list six two three))))) (dolist (three '(3 3.0 ?\03)) - (Assert (= (/ three 2.0) 1.5) three)) + (Assert= (/ three 2.0) 1.5 three)) (dolist (two '(2 2.0 ?\02)) - (Assert (= (/ 3.0 two) 1.5) two)) + (Assert= (/ 3.0 two) 1.5 two)) (when (featurep 'bignum) (let* ((million 1000000) (billion (* million 1000)) ;; American, not British, billion (trillion (* billion 1000))) - (Assert (= (/ billion 1000) (/ trillion million) million 1000000.0)) - (Assert (= (/ billion -1000) (/ trillion (- million)) (- million))) - (Assert (= (/ trillion 1000) billion 1000000000.0)) - (Assert (= (/ trillion -1000) (- billion) -1000000000.0)) - (Assert (= (/ trillion 10) (* 100 billion) 100000000000.0)) - (Assert (= (/ (- trillion) 10) (* -100 billion) -100000000000.0)))) + (Assert= (/ billion 1000) (/ trillion million) million 1000000.0) + (Assert= (/ billion -1000) (/ trillion (- million)) (- million)) + (Assert= (/ trillion 1000) billion 1000000000.0) + (Assert= (/ trillion -1000) (- billion) -1000000000.0) + (Assert= (/ trillion 10) (* 100 billion) 100000000000.0) + (Assert= (/ (- trillion) 10) (* -100 billion) -100000000000.0))) (when (featurep 'ratio) (let ((half (div 1 2)) (fivefourths (div 5 4)) (fivehalfs (div 5 2))) - (Assert (= half (read "3000000000/6000000000"))) - (Assert (= (/ fivehalfs fivefourths) 2)) - (Assert (= (/ fivefourths fivehalfs) half)) - (Assert (= (- half) (read "-3000000000/6000000000"))) - (Assert (= (/ fivehalfs (- fivefourths)) -2)) - (Assert (= (/ (- fivefourths) fivehalfs) (- half))))) + (Assert= half (read "3000000000/6000000000")) + (Assert= (/ fivehalfs fivefourths) 2) + (Assert= (/ fivefourths fivehalfs) half) + (Assert= (- half) (read "-3000000000/6000000000")) + (Assert= (/ fivehalfs (- fivefourths)) -2) + (Assert= (/ (- fivefourths) fivehalfs) (- half)))) ;; Test `*' -(Assert (= 1 (*))) +(Assert= 1 (*)) (dolist (one `(1 1.0 ?\01 ,(Int-to-Marker 1))) - (Assert (= 1 (* one)) one)) + (Assert= 1 (* one) one)) (dolist (two '(2 2.0 ?\02)) - (Assert (= 2 (* two)) two)) + (Assert= 2 (* two) two)) (dolist (six '(6 6.0 ?\06)) (dolist (two '(2 2.0 ?\02)) (dolist (three '(3 3.0 ?\03)) - (Assert (= (* three two) six) (list three two six))))) + (Assert= (* three two) six (list three two six))))) (dolist (three '(3 3.0 ?\03)) (dolist (two '(2 2.0 ?\02)) - (Assert (= (* 1.5 two) three) (list two three)) + (Assert= (* 1.5 two) three (list two three)) (dolist (five '(5 5.0 ?\05)) - (Assert (= 30 (* five two three)) (list five two three))))) + (Assert= 30 (* five two three) (list five two three))))) (when (featurep 'bignum) (let ((64K 65536)) - (Assert (= (* 64K 64K) (read "4294967296"))) - (Assert (= (* (- 64K) 64K) (read "-4294967296"))) + (Assert= (* 64K 64K) (read "4294967296")) + (Assert= (* (- 64K) 64K) (read "-4294967296")) (Assert (/= (* -1 most-negative-fixnum) most-negative-fixnum)))) (when (featurep 'ratio) (let ((half (div 1 2)) (fivefourths (div 5 4)) (twofifths (div 2 5))) - (Assert (= (* fivefourths twofifths) half)) - (Assert (= (* half twofifths) (read "3/15"))))) + (Assert= (* fivefourths twofifths) half) + (Assert= (* half twofifths) (read "3/15")))) ;; Test `+' -(Assert (= 0 (+))) +(Assert= 0 (+)) (dolist (one `(1 1.0 ?\01 ,(Int-to-Marker 1))) - (Assert (= 1 (+ one)) one)) + (Assert= 1 (+ one) one)) (dolist (two '(2 2.0 ?\02)) - (Assert (= 2 (+ two)) two)) + (Assert= 2 (+ two) two)) (dolist (five '(5 5.0 ?\05)) (dolist (two '(2 2.0 ?\02)) (dolist (three '(3 3.0 ?\03)) - (Assert (= (+ three two) five) (list three two five)) - (Assert (= 10 (+ five two three)) (list five two three))))) + (Assert= (+ three two) five (list three two five)) + (Assert= 10 (+ five two three) (list five two three))))) ;; Test `max', `min' (dolist (one `(1 1.0 ?\01 ,(Int-to-Marker 1))) - (Assert (= one (max one)) one) - (Assert (= one (max one one)) one) - (Assert (= one (max one one one)) one) - (Assert (= one (min one)) one) - (Assert (= one (min one one)) one) - (Assert (= one (min one one one)) one) + (Assert= one (max one) one) + (Assert= one (max one one) one) + (Assert= one (max one one one) one) + (Assert= one (min one) one) + (Assert= one (min one one) one) + (Assert= one (min one one one) one) (dolist (two `(2 2.0 ?\02 ,(Int-to-Marker 2))) - (Assert (= one (min one two)) (list one two)) - (Assert (= one (min one two two)) (list one two)) - (Assert (= one (min two two one)) (list one two)) - (Assert (= two (max one two)) (list one two)) - (Assert (= two (max one two two)) (list one two)) - (Assert (= two (max two two one)) (list one two)))) + (Assert= one (min one two) (list one two)) + (Assert= one (min one two two) (list one two)) + (Assert= one (min two two one) (list one two)) + (Assert= two (max one two) (list one two)) + (Assert= two (max one two two) (list one two)) + (Assert= two (max two two one) (list one two)))) (when (featurep 'bignum) (let ((big (1+ most-positive-fixnum)) (small (1- most-negative-fixnum))) - (Assert (= big (max 1 1000000.0 most-positive-fixnum big))) - (Assert (= small (min -1 -1000000.0 most-negative-fixnum small))))) + (Assert= big (max 1 1000000.0 most-positive-fixnum big)) + (Assert= small (min -1 -1000000.0 most-negative-fixnum small)))) (when (featurep 'ratio) (let* ((big (1+ most-positive-fixnum)) (small (1- most-negative-fixnum)) (bigr (div (* 5 (1+ most-positive-fixnum)) 4)) (smallr (- bigr))) - (Assert (= bigr (max 1 1000000.0 most-positive-fixnum big bigr))) - (Assert (= smallr (min -1 -1000000.0 most-negative-fixnum small smallr))))) + (Assert= bigr (max 1 1000000.0 most-positive-fixnum big bigr)) + (Assert= smallr (min -1 -1000000.0 most-negative-fixnum small smallr)))) ;; The byte compiler has special handling for these constructs: (let ((three 3) (five 5)) - (Assert (= (+ three five 1) 9)) - (Assert (= (+ 1 three five) 9)) - (Assert (= (+ three five -1) 7)) - (Assert (= (+ -1 three five) 7)) - (Assert (= (+ three 1) 4)) - (Assert (= (+ three -1) 2)) - (Assert (= (+ -1 three) 2)) - (Assert (= (+ -1 three) 2)) - (Assert (= (- three five 1) -3)) - (Assert (= (- 1 three five) -7)) - (Assert (= (- three five -1) -1)) - (Assert (= (- -1 three five) -9)) - (Assert (= (- three 1) 2)) - (Assert (= (- three 2 1) 0)) - (Assert (= (- 2 three 1) -2)) - (Assert (= (- three -1) 4)) - (Assert (= (- three 0) 3)) - (Assert (= (- three 0 five) -2)) - (Assert (= (- 0 three 0 five) -8)) - (Assert (= (- 0 three five) -8)) - (Assert (= (* three 2) 6)) - (Assert (= (* three -1 five) -15)) - (Assert (= (* three 1 five) 15)) - (Assert (= (* three 0 five) 0)) - (Assert (= (* three 2 five) 30)) - (Assert (= (/ three 1) 3)) - (Assert (= (/ three -1) -3)) - (Assert (= (/ (* five five) 2 2) 6)) - (Assert (= (/ 64 five 2) 6))) + (Assert= (+ three five 1) 9) + (Assert= (+ 1 three five) 9) + (Assert= (+ three five -1) 7) + (Assert= (+ -1 three five) 7) + (Assert= (+ three 1) 4) + (Assert= (+ three -1) 2) + (Assert= (+ -1 three) 2) + (Assert= (+ -1 three) 2) + (Assert= (- three five 1) -3) + (Assert= (- 1 three five) -7) + (Assert= (- three five -1) -1) + (Assert= (- -1 three five) -9) + (Assert= (- three 1) 2) + (Assert= (- three 2 1) 0) + (Assert= (- 2 three 1) -2) + (Assert= (- three -1) 4) + (Assert= (- three 0) 3) + (Assert= (- three 0 five) -2) + (Assert= (- 0 three 0 five) -8) + (Assert= (- 0 three five) -8) + (Assert= (* three 2) 6) + (Assert= (* three -1 five) -15) + (Assert= (* three 1 five) 15) + (Assert= (* three 0 five) 0) + (Assert= (* three 2 five) 30) + (Assert= (/ three 1) 3) + (Assert= (/ three -1) -3) + (Assert= (/ (* five five) 2 2) 6) + (Assert= (/ 64 five 2) 6)) ;;----------------------------------------------------- ;; Logical bit-twiddling operations ;;----------------------------------------------------- -(Assert (= (logxor) 0)) -(Assert (= (logior) 0)) -(Assert (= (logand) -1)) +(Assert= (logxor) 0) +(Assert= (logior) 0) +(Assert= (logand) -1) (Check-Error wrong-type-argument (logxor 3.0)) (Check-Error wrong-type-argument (logior 3.0)) (Check-Error wrong-type-argument (logand 3.0)) (dolist (three '(3 ?\03)) - (Assert (eq 3 (logand three)) three) - (Assert (eq 3 (logxor three)) three) - (Assert (eq 3 (logior three)) three) - (Assert (eq 3 (logand three three)) three) - (Assert (eq 0 (logxor three three)) three) - (Assert (eq 3 (logior three three))) three) + (Assert-eq 3 (logand three) three) + (Assert-eq 3 (logxor three) three) + (Assert-eq 3 (logior three) three) + (Assert-eq 3 (logand three three) three) + (Assert-eq 0 (logxor three three) three) + (Assert-eq 3 (logior three three)) three) (dolist (one `(1 ?\01 ,(Int-to-Marker 1))) (dolist (two '(2 ?\02)) - (Assert (eq 0 (logand one two)) (list one two)) - (Assert (eq 3 (logior one two)) (list one two)) - (Assert (eq 3 (logxor one two)) (list one two))) + (Assert-eq 0 (logand one two) (list one two)) + (Assert-eq 3 (logior one two) (list one two)) + (Assert-eq 3 (logxor one two) (list one two))) (dolist (three '(3 ?\03)) - (Assert (eq 1 (logand one three)) (list one three)) - (Assert (eq 3 (logior one three)) (list one three)) - (Assert (eq 2 (logxor one three)) (list one three)))) + (Assert-eq 1 (logand one three) (list one three)) + (Assert-eq 3 (logior one three) (list one three)) + (Assert-eq 2 (logxor one three) (list one three)))) ;;----------------------------------------------------- ;; Test `%', mod @@ -501,11 +501,11 @@ (Check-Error wrong-type-argument (% 10.0 2)) (Check-Error wrong-type-argument (% 10 2.0)) -(flet ((test1 (x) (Assert (eql x (+ (% x 17) (* (/ x 17) 17))) x)) - (test2 (x) (Assert (eql (- x) (+ (% (- x) 17) (* (/ (- x) 17) 17))) x)) - (test3 (x) (Assert (eql x (+ (% (- x) 17) (* (/ (- x) 17) 17))) x)) - (test4 (x) (Assert (eql (% x -17) (- (% (- x) 17))) x)) - (test5 (x) (Assert (eql (% x -17) (% (- x) 17))) x)) +(flet ((test1 (x) (Assert-eql x (+ (% x 17) (* (/ x 17) 17)) x)) + (test2 (x) (Assert-eql (- x) (+ (% (- x) 17) (* (/ (- x) 17) 17)) x)) + (test3 (x) (Assert-eql x (+ (% (- x) 17) (* (/ (- x) 17) 17)) x)) + (test4 (x) (Assert-eql (% x -17) (- (% (- x) 17)) x)) + (test5 (x) (Assert-eql (% x -17) (% (- x) 17)) x)) (test1 most-negative-fixnum) (if (featurep 'bignum) (progn @@ -527,54 +527,54 @@ (macrolet ((division-test (seven) `(progn - (Assert (eq (% ,seven 2) 1)) - (Assert (eq (% ,seven -2) 1)) - (Assert (eq (% (- ,seven) 2) -1)) - (Assert (eq (% (- ,seven) -2) -1)) + (Assert-eq (% ,seven 2) 1) + (Assert-eq (% ,seven -2) 1) + (Assert-eq (% (- ,seven) 2) -1) + (Assert-eq (% (- ,seven) -2) -1) - (Assert (eq (% ,seven 4) 3)) - (Assert (eq (% ,seven -4) 3)) - (Assert (eq (% (- ,seven) 4) -3)) - (Assert (eq (% (- ,seven) -4) -3)) + (Assert-eq (% ,seven 4) 3) + (Assert-eq (% ,seven -4) 3) + (Assert-eq (% (- ,seven) 4) -3) + (Assert-eq (% (- ,seven) -4) -3) - (Assert (eq (% 35 ,seven) 0)) - (Assert (eq (% -35 ,seven) 0)) - (Assert (eq (% 35 (- ,seven)) 0)) - (Assert (eq (% -35 (- ,seven)) 0)) + (Assert-eq (% 35 ,seven) 0) + (Assert-eq (% -35 ,seven) 0) + (Assert-eq (% 35 (- ,seven)) 0) + (Assert-eq (% -35 (- ,seven)) 0) - (Assert (eq (mod ,seven 2) 1)) - (Assert (eq (mod ,seven -2) -1)) - (Assert (eq (mod (- ,seven) 2) 1)) - (Assert (eq (mod (- ,seven) -2) -1)) + (Assert-eq (mod ,seven 2) 1) + (Assert-eq (mod ,seven -2) -1) + (Assert-eq (mod (- ,seven) 2) 1) + (Assert-eq (mod (- ,seven) -2) -1) - (Assert (eq (mod ,seven 4) 3)) - (Assert (eq (mod ,seven -4) -1)) - (Assert (eq (mod (- ,seven) 4) 1)) - (Assert (eq (mod (- ,seven) -4) -3)) + (Assert-eq (mod ,seven 4) 3) + (Assert-eq (mod ,seven -4) -1) + (Assert-eq (mod (- ,seven) 4) 1) + (Assert-eq (mod (- ,seven) -4) -3) - (Assert (eq (mod 35 ,seven) 0)) - (Assert (eq (mod -35 ,seven) 0)) - (Assert (eq (mod 35 (- ,seven)) 0)) - (Assert (eq (mod -35 (- ,seven)) 0)) + (Assert-eq (mod 35 ,seven) 0) + (Assert-eq (mod -35 ,seven) 0) + (Assert-eq (mod 35 (- ,seven)) 0) + (Assert-eq (mod -35 (- ,seven)) 0) - (Assert (= (mod ,seven 2.0) 1.0)) - (Assert (= (mod ,seven -2.0) -1.0)) - (Assert (= (mod (- ,seven) 2.0) 1.0)) - (Assert (= (mod (- ,seven) -2.0) -1.0)) + (Assert= (mod ,seven 2.0) 1.0) + (Assert= (mod ,seven -2.0) -1.0) + (Assert= (mod (- ,seven) 2.0) 1.0) + (Assert= (mod (- ,seven) -2.0) -1.0) - (Assert (= (mod ,seven 4.0) 3.0)) - (Assert (= (mod ,seven -4.0) -1.0)) - (Assert (= (mod (- ,seven) 4.0) 1.0)) - (Assert (= (mod (- ,seven) -4.0) -3.0)) + (Assert= (mod ,seven 4.0) 3.0) + (Assert= (mod ,seven -4.0) -1.0) + (Assert= (mod (- ,seven) 4.0) 1.0) + (Assert= (mod (- ,seven) -4.0) -3.0) - (Assert (eq (% 0 ,seven) 0)) - (Assert (eq (% 0 (- ,seven)) 0)) + (Assert-eq (% 0 ,seven) 0) + (Assert-eq (% 0 (- ,seven)) 0) - (Assert (eq (mod 0 ,seven) 0)) - (Assert (eq (mod 0 (- ,seven)) 0)) + (Assert-eq (mod 0 ,seven) 0) + (Assert-eq (mod 0 (- ,seven)) 0) - (Assert (= (mod 0.0 ,seven) 0.0)) - (Assert (= (mod 0.0 (- ,seven)) 0.0))))) + (Assert= (mod 0.0 ,seven) 0.0) + (Assert= (mod 0.0 (- ,seven)) 0.0)))) (division-test 7) (division-test ?\07) @@ -600,12 +600,12 @@ ;; One argument always yields t (loop for x in `(1 1.0 ,(Int-to-Marker 1) ?z) do - (Assert (eq t (= x)) x) - (Assert (eq t (< x)) x) - (Assert (eq t (> x)) x) - (Assert (eq t (>= x)) x) - (Assert (eq t (<= x)) x) - (Assert (eq t (/= x)) x) + (Assert-eq t (= x) x) + (Assert-eq t (< x) x) + (Assert-eq t (> x) x) + (Assert-eq t (>= x) x) + (Assert-eq t (<= x) x) + (Assert-eq t (/= x) x) ) ;; Type checking @@ -633,7 +633,7 @@ (Assert (not (< one one two two)) (list one two)) (Assert (>= two two one one) (list one two)) (Assert (not (> two two one one)) (list one two)) - (Assert (= one one one) one) + (Assert= one one one one) (Assert (not (= one one one two)) (list one two)) (Assert (not (/= one two one)) (list one two)) )) @@ -654,7 +654,7 @@ (Assert (not (< one one two two)) (list one two)) (Assert (>= two two one one) (list one two)) (Assert (not (> two two one one)) (list one two)) - (Assert (= one one one) one) + (Assert= one one one one) (Assert (not (= one one one two)) (list one two)) (Assert (not (/= one two one)) (list one two)) )) @@ -674,8 +674,8 @@ (Assert (<= 1 1)) (Assert (not (eq (point) (point-marker)))) -(Assert (= 1 (Int-to-Marker 1))) -(Assert (= (point) (point-marker))) +(Assert= 1 (Int-to-Marker 1)) +(Assert= (point) (point-marker)) (when (featurep 'bignum) (let ((big1 (1+ most-positive-fixnum)) @@ -700,8 +700,8 @@ (small1 (div (* 10 most-negative-fixnum) 4)) (small2 (div (* 5 most-negative-fixnum) 2)) (small3 (div (* 7 most-negative-fixnum) 2))) - (Assert (= big1 big2)) - (Assert (= small1 small2)) + (Assert= big1 big2) + (Assert= small1 small2) (Assert (< small3 small1 most-negative-fixnum most-positive-fixnum big1 big3)) (Assert (<= small3 small2 small1 most-negative-fixnum most-positive-fixnum @@ -737,56 +737,56 @@ remassoc remassq remrassoc remrassq)) (let ((x '((1 . 2) 3 (4 . 5)))) - (Assert (eq (assoc 1 x) (car x))) - (Assert (eq (assq 1 x) (car x))) - (Assert (eq (rassoc 1 x) nil)) - (Assert (eq (rassq 1 x) nil)) - (Assert (eq (assoc 2 x) nil)) - (Assert (eq (assq 2 x) nil)) - (Assert (eq (rassoc 2 x) (car x))) - (Assert (eq (rassq 2 x) (car x))) - (Assert (eq (assoc 3 x) nil)) - (Assert (eq (assq 3 x) nil)) - (Assert (eq (rassoc 3 x) nil)) - (Assert (eq (rassq 3 x) nil)) - (Assert (eq (assoc 4 x) (caddr x))) - (Assert (eq (assq 4 x) (caddr x))) - (Assert (eq (rassoc 4 x) nil)) - (Assert (eq (rassq 4 x) nil)) - (Assert (eq (assoc 5 x) nil)) - (Assert (eq (assq 5 x) nil)) - (Assert (eq (rassoc 5 x) (caddr x))) - (Assert (eq (rassq 5 x) (caddr x))) - (Assert (eq (assoc 6 x) nil)) - (Assert (eq (assq 6 x) nil)) - (Assert (eq (rassoc 6 x) nil)) - (Assert (eq (rassq 6 x) nil))) + (Assert-eq (assoc 1 x) (car x)) + (Assert-eq (assq 1 x) (car x)) + (Assert-eq (rassoc 1 x) nil) + (Assert-eq (rassq 1 x) nil) + (Assert-eq (assoc 2 x) nil) + (Assert-eq (assq 2 x) nil) + (Assert-eq (rassoc 2 x) (car x)) + (Assert-eq (rassq 2 x) (car x)) + (Assert-eq (assoc 3 x) nil) + (Assert-eq (assq 3 x) nil) + (Assert-eq (rassoc 3 x) nil) + (Assert-eq (rassq 3 x) nil) + (Assert-eq (assoc 4 x) (caddr x)) + (Assert-eq (assq 4 x) (caddr x)) + (Assert-eq (rassoc 4 x) nil) + (Assert-eq (rassq 4 x) nil) + (Assert-eq (assoc 5 x) nil) + (Assert-eq (assq 5 x) nil) + (Assert-eq (rassoc 5 x) (caddr x)) + (Assert-eq (rassq 5 x) (caddr x)) + (Assert-eq (assoc 6 x) nil) + (Assert-eq (assq 6 x) nil) + (Assert-eq (rassoc 6 x) nil) + (Assert-eq (rassq 6 x) nil)) (let ((x '(("1" . "2") "3" ("4" . "5")))) - (Assert (eq (assoc "1" x) (car x))) - (Assert (eq (assq "1" x) nil)) - (Assert (eq (rassoc "1" x) nil)) - (Assert (eq (rassq "1" x) nil)) - (Assert (eq (assoc "2" x) nil)) - (Assert (eq (assq "2" x) nil)) - (Assert (eq (rassoc "2" x) (car x))) - (Assert (eq (rassq "2" x) nil)) - (Assert (eq (assoc "3" x) nil)) - (Assert (eq (assq "3" x) nil)) - (Assert (eq (rassoc "3" x) nil)) - (Assert (eq (rassq "3" x) nil)) - (Assert (eq (assoc "4" x) (caddr x))) - (Assert (eq (assq "4" x) nil)) - (Assert (eq (rassoc "4" x) nil)) - (Assert (eq (rassq "4" x) nil)) - (Assert (eq (assoc "5" x) nil)) - (Assert (eq (assq "5" x) nil)) - (Assert (eq (rassoc "5" x) (caddr x))) - (Assert (eq (rassq "5" x) nil)) - (Assert (eq (assoc "6" x) nil)) - (Assert (eq (assq "6" x) nil)) - (Assert (eq (rassoc "6" x) nil)) - (Assert (eq (rassq "6" x) nil))) + (Assert-eq (assoc "1" x) (car x)) + (Assert-eq (assq "1" x) nil) + (Assert-eq (rassoc "1" x) nil) + (Assert-eq (rassq "1" x) nil) + (Assert-eq (assoc "2" x) nil) + (Assert-eq (assq "2" x) nil) + (Assert-eq (rassoc "2" x) (car x)) + (Assert-eq (rassq "2" x) nil) + (Assert-eq (assoc "3" x) nil) + (Assert-eq (assq "3" x) nil) + (Assert-eq (rassoc "3" x) nil) + (Assert-eq (rassq "3" x) nil) + (Assert-eq (assoc "4" x) (caddr x)) + (Assert-eq (assq "4" x) nil) + (Assert-eq (rassoc "4" x) nil) + (Assert-eq (rassq "4" x) nil) + (Assert-eq (assoc "5" x) nil) + (Assert-eq (assq "5" x) nil) + (Assert-eq (rassoc "5" x) (caddr x)) + (Assert-eq (rassq "5" x) nil) + (Assert-eq (assoc "6" x) nil) + (Assert-eq (assq "6" x) nil) + (Assert-eq (rassoc "6" x) nil) + (Assert-eq (rassq "6" x) nil)) (flet ((a () (list '(1 . 2) 3 '(4 . 5)))) (Assert (let* ((x (a)) (y (remassoc 1 x))) (and (not (eq x y)) (equal y '(3 (4 . 5)))))) @@ -868,8 +868,8 @@ ;;----------------------------------------------------- (defmacro check-function-argcounts (fun min max) `(progn - (Assert (eq (function-min-args ,fun) ,min)) - (Assert (eq (function-max-args ,fun) ,max)))) + (Assert-eq (function-min-args ,fun) ,min) + (Assert-eq (function-max-args ,fun) ,max))) (check-function-argcounts 'prog1 1 nil) ; special form (check-function-argcounts 'command-execute 1 3) ; normal subr @@ -896,7 +896,7 @@ (list (0 . many)) (type-of (1 . 1)) (garbage-collect (0 . 0))) - do (Assert (equal (subr-arity (symbol-function function-name)) arity))) + do (Assert-equal (subr-arity (symbol-function function-name)) arity)) (Check-Error wrong-type-argument (subr-arity (lambda () (message "Hi there!")))) @@ -918,37 +918,37 @@ ;;----------------------------------------------------- ;; Test `type-of' ;;----------------------------------------------------- -(Assert (eq (type-of load-path) 'cons)) -(Assert (eq (type-of obarray) 'vector)) -(Assert (eq (type-of 42) 'integer)) -(Assert (eq (type-of ?z) 'character)) -(Assert (eq (type-of "42") 'string)) -(Assert (eq (type-of 'foo) 'symbol)) -(Assert (eq (type-of (selected-device)) 'device)) +(Assert-eq (type-of load-path) 'cons) +(Assert-eq (type-of obarray) 'vector) +(Assert-eq (type-of 42) 'integer) +(Assert-eq (type-of ?z) 'character) +(Assert-eq (type-of "42") 'string) +(Assert-eq (type-of 'foo) 'symbol) +(Assert-eq (type-of (selected-device)) 'device) ;;----------------------------------------------------- ;; Test mapping functions ;;----------------------------------------------------- (Check-Error wrong-type-argument (mapcar #'identity (current-buffer))) -(Assert (equal (mapcar #'identity load-path) load-path)) -(Assert (equal (mapcar #'identity '(1 2 3)) '(1 2 3))) -(Assert (equal (mapcar #'identity "123") '(?1 ?2 ?3))) -(Assert (equal (mapcar #'identity [1 2 3]) '(1 2 3))) -(Assert (equal (mapcar #'identity #*010) '(0 1 0))) +(Assert-equal (mapcar #'identity load-path) load-path) +(Assert-equal (mapcar #'identity '(1 2 3)) '(1 2 3)) +(Assert-equal (mapcar #'identity "123") '(?1 ?2 ?3)) +(Assert-equal (mapcar #'identity [1 2 3]) '(1 2 3)) +(Assert-equal (mapcar #'identity #*010) '(0 1 0)) (let ((z 0) (list (make-list 1000 1))) (mapc (lambda (x) (incf z x)) list) - (Assert (eq 1000 z))) + (Assert-eq 1000 z)) (Check-Error wrong-type-argument (mapvector #'identity (current-buffer))) -(Assert (equal (mapvector #'identity '(1 2 3)) [1 2 3])) -(Assert (equal (mapvector #'identity "123") [?1 ?2 ?3])) -(Assert (equal (mapvector #'identity [1 2 3]) [1 2 3])) -(Assert (equal (mapvector #'identity #*010) [0 1 0])) +(Assert-equal (mapvector #'identity '(1 2 3)) [1 2 3]) +(Assert-equal (mapvector #'identity "123") [?1 ?2 ?3]) +(Assert-equal (mapvector #'identity [1 2 3]) [1 2 3]) +(Assert-equal (mapvector #'identity #*010) [0 1 0]) (Check-Error wrong-type-argument (mapconcat #'identity (current-buffer) "foo")) -(Assert (equal (mapconcat #'identity '("1" "2" "3") "|") "1|2|3")) -(Assert (equal (mapconcat #'identity ["1" "2" "3"] "|") "1|2|3")) +(Assert-equal (mapconcat #'identity '("1" "2" "3") "|") "1|2|3") +(Assert-equal (mapconcat #'identity ["1" "2" "3"] "|") "1|2|3") ;; The following 2 functions used to crash XEmacs via mapcar1(). ;; We don't test the actual values of the mapcar, since they're undefined. @@ -976,29 +976,29 @@ ;;----------------------------------------------------- ;; Test vector functions ;;----------------------------------------------------- -(Assert (equal [1 2 3] [1 2 3])) -(Assert (equal [] [])) +(Assert-equal [1 2 3] [1 2 3]) +(Assert-equal [] []) (Assert (not (equal [1 2 3] []))) (Assert (not (equal [1 2 3] [1 2 4]))) (Assert (not (equal [0 2 3] [1 2 3]))) (Assert (not (equal [1 2 3] [1 2 3 4]))) (Assert (not (equal [1 2 3 4] [1 2 3]))) -(Assert (equal (vector 1 2 3) [1 2 3])) -(Assert (equal (make-vector 3 1) [1 1 1])) +(Assert-equal (vector 1 2 3) [1 2 3]) +(Assert-equal (make-vector 3 1) [1 1 1]) ;;----------------------------------------------------- ;; Test bit-vector functions ;;----------------------------------------------------- -(Assert (equal #*010 #*010)) -(Assert (equal #* #*)) +(Assert-equal #*010 #*010) +(Assert-equal #* #*) (Assert (not (equal #*010 #*011))) (Assert (not (equal #*010 #*))) (Assert (not (equal #*110 #*010))) (Assert (not (equal #*010 #*0100))) (Assert (not (equal #*0101 #*010))) -(Assert (equal (bit-vector 0 1 0) #*010)) -(Assert (equal (make-bit-vector 3 1) #*111)) -(Assert (equal (make-bit-vector 3 0) #*000)) +(Assert-equal (bit-vector 0 1 0) #*010) +(Assert-equal (make-bit-vector 3 1) #*111) +(Assert-equal (make-bit-vector 3 0) #*000) ;;----------------------------------------------------- ;; Test buffer-local variables used as (ugh!) function parameters @@ -1016,59 +1016,59 @@ ;; Hrvoje didn't like the next 3 tests so I'm disabling them for now. -sb ;; I assume Hrvoje worried about the possibility of infloops. -sjt (when test-harness-risk-infloops - (Assert (equal (split-string "foo" "") '("" "f" "o" "o" ""))) - (Assert (equal (split-string "foo" "^") '("" "foo"))) - (Assert (equal (split-string "foo" "$") '("foo" "")))) -(Assert (equal (split-string "foo,bar" ",") '("foo" "bar"))) -(Assert (equal (split-string ",foo,bar," ",") '("" "foo" "bar" ""))) -(Assert (equal (split-string ",foo,bar," "^,") '("" "foo,bar,"))) -(Assert (equal (split-string ",foo,bar," ",$") '(",foo,bar" ""))) -(Assert (equal (split-string ",foo,,bar," ",") '("" "foo" "" "bar" ""))) -(Assert (equal (split-string "foo,,,bar" ",") '("foo" "" "" "bar"))) -(Assert (equal (split-string "foo,,bar,," ",") '("foo" "" "bar" "" ""))) -(Assert (equal (split-string "foo,,bar" ",+") '("foo" "bar"))) -(Assert (equal (split-string ",foo,,bar," ",+") '("" "foo" "bar" ""))) + (Assert-equal (split-string "foo" "") '("" "f" "o" "o" "")) + (Assert-equal (split-string "foo" "^") '("" "foo")) + (Assert-equal (split-string "foo" "$") '("foo" ""))) +(Assert-equal (split-string "foo,bar" ",") '("foo" "bar")) +(Assert-equal (split-string ",foo,bar," ",") '("" "foo" "bar" "")) +(Assert-equal (split-string ",foo,bar," "^,") '("" "foo,bar,")) +(Assert-equal (split-string ",foo,bar," ",$") '(",foo,bar" "")) +(Assert-equal (split-string ",foo,,bar," ",") '("" "foo" "" "bar" "")) +(Assert-equal (split-string "foo,,,bar" ",") '("foo" "" "" "bar")) +(Assert-equal (split-string "foo,,bar,," ",") '("foo" "" "bar" "" "")) +(Assert-equal (split-string "foo,,bar" ",+") '("foo" "bar")) +(Assert-equal (split-string ",foo,,bar," ",+") '("" "foo" "bar" "")) ;; Omit nulls, explicit SEPARATORS (when test-harness-risk-infloops - (Assert (equal (split-string "foo" "" t) '("f" "o" "o"))) - (Assert (equal (split-string "foo" "^" t) '("foo"))) - (Assert (equal (split-string "foo" "$" t) '("foo")))) -(Assert (equal (split-string "foo,bar" "," t) '("foo" "bar"))) -(Assert (equal (split-string ",foo,bar," "," t) '("foo" "bar"))) -(Assert (equal (split-string ",foo,bar," "^," t) '("foo,bar,"))) -(Assert (equal (split-string ",foo,bar," ",$" t) '(",foo,bar"))) -(Assert (equal (split-string ",foo,,bar," "," t) '("foo" "bar"))) -(Assert (equal (split-string "foo,,,bar" "," t) '("foo" "bar"))) -(Assert (equal (split-string "foo,,bar,," "," t) '("foo" "bar"))) -(Assert (equal (split-string "foo,,bar" ",+" t) '("foo" "bar"))) -(Assert (equal (split-string ",foo,,bar," ",+" t) '("foo" "bar"))) + (Assert-equal (split-string "foo" "" t) '("f" "o" "o")) + (Assert-equal (split-string "foo" "^" t) '("foo")) + (Assert-equal (split-string "foo" "$" t) '("foo"))) +(Assert-equal (split-string "foo,bar" "," t) '("foo" "bar")) +(Assert-equal (split-string ",foo,bar," "," t) '("foo" "bar")) +(Assert-equal (split-string ",foo,bar," "^," t) '("foo,bar,")) +(Assert-equal (split-string ",foo,bar," ",$" t) '(",foo,bar")) +(Assert-equal (split-string ",foo,,bar," "," t) '("foo" "bar")) +(Assert-equal (split-string "foo,,,bar" "," t) '("foo" "bar")) +(Assert-equal (split-string "foo,,bar,," "," t) '("foo" "bar")) +(Assert-equal (split-string "foo,,bar" ",+" t) '("foo" "bar")) +(Assert-equal (split-string ",foo,,bar," ",+" t) '("foo" "bar")) ;; "Double-default" case -(Assert (equal (split-string "foo bar") '("foo" "bar"))) -(Assert (equal (split-string " foo bar ") '("foo" "bar"))) -(Assert (equal (split-string " foo bar ") '("foo" "bar"))) -(Assert (equal (split-string "foo bar") '("foo" "bar"))) -(Assert (equal (split-string "foo bar ") '("foo" "bar"))) -(Assert (equal (split-string "foobar") '("foobar"))) +(Assert-equal (split-string "foo bar") '("foo" "bar")) +(Assert-equal (split-string " foo bar ") '("foo" "bar")) +(Assert-equal (split-string " foo bar ") '("foo" "bar")) +(Assert-equal (split-string "foo bar") '("foo" "bar")) +(Assert-equal (split-string "foo bar ") '("foo" "bar")) +(Assert-equal (split-string "foobar") '("foobar")) ;; Semantics are identical to "double-default" case! Fool ya? -(Assert (equal (split-string "foo bar" nil t) '("foo" "bar"))) -(Assert (equal (split-string " foo bar " nil t) '("foo" "bar"))) -(Assert (equal (split-string " foo bar " nil t) '("foo" "bar"))) -(Assert (equal (split-string "foo bar" nil t) '("foo" "bar"))) -(Assert (equal (split-string "foo bar " nil t) '("foo" "bar"))) -(Assert (equal (split-string "foobar" nil t) '("foobar"))) +(Assert-equal (split-string "foo bar" nil t) '("foo" "bar")) +(Assert-equal (split-string " foo bar " nil t) '("foo" "bar")) +(Assert-equal (split-string " foo bar " nil t) '("foo" "bar")) +(Assert-equal (split-string "foo bar" nil t) '("foo" "bar")) +(Assert-equal (split-string "foo bar " nil t) '("foo" "bar")) +(Assert-equal (split-string "foobar" nil t) '("foobar")) ;; Perverse "anti-double-default" case -(Assert (equal (split-string "foo bar" split-string-default-separators) - '("foo" "bar"))) -(Assert (equal (split-string " foo bar " split-string-default-separators) - '("" "foo" "bar" ""))) -(Assert (equal (split-string " foo bar " split-string-default-separators) - '("" "foo" "bar" ""))) -(Assert (equal (split-string "foo bar" split-string-default-separators) - '("foo" "bar"))) -(Assert (equal (split-string "foo bar " split-string-default-separators) - '("foo" "bar" ""))) -(Assert (equal (split-string "foobar" split-string-default-separators) - '("foobar"))) +(Assert-equal (split-string "foo bar" split-string-default-separators) + '("foo" "bar")) +(Assert-equal (split-string " foo bar " split-string-default-separators) + '("" "foo" "bar" "")) +(Assert-equal (split-string " foo bar " split-string-default-separators) + '("" "foo" "bar" "")) +(Assert-equal (split-string "foo bar" split-string-default-separators) + '("foo" "bar")) +(Assert-equal (split-string "foo bar " split-string-default-separators) + '("foo" "bar" "")) +(Assert-equal (split-string "foobar" split-string-default-separators) + '("foobar")) (Assert (not (string-match "\\(\\.\\=\\)" "."))) (Assert (string= "" (let ((str "test string")) @@ -1086,50 +1086,50 @@ ;;----------------------------------------------------- (with-temp-buffer (erase-buffer) - (Assert (eq (char-before) nil)) - (Assert (eq (char-before (point)) nil)) - (Assert (eq (char-before (point-marker)) nil)) - (Assert (eq (char-before (point) (current-buffer)) nil)) - (Assert (eq (char-before (point-marker) (current-buffer)) nil)) - (Assert (eq (char-after) nil)) - (Assert (eq (char-after (point)) nil)) - (Assert (eq (char-after (point-marker)) nil)) - (Assert (eq (char-after (point) (current-buffer)) nil)) - (Assert (eq (char-after (point-marker) (current-buffer)) nil)) - (Assert (eq (preceding-char) 0)) - (Assert (eq (preceding-char (current-buffer)) 0)) - (Assert (eq (following-char) 0)) - (Assert (eq (following-char (current-buffer)) 0)) + (Assert-eq (char-before) nil) + (Assert-eq (char-before (point)) nil) + (Assert-eq (char-before (point-marker)) nil) + (Assert-eq (char-before (point) (current-buffer)) nil) + (Assert-eq (char-before (point-marker) (current-buffer)) nil) + (Assert-eq (char-after) nil) + (Assert-eq (char-after (point)) nil) + (Assert-eq (char-after (point-marker)) nil) + (Assert-eq (char-after (point) (current-buffer)) nil) + (Assert-eq (char-after (point-marker) (current-buffer)) nil) + (Assert-eq (preceding-char) 0) + (Assert-eq (preceding-char (current-buffer)) 0) + (Assert-eq (following-char) 0) + (Assert-eq (following-char (current-buffer)) 0) (insert "foobar") - (Assert (eq (char-before) ?r)) - (Assert (eq (char-after) nil)) - (Assert (eq (preceding-char) ?r)) - (Assert (eq (following-char) 0)) + (Assert-eq (char-before) ?r) + (Assert-eq (char-after) nil) + (Assert-eq (preceding-char) ?r) + (Assert-eq (following-char) 0) (goto-char (point-min)) - (Assert (eq (char-before) nil)) - (Assert (eq (char-after) ?f)) - (Assert (eq (preceding-char) 0)) - (Assert (eq (following-char) ?f)) + (Assert-eq (char-before) nil) + (Assert-eq (char-after) ?f) + (Assert-eq (preceding-char) 0) + (Assert-eq (following-char) ?f) ) ;;----------------------------------------------------- ;; Test plist manipulation functions. ;;----------------------------------------------------- (let ((sym (make-symbol "test-symbol"))) - (Assert (eq t (get* sym t t))) - (Assert (eq t (get sym t t))) - (Assert (eq t (getf nil t t))) - (Assert (eq t (plist-get nil t t))) + (Assert-eq t (get* sym t t)) + (Assert-eq t (get sym t t)) + (Assert-eq t (getf nil t t)) + (Assert-eq t (plist-get nil t t)) (put sym 'bar 'baz) - (Assert (eq 'baz (get sym 'bar))) - (Assert (eq 'baz (getf '(bar baz) 'bar))) - (Assert (eq 'baz (getf (symbol-plist sym) 'bar))) - (Assert (eq 2 (getf '(1 2) 1))) - (Assert (eq 4 (put sym 3 4))) - (Assert (eq 4 (get sym 3))) - (Assert (eq t (remprop sym 3))) - (Assert (eq nil (remprop sym 3))) - (Assert (eq 5 (get sym 3 5))) + (Assert-eq 'baz (get sym 'bar)) + (Assert-eq 'baz (getf '(bar baz) 'bar)) + (Assert-eq 'baz (getf (symbol-plist sym) 'bar)) + (Assert-eq 2 (getf '(1 2) 1)) + (Assert-eq 4 (put sym 3 4)) + (Assert-eq 4 (get sym 3)) + (Assert-eq t (remprop sym 3)) + (Assert-eq nil (remprop sym 3)) + (Assert-eq 5 (get sym 3 5)) ) (loop for obj in @@ -1138,18 +1138,18 @@ (make-extent nil nil nil) (make-face 'test-face)) do - (Assert (eq 2 (get obj ?1 2)) obj) - (Assert (eq 4 (put obj ?3 4)) obj) - (Assert (eq 4 (get obj ?3)) obj) + (Assert-eq 2 (get obj ?1 2) obj) + (Assert-eq 4 (put obj ?3 4) obj) + (Assert-eq 4 (get obj ?3) obj) (when (or (stringp obj) (symbolp obj)) - (Assert (equal '(?3 4) (object-plist obj)) obj)) - (Assert (eq t (remprop obj ?3)) obj) + (Assert-equal '(?3 4) (object-plist obj) obj)) + (Assert-eq t (remprop obj ?3) obj) (when (or (stringp obj) (symbolp obj)) - (Assert (eq '() (object-plist obj)) obj)) - (Assert (eq nil (remprop obj ?3)) obj) + (Assert-eq '() (object-plist obj) obj)) + (Assert-eq nil (remprop obj ?3) obj) (when (or (stringp obj) (symbolp obj)) - (Assert (eq '() (object-plist obj)) obj)) - (Assert (eq 5 (get obj ?3 5)) obj) + (Assert-eq '() (object-plist obj) obj)) + (Assert-eq 5 (get obj ?3 5) obj) ) (Check-Error-Message @@ -1175,15 +1175,15 @@ ;;----------------------------------------------------- ;; Test subseq ;;----------------------------------------------------- -(Assert (equal (subseq nil 0) nil)) -(Assert (equal (subseq [1 2 3] 0) [1 2 3])) -(Assert (equal (subseq [1 2 3] 1 -1) [2])) -(Assert (equal (subseq "123" 0) "123")) -(Assert (equal (subseq "1234" -3 -1) "23")) -(Assert (equal (subseq #*0011 0) #*0011)) -(Assert (equal (subseq #*0011 -3 3) #*01)) -(Assert (equal (subseq '(1 2 3) 0) '(1 2 3))) -(Assert (equal (subseq '(1 2 3 4) -3 nil) '(2 3 4))) +(Assert-equal (subseq nil 0) nil) +(Assert-equal (subseq [1 2 3] 0) [1 2 3]) +(Assert-equal (subseq [1 2 3] 1 -1) [2]) +(Assert-equal (subseq "123" 0) "123") +(Assert-equal (subseq "1234" -3 -1) "23") +(Assert-equal (subseq #*0011 0) #*0011) +(Assert-equal (subseq #*0011 -3 3) #*01) +(Assert-equal (subseq '(1 2 3) 0) '(1 2 3)) +(Assert-equal (subseq '(1 2 3 4) -3 nil) '(2 3 4)) (Check-Error wrong-type-argument (subseq 3 2)) (Check-Error args-out-of-range (subseq [1 2 3] -42)) @@ -1192,7 +1192,7 @@ ;;----------------------------------------------------- ;; Time-related tests ;;----------------------------------------------------- -(Assert (= (length (current-time-string)) 24)) +(Assert= (length (current-time-string)) 24) ;;----------------------------------------------------- ;; format test @@ -1282,20 +1282,20 @@ ;;; The following two tests used to use 1000 instead of 100, ;;; but that merely found buffer overflow bugs in Solaris sprintf(). -(Assert (= 102 (length (format "%.100f" 3.14)))) -(Assert (= 100 (length (format "%100f" 3.14)))) +(Assert= 102 (length (format "%.100f" 3.14))) +(Assert= 100 (length (format "%100f" 3.14))) ;;; Check for 64-bit cleanness on LP64 platforms. -(Assert (= (read (format "%d" most-positive-fixnum)) most-positive-fixnum)) -(Assert (= (read (format "%ld" most-positive-fixnum)) most-positive-fixnum)) -(Assert (= (read (format "%u" most-positive-fixnum)) most-positive-fixnum)) -(Assert (= (read (format "%lu" most-positive-fixnum)) most-positive-fixnum)) -(Assert (= (read (format "%d" most-negative-fixnum)) most-negative-fixnum)) -(Assert (= (read (format "%ld" most-negative-fixnum)) most-negative-fixnum)) +(Assert= (read (format "%d" most-positive-fixnum)) most-positive-fixnum) +(Assert= (read (format "%ld" most-positive-fixnum)) most-positive-fixnum) +(Assert= (read (format "%u" most-positive-fixnum)) most-positive-fixnum) +(Assert= (read (format "%lu" most-positive-fixnum)) most-positive-fixnum) +(Assert= (read (format "%d" most-negative-fixnum)) most-negative-fixnum) +(Assert= (read (format "%ld" most-negative-fixnum)) most-negative-fixnum) ;; These used to crash. -(Assert (eql (read (format "%f" 1.2e+302)) 1.2e+302)) -(Assert (eql (read (format "%.1000d" 1)) 1)) +(Assert-eql (read (format "%f" 1.2e+302)) 1.2e+302) +(Assert-eql (read (format "%.1000d" 1)) 1) ;;; "%u" is undocumented, and Emacs Lisp has no unsigned type. ;;; What to do if "%u" is used with a negative number? @@ -1353,12 +1353,12 @@ (if (= new-char old-char) (setq new-char ?/)) (aset load-file-name 0 new-char) - (Assert (= new-char (aref load-file-name 0)) + (Assert= new-char (aref load-file-name 0) \"Check that we can modify the string value of load-file-name\")) (let* ((new-load-file-name \"hi there\") (load-file-name new-load-file-name)) - (Assert (eq new-load-file-name load-file-name) + (Assert-eq new-load-file-name load-file-name \"Checking that we can bind load-file-name successfully.\")) ") @@ -1402,137 +1402,137 @@ one-fround-result two-fround-result one-truncate-result two-truncate-result one-ftruncate-result two-ftruncate-result) - (Assert (equal one-floor-result (multiple-value-list - (floor first))) + (Assert-equal one-floor-result (multiple-value-list + (floor first)) (format "checking (floor %S) gives %S" first one-floor-result)) - (Assert (equal one-floor-result (multiple-value-list - (floor first 1))) + (Assert-equal one-floor-result (multiple-value-list + (floor first 1)) (format "checking (floor %S 1) gives %S" first one-floor-result)) (Check-Error arith-error (floor first 0)) (Check-Error arith-error (floor first 0.0)) - (Assert (equal two-floor-result (multiple-value-list - (floor first second))) + (Assert-equal two-floor-result (multiple-value-list + (floor first second)) (format "checking (floor %S %S) gives %S" first second two-floor-result)) - (Assert (equal (cl-floor first second) - (multiple-value-list (floor first second))) + (Assert-equal (cl-floor first second) + (multiple-value-list (floor first second)) (format "checking (floor %S %S) gives the same as the old code" first second)) - (Assert (equal one-ffloor-result (multiple-value-list - (ffloor first))) + (Assert-equal one-ffloor-result (multiple-value-list + (ffloor first)) (format "checking (ffloor %S) gives %S" first one-ffloor-result)) - (Assert (equal one-ffloor-result (multiple-value-list - (ffloor first 1))) + (Assert-equal one-ffloor-result (multiple-value-list + (ffloor first 1)) (format "checking (ffloor %S 1) gives %S" first one-ffloor-result)) (Check-Error arith-error (ffloor first 0)) (Check-Error arith-error (ffloor first 0.0)) - (Assert (equal two-ffloor-result (multiple-value-list - (ffloor first second))) + (Assert-equal two-ffloor-result (multiple-value-list + (ffloor first second)) (format "checking (ffloor %S %S) gives %S" first second two-ffloor-result)) - (Assert (equal one-ceiling-result (multiple-value-list - (ceiling first))) + (Assert-equal one-ceiling-result (multiple-value-list + (ceiling first)) (format "checking (ceiling %S) gives %S" first one-ceiling-result)) - (Assert (equal one-ceiling-result (multiple-value-list - (ceiling first 1))) + (Assert-equal one-ceiling-result (multiple-value-list + (ceiling first 1)) (format "checking (ceiling %S 1) gives %S" first one-ceiling-result)) (Check-Error arith-error (ceiling first 0)) (Check-Error arith-error (ceiling first 0.0)) - (Assert (equal two-ceiling-result (multiple-value-list - (ceiling first second))) + (Assert-equal two-ceiling-result (multiple-value-list + (ceiling first second)) (format "checking (ceiling %S %S) gives %S" first second two-ceiling-result)) - (Assert (equal (cl-ceiling first second) - (multiple-value-list (ceiling first second))) + (Assert-equal (cl-ceiling first second) + (multiple-value-list (ceiling first second)) (format "checking (ceiling %S %S) gives the same as the old code" first second)) - (Assert (equal one-fceiling-result (multiple-value-list - (fceiling first))) + (Assert-equal one-fceiling-result (multiple-value-list + (fceiling first)) (format "checking (fceiling %S) gives %S" first one-fceiling-result)) - (Assert (equal one-fceiling-result (multiple-value-list - (fceiling first 1))) + (Assert-equal one-fceiling-result (multiple-value-list + (fceiling first 1)) (format "checking (fceiling %S 1) gives %S" first one-fceiling-result)) (Check-Error arith-error (fceiling first 0)) (Check-Error arith-error (fceiling first 0.0)) - (Assert (equal two-fceiling-result (multiple-value-list - (fceiling first second))) + (Assert-equal two-fceiling-result (multiple-value-list + (fceiling first second)) (format "checking (fceiling %S %S) gives %S" first second two-fceiling-result)) - (Assert (equal one-round-result (multiple-value-list - (round first))) + (Assert-equal one-round-result (multiple-value-list + (round first)) (format "checking (round %S) gives %S" first one-round-result)) - (Assert (equal one-round-result (multiple-value-list - (round first 1))) + (Assert-equal one-round-result (multiple-value-list + (round first 1)) (format "checking (round %S 1) gives %S" first one-round-result)) (Check-Error arith-error (round first 0)) (Check-Error arith-error (round first 0.0)) - (Assert (equal two-round-result (multiple-value-list - (round first second))) + (Assert-equal two-round-result (multiple-value-list + (round first second)) (format "checking (round %S %S) gives %S" first second two-round-result)) - (Assert (equal one-fround-result (multiple-value-list - (fround first))) + (Assert-equal one-fround-result (multiple-value-list + (fround first)) (format "checking (fround %S) gives %S" first one-fround-result)) - (Assert (equal one-fround-result (multiple-value-list - (fround first 1))) + (Assert-equal one-fround-result (multiple-value-list + (fround first 1)) (format "checking (fround %S 1) gives %S" first one-fround-result)) (Check-Error arith-error (fround first 0)) (Check-Error arith-error (fround first 0.0)) - (Assert (equal two-fround-result (multiple-value-list - (fround first second))) + (Assert-equal two-fround-result (multiple-value-list + (fround first second)) (format "checking (fround %S %S) gives %S" first second two-fround-result)) - (Assert (equal (cl-round first second) - (multiple-value-list (round first second))) + (Assert-equal (cl-round first second) + (multiple-value-list (round first second)) (format "checking (round %S %S) gives the same as the old code" first second)) - (Assert (equal one-truncate-result (multiple-value-list - (truncate first))) + (Assert-equal one-truncate-result (multiple-value-list + (truncate first)) (format "checking (truncate %S) gives %S" first one-truncate-result)) - (Assert (equal one-truncate-result (multiple-value-list - (truncate first 1))) + (Assert-equal one-truncate-result (multiple-value-list + (truncate first 1)) (format "checking (truncate %S 1) gives %S" first one-truncate-result)) (Check-Error arith-error (truncate first 0)) (Check-Error arith-error (truncate first 0.0)) - (Assert (equal two-truncate-result (multiple-value-list - (truncate first second))) + (Assert-equal two-truncate-result (multiple-value-list + (truncate first second)) (format "checking (truncate %S %S) gives %S" first second two-truncate-result)) - (Assert (equal (cl-truncate first second) - (multiple-value-list (truncate first second))) + (Assert-equal (cl-truncate first second) + (multiple-value-list (truncate first second)) (format "checking (truncate %S %S) gives the same as the old code" first second)) - (Assert (equal one-ftruncate-result (multiple-value-list - (ftruncate first))) + (Assert-equal one-ftruncate-result (multiple-value-list + (ftruncate first)) (format "checking (ftruncate %S) gives %S" first one-ftruncate-result)) - (Assert (equal one-ftruncate-result (multiple-value-list - (ftruncate first 1))) + (Assert-equal one-ftruncate-result (multiple-value-list + (ftruncate first 1)) (format "checking (ftruncate %S 1) gives %S" first one-ftruncate-result)) (Check-Error arith-error (ftruncate first 0)) (Check-Error arith-error (ftruncate first 0.0)) - (Assert (equal two-ftruncate-result (multiple-value-list - (ftruncate first second))) + (Assert-equal two-ftruncate-result (multiple-value-list + (ftruncate first second)) (format "checking (ftruncate %S %S) gives %S" first second two-ftruncate-result))) (Assert-rounding-floating (pie ee) @@ -2000,9 +2000,9 @@ "Checking #'multiple-value-prog1 passes back multiple values") (multiple-value-bind (floored remainder this-is-nil) (floor pi 1.0) - (Assert (= floored 3) + (Assert= floored 3 "Checking floored bound correctly") - (Assert (eql remainder (- pi 3.0)) + (Assert-eql remainder (- pi 3.0) "Checking remainder bound correctly") (Assert (null this-is-nil) "Checking trailing arg bound but nil")) @@ -2011,8 +2011,8 @@ (cee #s(hash-table size 256 data (969 ?\xF9)))) (multiple-value-setq (ey bee cee) (ffloor e 1.0)) - (Assert (eql 2.0 ey) "Checking ey set correctly") - (Assert (eql bee (- e 2.0)) "Checking bee set correctly") + (Assert-eql 2.0 ey "Checking ey set correctly") + (Assert-eql bee (- e 2.0) "Checking bee set correctly") (Assert (null cee) "Checking cee set to nil correctly")) (Assert (= 3 (length (multiple-value-list (eval '(values nil t pi))))) @@ -2095,60 +2095,60 @@ for char being each element in-ref res do (setf char (int-to-char int-char)) finally return res))) - (Assert (equalp "hi there" "Hi There") + (Assert-equalp "hi there" "Hi There" "checking equalp isn't case-sensitive") - (Assert (equalp 99 99.0) + (Assert-equalp 99 99.0 "checking equalp compares numerical values of different types") (Assert (null (equalp 99 ?c)) "checking equalp does not convert characters to numbers") ;; Fixed in Hg d0ea57eb3de4. (Assert (null (equalp "hi there" [hi there])) "checking equalp doesn't error with string and non-string") - (Assert (eq t (equalp "ABCDEEFGH\u00CDJ" string-variable)) + (Assert-eq t (equalp "ABCDEEFGH\u00CDJ" string-variable) "checking #'equalp is case-insensitive with an upcased constant") - (Assert (eq t (equalp "abcdeefgh\xedj" string-variable)) + (Assert-eq t (equalp "abcdeefgh\xedj" string-variable) "checking #'equalp is case-insensitive with a downcased constant") - (Assert (eq t (equalp string-variable string-variable)) + (Assert-eq t (equalp string-variable string-variable) "checking #'equalp works when handed the same string twice") - (Assert (eq t (equalp string-variable "aBcDeeFgH\u00Edj")) + (Assert-eq t (equalp string-variable "aBcDeeFgH\u00Edj") "check #'equalp is case-insensitive with a variable-cased constant") - (Assert (eq t (equalp "" (bit-vector))) + (Assert-eq t (equalp "" (bit-vector)) "check empty string and empty bit-vector are #'equalp.") - (Assert (eq t (equalp (string) (bit-vector))) + (Assert-eq t (equalp (string) (bit-vector)) "check empty string and empty bit-vector are #'equalp, no constants") - (Assert (eq t (equalp "hi there" (vector ?h ?i ?\ ?t ?h ?e ?r ?e))) + (Assert-eq t (equalp "hi there" (vector ?h ?i ?\ ?t ?h ?e ?r ?e)) "check string and vector with same contents #'equalp") - (Assert (eq t (equalp (string ?h ?i ?\ ?t ?h ?e ?r ?e) - (vector ?h ?i ?\ ?t ?h ?e ?r ?e))) + (Assert-eq t (equalp (string ?h ?i ?\ ?t ?h ?e ?r ?e) + (vector ?h ?i ?\ ?t ?h ?e ?r ?e)) "check string and vector with same contents #'equalp, no constants") - (Assert (eq t (equalp [?h ?i ?\ ?t ?h ?e ?r ?e] - (string ?h ?i ?\ ?t ?h ?e ?r ?e))) + (Assert-eq t (equalp [?h ?i ?\ ?t ?h ?e ?r ?e] + (string ?h ?i ?\ ?t ?h ?e ?r ?e)) "check string and vector with same contents #'equalp, vector constant") - (Assert (eq t (equalp [0 1.0 0.0 0 1] - (bit-vector 0 1 0 0 1))) + (Assert-eq t (equalp [0 1.0 0.0 0 1] + (bit-vector 0 1 0 0 1)) "check vector and bit-vector with same contents #'equalp,\ vector constant") - (Assert (eq t (equalp #*01001 - (vector 0 1.0 0.0 0 1))) + (Assert-eq t (equalp #*01001 + (vector 0 1.0 0.0 0 1)) "check vector and bit-vector with same contents #'equalp,\ bit-vector constant") - (Assert (eq t (equalp ?\u00E9 Eacute-character)) + (Assert-eq t (equalp ?\u00E9 Eacute-character) "checking characters are case-insensitive, one constant") - (Assert (eq nil (equalp ?\u00E9 (aref (format "%c" ?a) 0))) + (Assert-eq nil (equalp ?\u00E9 (aref (format "%c" ?a) 0)) "checking distinct characters are not equalp, one constant") - (Assert (eq t (equalp t (and))) + (Assert-eq t (equalp t (and)) "checking symbols are correctly #'equalp") - (Assert (eq nil (equalp t (or nil '#:t))) + (Assert-eq nil (equalp t (or nil '#:t)) "checking distinct symbols with the same name are not #'equalp") - (Assert (eq t (equalp #s(char-table type generic data (?\u0080 "hi-there")) + (Assert-eq t (equalp #s(char-table type generic data (?\u0080 "hi-there")) (let ((aragh (make-char-table 'generic))) (put-char-table ?\u0080 "hi-there" aragh) - aragh))) + aragh)) "checking #'equalp succeeds correctly, char-tables") - (Assert (eq nil (equalp #s(char-table type generic data (?\u0080 "hi-there")) + (Assert-eq nil (equalp #s(char-table type generic data (?\u0080 "hi-there")) (let ((aragh (make-char-table 'generic))) (put-char-table ?\u0080 "HI-THERE" aragh) - aragh))) + aragh)) "checking #'equalp fails correctly, char-tables")) ;; There are more tests available for equalp here:
--- a/tests/automated/md5-tests.el Thu Jan 14 01:25:16 2010 -0600 +++ b/tests/automated/md5-tests.el Thu Jan 14 02:18:03 2010 -0600 @@ -56,7 +56,7 @@ ;;----------------------------------------------------- (mapcar (lambda (x) - (Assert (equal (md5 (car x)) (cdr x)))) + (Assert-equal (md5 (car x)) (cdr x))) md5-tests) ;;----------------------------------------------------- @@ -66,8 +66,8 @@ (let ((large-string (mapconcat #'car md5-tests ""))) (let ((count 0)) (mapcar (lambda (x) - (Assert (equal (md5 large-string count (+ count (length (car x)))) - (cdr x))) + (Assert-equal (md5 large-string count (+ count (length (car x)))) + (cdr x)) (incf count (length (car x)))) md5-tests))) @@ -79,7 +79,7 @@ (mapcar (lambda (x) (erase-buffer) (insert (car x)) - (Assert (equal (md5 (current-buffer)) (cdr x)))) + (Assert-equal (md5 (current-buffer)) (cdr x))) md5-tests)) ;;----------------------------------------------------- @@ -90,7 +90,7 @@ (insert (mapconcat #'car md5-tests "")) (let ((point 1)) (mapcar (lambda (x) - (Assert (equal (md5 (current-buffer) point (+ point (length (car x)))) - (cdr x))) + (Assert-equal (md5 (current-buffer) point (+ point (length (car x)))) + (cdr x)) (incf point (length (car x)))) md5-tests)))
--- a/tests/automated/mule-tests.el Thu Jan 14 01:25:16 2010 -0600 +++ b/tests/automated/mule-tests.el Thu Jan 14 02:18:03 2010 -0600 @@ -65,7 +65,7 @@ ;; 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")) @@ -152,12 +152,12 @@ (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) - buffer-file-coding-system)) + (Assert-eq (find-coding-system coding-system) + buffer-file-coding-system) (kill-buffer nil) (find-file nonexistent-file-name coding-system) - (Assert (eq (find-coding-system coding-system) - buffer-file-coding-system)) + (Assert-eq (find-coding-system coding-system) + buffer-file-coding-system) (set-buffer-modified-p nil) (kill-buffer nil))) (delete-file existing-file-name)) @@ -177,9 +177,9 @@ (char2 (make-char charset2 69))) `(let ((string (make-string 1000 ,char1))) (fillarray string ,char2) - (Assert (eq (aref string 0) ,char2)) - (Assert (eq (aref string (1- (length string))) ,char2)) - (Assert (eq (length string) 1000)))))) + (Assert-eq (aref string 0) ,char2) + (Assert-eq (aref string (1- (length string))) ,char2) + (Assert-eq (length string) 1000))))) (fillarray-test ascii latin-iso8859-1) (fillarray-test ascii latin-iso8859-2) (fillarray-test latin-iso8859-1 ascii) @@ -188,7 +188,7 @@ ;; 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 @@ -210,8 +210,8 @@ (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-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))) @@ -219,8 +219,8 @@ (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-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))) @@ -228,9 +228,9 @@ (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-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))) @@ -266,8 +266,8 @@ (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-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)) @@ -275,26 +275,26 @@ (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-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))) + (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-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))) + (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" @@ -351,28 +351,28 @@ (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) @@ -415,8 +415,8 @@ (when working-symlinks (make-symbolic-link name1 name2) (Assert (file-exists-p name2)) - (Assert (equal (file-truename name2) name1)) - (Assert (equal (file-truename name1) name1))) + (Assert-equal (file-truename name2) 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))) @@ -426,18 +426,21 @@ ;;--------------------------------------------------------------- ;; 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) - (Assert (eq code (char-to-unicode scaron))) - (Assert (eq scaron (unicode-to-char code '(latin-iso8859-2))))) - finally (set-unicode-conversion scaron initial-unicode)) - (Check-Error wrong-type-argument (set-unicode-conversion scaron -10000))) + (apply 'set-unicode-conversion code scaron) + (Assert-eq code (apply 'charset-codepoint-to-unicode scaron)) + (Assert-equal scaron (unicode-to-charset-codepoint + code '(latin-iso8859-2))) + (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 @@ -450,37 +453,37 @@ (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) - (encode-coding-string xemacs-character 'escape-quoted))) - (Assert (equal (concat "\033%G" utf-8-char) - (encode-coding-string xemacs-character 'ctext)))))) + (Assert-equal (concat "\033%G" utf-8-char) + (encode-coding-string xemacs-character 'escape-quoted)) + (Assert-equal (concat "\033%G" utf-8-char) + (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)) - (Assert (equal (encode-coding-string + utf-16-big-endian) + (Assert-equal (encode-coding-string (decode-char 'ucs code-point) 'utf-16-le) - utf-16-little-endian))) + utf-16-little-endian)) ;;--------------------------------------------------------------- @@ -497,11 +500,11 @@ (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 @@ -539,11 +542,11 @@ ;; (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)))) ;;--------------------------------------------------------------- @@ -551,7 +554,7 @@ ;;--------------------------------------------------------------- (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)) @@ -560,8 +563,8 @@ 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))) - (Assert (equal + vietnamese-viscii-lower)) + (Assert-equal (sort (charsets-in-string (buffer-substring (point-min) (point-max))) #'string<) @@ -569,7 +572,7 @@ 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. @@ -582,7 +585,7 @@ 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)) @@ -602,7 +605,7 @@ ;; 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))))
--- a/tests/automated/query-coding-tests.el Thu Jan 14 01:25:16 2010 -0600 +++ b/tests/automated/query-coding-tests.el Thu Jan 14 02:18:03 2010 -0600 @@ -70,7 +70,7 @@ :test #'eq)) (multiple-value-bind (query-coding-succeeded query-coding-table) (query-coding-region (point-min) (point-max) coding-system) - (Assert (eq t query-coding-succeeded) + (Assert-eq t query-coding-succeeded (format "checking query-coding-region ASCII-transparency, %s" coding-system)) (Assert (null query-coding-table) @@ -78,7 +78,7 @@ coding-system))) (multiple-value-bind (query-coding-succeeded query-coding-table) (query-coding-string ascii-chars-string coding-system) - (Assert (eq t query-coding-succeeded) + (Assert-eq t query-coding-succeeded (format "checking query-coding-string ASCII-transparency, %s" coding-system)) (Assert (null query-coding-table) @@ -89,20 +89,19 @@ (insert latin-1-chars-string) (multiple-value-bind (query-coding-succeeded query-coding-table) (query-coding-region (point-min) (point-max) 'iso-8859-1-unix) - (Assert (eq t query-coding-succeeded) + (Assert-eq t query-coding-succeeded "checking query-coding-region iso-8859-1-transparency") (Assert (null query-coding-table) "checking query-coding-region iso-8859-1-transparency")) (multiple-value-bind (query-coding-succeeded query-coding-table) (query-coding-string (buffer-string) 'iso-8859-1-unix) - (Assert (eq t query-coding-succeeded) + (Assert-eq t query-coding-succeeded "checking query-coding-string iso-8859-1-transparency") (Assert (null query-coding-table) "checking query-coding-string iso-8859-1-transparency")) (multiple-value-bind (query-coding-succeeded query-coding-table) (query-coding-string (buffer-string) 'iso-latin-1-with-esc-unix) - (Assert - (eq t query-coding-succeeded) + (Assert-eq t query-coding-succeeded "checking query-coding-region iso-latin-1-with-esc-transparency") (Assert (null query-coding-table) @@ -114,10 +113,9 @@ (Assert (null query-coding-succeeded) "checking that query-coding-region fails, U+20AC, iso-8859-1") - (Assert - (equal query-coding-table + (Assert-equal query-coding-table #s(range-table type start-closed-end-open data - ((257 258) unencodable))) + ((257 258) unencodable)) "checking query-coding-region fails correctly, U+20AC, iso-8859-1")) (multiple-value-bind (query-coding-succeeded query-coding-table) (query-coding-region (point-min) (point-max) @@ -161,19 +159,17 @@ (Assert (null query-coding-succeeded) "check query-coding-region fails, windows-1252, invalid-sequences") - (Assert - (equal query-coding-table + (Assert-equal query-coding-table #s(range-table type start-closed-end-open data ((130 131) invalid-sequence (142 143) invalid-sequence (144 146) invalid-sequence - (158 159) invalid-sequence))) + (158 159) invalid-sequence)) "check query-coding-region fails, windows-1252, invalid-sequences")) (multiple-value-bind (query-coding-succeeded query-coding-table) (query-coding-region (point-min) (point-max) 'windows-1252-unix (current-buffer) t) - (Assert - (eq t query-coding-succeeded) + (Assert-eq t query-coding-succeeded "checking that query-coding-region succeeds, U+20AC, windows-1252") (Assert (null query-coding-table) @@ -185,24 +181,22 @@ (Assert (null query-coding-succeeded) "checking that query-coding-region fails, U+0080, windows-1252") - (Assert - (equal query-coding-table + (Assert-equal query-coding-table #s(range-table type start-closed-end-open data - ((257 258) unencodable))) + ((257 258) unencodable)) "checking that query-coding-region fails, U+0080, windows-1252")) (multiple-value-bind (query-coding-succeeded query-coding-table) (query-coding-region (point-min) (point-max) 'windows-1252-unix) (Assert (null query-coding-succeeded) "check query-coding-region fails, U+0080, invalid-sequence, cp1252") - (Assert - (equal query-coding-table + (Assert-equal query-coding-table #s(range-table type start-closed-end-open data ((130 131) invalid-sequence (142 143) invalid-sequence (144 146) invalid-sequence (158 159) invalid-sequence - (257 258) unencodable))) + (257 258) unencodable)) "check query-coding-region fails, U+0080, invalid-sequence, cp1252")) ;; Try a similar approach with koi8-o, the koi8 variant with ;; support for Old Church Slavonic. @@ -219,7 +213,7 @@ "checking that query-coding-region succeeds, koi8-o-unix")) (multiple-value-bind (query-coding-succeeded query-coding-table) (query-coding-region (point-min) (point-max) 'escape-quoted) - (Assert (eq t query-coding-succeeded) + (Assert-eq t query-coding-succeeded "checking that query-coding-region succeeds, escape-quoted") (Assert (null query-coding-table) "checking that query-coding-region succeeds, escape-quoted")) @@ -283,15 +277,15 @@ (query-coding-region (point-min) (point-max) coding-system) (Assert (null query-coding-succeeded) "checking unicode coding systems fail with unmapped chars") - (Assert (equal query-coding-table + (Assert-equal query-coding-table #s(range-table type start-closed-end-open data ((173 174) unencodable (209 210) unencodable - (254 255) unencodable))) + (254 255) unencodable)) "checking unicode coding systems fail with unmapped chars")) (multiple-value-bind (query-coding-succeeded query-coding-table) (query-coding-region (point-min) 173 coding-system) - (Assert (eq t query-coding-succeeded) + (Assert-eq t query-coding-succeeded "checking unicode coding systems succeed sans unmapped chars") (Assert (null query-coding-table) @@ -306,7 +300,7 @@ "checking unicode coding systems succeed sans unmapped chars again")) (multiple-value-bind (query-coding-succeeded query-coding-table) (query-coding-region 210 254 coding-system) - (Assert (eq t query-coding-succeeded)) + (Assert-eq t query-coding-succeeded) (Assert (null query-coding-table))) ;; Check that it errors correctly. (setq text-conversion-error-signalled nil) @@ -342,11 +336,11 @@ (format "checking %s fails with unmapped chars and invalid seqs" coding-system)) - (Assert (equal query-coding-table + (Assert-equal query-coding-table #s(range-table type start-closed-end-open data ((1 5) unencodable (5 9) invalid-sequence - (9 13) unencodable))) + (9 13) unencodable)) (format "checking %s fails with unmapped chars and invalid seqs" coding-system))) @@ -396,23 +390,23 @@ "check #'unencodable-char-position has some borked GNU semantics") (dotimes (i 6) (insert (decode-char 'ucs #x20ac))) ;; Check if it stops at one: - (Assert (equal '(257) (unencodable-char-position (point-min) (point-max) - 'iso-8859-1 1)) + (Assert-equal '(257) (unencodable-char-position (point-min) (point-max) + 'iso-8859-1 1) "check #'unencodable-char-position stops at 1 when asked to") ;; Check if it stops at four: - (Assert (equal '(260 259 258 257) + (Assert-equal '(260 259 258 257) (unencodable-char-position (point-min) (point-max) - 'iso-8859-1 4)) + 'iso-8859-1 4) "check #'unencodable-char-position stops at 4 when asked to") ;; Check whether it stops at seven: - (Assert (equal '(263 262 261 260 259 258 257) + (Assert-equal '(263 262 261 260 259 258 257) (unencodable-char-position (point-min) (point-max) - 'iso-8859-1 7)) + 'iso-8859-1 7) "check #'unencodable-char-position stops at 7 when asked to") ;; Check that it still stops at seven: - (Assert (equal '(263 262 261 260 259 258 257) + (Assert-equal '(263 262 261 260 259 258 257) (unencodable-char-position (point-min) (point-max) - 'iso-8859-1 2000)) + 'iso-8859-1 2000) "check #'unencodable-char-position stops at 7 if 2000 asked for") ;; Now, #'check-coding-systems-region. ;; UTF-8 should certainly be able to encode these characters:
--- a/tests/automated/regexp-tests.el Thu Jan 14 01:25:16 2010 -0600 +++ b/tests/automated/regexp-tests.el Thu Jan 14 02:18:03 2010 -0600 @@ -93,40 +93,40 @@ ;; forward (goto-char (point-min)) ;; Avoid trivial regexp. - (Assert (eq 2 (re-search-forward "ä\\|a" nil t))) + (Assert-eq 2 (re-search-forward "ä\\|a" nil t)) (goto-char (point-min)) - (Assert (eq 2 (re-search-forward "Ä\\|a" nil t))) + (Assert-eq 2 (re-search-forward "Ä\\|a" nil t)) (goto-char (1+ (point-min))) - (Assert (eq 3 (re-search-forward "ä\\|a" nil t))) + (Assert-eq 3 (re-search-forward "ä\\|a" nil t)) (goto-char (1+ (point-min))) - (Assert (eq 3 (re-search-forward "Ä\\|a" nil t))) + (Assert-eq 3 (re-search-forward "Ä\\|a" nil t)) ;; backward (goto-char (point-max)) - (Assert (eq 2 (re-search-backward "ä\\|a" nil t))) + (Assert-eq 2 (re-search-backward "ä\\|a" nil t)) (goto-char (point-max)) - (Assert (eq 2 (re-search-backward "Ä\\|a" nil t))) + (Assert-eq 2 (re-search-backward "Ä\\|a" nil t)) (goto-char (1- (point-max))) - (Assert (eq 1 (re-search-backward "ä\\|a" nil t))) + (Assert-eq 1 (re-search-backward "ä\\|a" nil t)) (goto-char (1- (point-max))) - (Assert (eq 1 (re-search-backward "Ä\\|a" nil t))) + (Assert-eq 1 (re-search-backward "Ä\\|a" nil t)) ;; case sensitive (setq case-fold-search nil) ;; forward (goto-char (point-min)) - (Assert (eq 2 (re-search-forward "ä\\|a" nil t))) + (Assert-eq 2 (re-search-forward "ä\\|a" nil t)) (goto-char (point-min)) - (Assert (eq 3 (re-search-forward "Ä\\|a" nil t))) + (Assert-eq 3 (re-search-forward "Ä\\|a" nil t)) (goto-char (1+ (point-min))) (Assert (not (re-search-forward "ä\\|a" nil t))) (goto-char (1+ (point-min))) - (Assert (eq 3 (re-search-forward "Ä\\|a" nil t))) + (Assert-eq 3 (re-search-forward "Ä\\|a" nil t)) ;; backward (goto-char (point-max)) - (Assert (eq 1 (re-search-backward "ä\\|a" nil t))) + (Assert-eq 1 (re-search-backward "ä\\|a" nil t)) (goto-char (point-max)) - (Assert (eq 2 (re-search-backward "Ä\\|a" nil t))) + (Assert-eq 2 (re-search-backward "Ä\\|a" nil t)) (goto-char (1- (point-max))) - (Assert (eq 1 (re-search-backward "ä\\|a" nil t))) + (Assert-eq 1 (re-search-backward "ä\\|a" nil t)) (goto-char (1- (point-max))) (Assert (not (re-search-backward "Ä\\|a" nil t)))) @@ -214,25 +214,25 @@ (forward-line 1) (Assert (not (looking-at "^[a]\\{3,5\\}$"))) (goto-char (point-min)) - (Assert (= 12 (re-search-forward "a\\{4,4\\}"))) + (Assert= 12 (re-search-forward "a\\{4,4\\}")) (goto-char (point-min)) - (Assert (= 12 (re-search-forward "b?a\\{4,4\\}"))) + (Assert= 12 (re-search-forward "b?a\\{4,4\\}")) (goto-char (point-min)) - (Assert (= 31 (re-search-forward "ba\\{4,4\\}"))) + (Assert= 31 (re-search-forward "ba\\{4,4\\}")) (goto-char (point-min)) - (Assert (= 31 (re-search-forward "[b]a\\{4,4\\}"))) + (Assert= 31 (re-search-forward "[b]a\\{4,4\\}")) (goto-char (point-min)) - (Assert (= 31 (re-search-forward "\\(b\\)a\\{4,4\\}"))) + (Assert= 31 (re-search-forward "\\(b\\)a\\{4,4\\}")) (goto-char (point-min)) - (Assert (= 12 (re-search-forward "^a\\{4,4\\}"))) + (Assert= 12 (re-search-forward "^a\\{4,4\\}")) (goto-char (point-min)) - (Assert (= 12 (re-search-forward "^a\\{4,4\\}$"))) + (Assert= 12 (re-search-forward "^a\\{4,4\\}$")) (goto-char (point-min)) - (Assert (= 12 (re-search-forward "[a]\\{4,4\\}"))) + (Assert= 12 (re-search-forward "[a]\\{4,4\\}")) (goto-char (point-min)) - (Assert (= 12 (re-search-forward "^[a]\\{4,4\\}"))) + (Assert= 12 (re-search-forward "^[a]\\{4,4\\}")) (goto-char (point-min)) - (Assert (= 12 (re-search-forward "^[a]\\{4,4\\}$"))) + (Assert= 12 (re-search-forward "^[a]\\{4,4\\}$")) ) ;; charset, charset_not @@ -312,15 +312,15 @@ (Assert (string= (match-string 1) nil))) ;; Test word boundaries -(Assert (= (string-match "\\<a" " a") 1)) -(Assert (= (string-match "a\\>" "a ") 0)) -(Assert (= (string-match "\\ba" " a") 1)) -(Assert (= (string-match "a\\b" "a ") 0)) +(Assert= (string-match "\\<a" " a") 1) +(Assert= (string-match "a\\>" "a ") 0) +(Assert= (string-match "\\ba" " a") 1) +(Assert= (string-match "a\\b" "a ") 0) ;; should work at target boundaries -(Assert (= (string-match "\\<a" "a") 0)) -(Assert (= (string-match "a\\>" "a") 0)) -(Assert (= (string-match "\\ba" "a") 0)) -(Assert (= (string-match "a\\b" "a") 0)) +(Assert= (string-match "\\<a" "a") 0) +(Assert= (string-match "a\\>" "a") 0) +(Assert= (string-match "\\ba" "a") 0) +(Assert= (string-match "a\\b" "a") 0) ;; Check for weirdness (Assert (not (string-match " \\> " " "))) (Assert (not (string-match " \\< " " "))) @@ -348,17 +348,17 @@ (ch1 (make-char 'japanese-jisx0208 51 65))) (Assert (not (string-match "A" (string ch0)))) (Assert (not (string-match "[A]" (string ch0)))) - (Assert (eq (string-match "[^A]" (string ch0)) 0)) + (Assert-eq (string-match "[^A]" (string ch0)) 0) (Assert (not (string-match "@A" (string ?@ ch0)))) (Assert (not (string-match "@[A]" (string ?@ ch0)))) - (Assert (eq (string-match "@[^A]" (string ?@ ch0)) 0)) + (Assert-eq (string-match "@[^A]" (string ?@ ch0)) 0) (Assert (not (string-match "@?A" (string ?@ ch0)))) (Assert (not (string-match "A" (string ch1)))) (Assert (not (string-match "[A]" (string ch1)))) - (Assert (eq (string-match "[^A]" (string ch1)) 0)) + (Assert-eq (string-match "[^A]" (string ch1)) 0) (Assert (not (string-match "@A" (string ?@ ch1)))) (Assert (not (string-match "@[A]" (string ?@ ch1)))) - (Assert (eq (string-match "@[^A]" (string ?@ ch1)) 0)) + (Assert-eq (string-match "@[^A]" (string ?@ ch1)) 0) (Assert (not (string-match "@?A" (string ?@ ch1)))) ) ) @@ -405,24 +405,24 @@ ;; fix submitted by sjt 2004-09-08 ;; trailing comments are values from buggy 21.4.15 (let ((text "abc")) - (Assert (eq 0 (string-match "\\(?:ab+\\)*c" text))) ; 2 - (Assert (eq 0 (string-match "^\\(?:ab+\\)*c" text))) ; nil - (Assert (eq 0 (string-match "^\\(?:ab+\\)*" text))) ; 0 - (Assert (eq 0 (string-match "^\\(?:ab+\\)c" text))) ; 0 - (Assert (eq 0 (string-match "^\\(?:ab\\)*c" text))) ; 0 - (Assert (eq 0 (string-match "^\\(?:a+\\)*b" text))) ; nil - (Assert (eq 0 (string-match "^\\(?:a\\)*b" text))) ; 0 + (Assert-eq 0 (string-match "\\(?:ab+\\)*c" text)) ; 2 + (Assert-eq 0 (string-match "^\\(?:ab+\\)*c" text)) ; nil + (Assert-eq 0 (string-match "^\\(?:ab+\\)*" text)) ; 0 + (Assert-eq 0 (string-match "^\\(?:ab+\\)c" text)) ; 0 + (Assert-eq 0 (string-match "^\\(?:ab\\)*c" text)) ; 0 + (Assert-eq 0 (string-match "^\\(?:a+\\)*b" text)) ; nil + (Assert-eq 0 (string-match "^\\(?:a\\)*b" text)) ; 0 ) ;; per Steve Youngs 2004-09-30 <microsoft-free.87ekkjhj7t.fsf@youngs.au.com> ;; fix submitted by sjt 2004-10-07 ;; trailing comments are values from buggy 21.4.pre16 (let ((text "abc")) - (Assert (eq 0 (string-match "\\(?:a\\(b\\)\\)" text))) ; 0 + (Assert-eq 0 (string-match "\\(?:a\\(b\\)\\)" text)) ; 0 (Assert (string= (match-string 1 text) "b")) ; ab (Assert (null (match-string 2 text))) ; b (Assert (null (match-string 3 text))) ; nil - (Assert (eq 0 (string-match "\\(?:a\\(?:b\\(c\\)\\)\\)" text))) ; 0 + (Assert-eq 0 (string-match "\\(?:a\\(?:b\\(c\\)\\)\\)" text)) ; 0 (Assert (string= (match-string 1 text) "c")) ; abc (Assert (null (match-string 2 text))) ; ab (Assert (null (match-string 3 text))) ; c @@ -437,7 +437,7 @@ (re2 "\\(?:a\\)\\(b\\)\\1") (re3 "\\(a\\)\\(?:b\\)\\1")) - (Assert (eq 0 (string-match re0 text1))) + (Assert-eq 0 (string-match re0 text1)) (Assert (string= text1 (match-string 0 text1))) (Assert (string= "a" (match-string 1 text1))) (Assert (string= "b" (match-string 2 text1))) @@ -446,14 +446,14 @@ (Check-Error-Message 'invalid-regexp "Invalid back reference" (string-match re1 text1)) - (Assert (eq 0 (string-match re2 text1))) + (Assert-eq 0 (string-match re2 text1)) (Assert (string= text1 (match-string 0 text1))) (Assert (string= "b" (match-string 1 text1))) (Assert (null (match-string 2 text1))) (Assert (null (string-match re2 text2))) (Assert (null (string-match re3 text1))) - (Assert (eq 0 (string-match re3 text2))) + (Assert-eq 0 (string-match re3 text2)) (Assert (string= text2 (match-string 0 text2))) (Assert (string= "a" (match-string 1 text2))) (Assert (null (match-string 2 text2))) @@ -528,14 +528,14 @@ "-]-----------------------------][]]------------------------" (goto-char (point-min)) (skip-chars-forward (skip-chars-quote "-[]")) - (Assert (= (point) (point-max))) + (Assert= (point) (point-max)) (skip-chars-backward (skip-chars-quote "-[]")) - (Assert (= (point) (point-min))) + (Assert= (point) (point-min)) ;; Testing in passing for an old bug in #'skip-chars-forward where I ;; thought it was impossible to call it with a string containing only ?- ;; and ?]: - (Assert (= (skip-chars-forward (skip-chars-quote "-]")) - (position ?[ (buffer-string) :test #'=))) + (Assert= (skip-chars-forward (skip-chars-quote "-]")) + (position ?[ (buffer-string) :test #'=)) ;; This used to error, incorrectly: (Assert (skip-chars-quote "[-"))) @@ -551,15 +551,15 @@ (with-string-as-buffer-contents "aáa" (goto-char (point-min)) (Assert (looking-at "\\=")) - (Assert (= (re-search-forward "\\=") 1)) + (Assert= (re-search-forward "\\=") 1) (forward-char 1) (Assert (looking-at "\\=")) - (Assert (= (re-search-forward "\\=") 2)) + (Assert= (re-search-forward "\\=") 2) (forward-char 1) (Assert (looking-at "\\=")) - (Assert (= (re-search-forward "\\=") 3)) + (Assert= (re-search-forward "\\=") 3) (forward-char 1) (Assert (looking-at "\\=")) - (Assert (= (re-search-forward "\\=") 4))) + (Assert= (re-search-forward "\\=") 4))
--- a/tests/automated/region-tests.el Thu Jan 14 01:25:16 2010 -0600 +++ b/tests/automated/region-tests.el Thu Jan 14 02:18:03 2010 -0600 @@ -71,7 +71,7 @@ ;; Region not active in this second temp buffer (Assert (not (region-active-p))) ;; Region still active in first temp buffer - (Assert (eq (zmacs-region-buffer) first-buffer)) + (Assert-eq (zmacs-region-buffer) first-buffer) ;; Activate region in second temp buffer (Silence-Message (mark-whole-buffer))
--- a/tests/automated/symbol-tests.el Thu Jan 14 01:25:16 2010 -0600 +++ b/tests/automated/symbol-tests.el Thu Jan 14 02:18:03 2010 -0600 @@ -63,8 +63,8 @@ (uninterned (make-symbol name))) (Assert (symbolp interned)) (Assert (symbolp uninterned)) - (Assert (equal (symbol-name interned) name)) - (Assert (equal (symbol-name uninterned) name)) + (Assert-equal (symbol-name interned) name) + (Assert-equal (symbol-name uninterned) name) (Assert (not (eq interned uninterned))) (Assert (not (equal interned uninterned))))) @@ -76,12 +76,12 @@ (Implementation-Incomplete-Expect-Failure (Assert (not (zerop len))) (garbage-collect) - (Assert (eq (length (weak-list-list weak-list)) - (if (not reversep) 0 len)))) + (Assert-eq (length (weak-list-list weak-list)) + (if (not reversep) 0 len))) (Assert (not (zerop len))) (garbage-collect) - (Assert (eq (length (weak-list-list weak-list)) - (if (not reversep) 0 len))))))) + (Assert-eq (length (weak-list-list weak-list)) + (if (not reversep) 0 len)))))) (let ((weak-list (make-weak-list)) (gc-cons-threshold most-positive-fixnum)) ;; Symbols created with `make-symbol' and `gensym' should be fresh @@ -112,7 +112,7 @@ string (read (concat "\"" string "\""))) (Assert (intern-soft string)) (Assert (intern-soft symbol)) - (Assert (eq (intern-soft string) (intern-soft symbol)))) + (Assert-eq (intern-soft string) (intern-soft symbol))) (let ((fresh (read (concat "#:" (ts-fresh-symbol-name "foo"))))) (Assert (not (intern-soft fresh)))) @@ -127,15 +127,15 @@ (bar3 (nth 5 list))) (Assert (symbolp foo)) (Assert (not (intern-soft foo))) - (Assert (equal (symbol-name foo) "foo")) + (Assert-equal (symbol-name foo) "foo") (Assert (symbolp bar)) (Assert (not (intern-soft bar))) - (Assert (equal (symbol-name bar) "bar")) + (Assert-equal (symbol-name bar) "bar") - (Assert (eq foo foo2)) - (Assert (eq foo2 foo3)) - (Assert (eq bar bar2)) - (Assert (eq bar2 bar3))) + (Assert-eq foo foo2) + (Assert-eq foo2 foo3) + (Assert-eq bar bar2) + (Assert-eq bar2 bar3)) ;; Check #N=OBJECT and #N# print syntax. (let* ((foo (make-symbol "foo")) @@ -143,10 +143,10 @@ (list (list foo foo bar bar foo bar))) (let* ((print-gensym nil) (printed-list (prin1-to-string list))) - (Assert (equal printed-list "(foo foo bar bar foo bar)"))) + (Assert-equal printed-list "(foo foo bar bar foo bar)")) (let* ((print-gensym t) (printed-list (prin1-to-string list))) - (Assert (equal printed-list "(#1=#:foo #1# #2=#:bar #2# #1# #2#)")))) + (Assert-equal printed-list "(#1=#:foo #1# #2=#:bar #2# #1# #2#)"))) ;;----------------------------------------------------- ;; Read-only symbols @@ -164,18 +164,18 @@ (let ((foo 0) (bar 1)) (defvaralias 'foo 'bar) - (Assert (eq foo bar)) - (Assert (eq foo 1)) - (Assert (eq (variable-alias 'foo) 'bar)) + (Assert-eq foo bar) + (Assert-eq foo 1) + (Assert-eq (variable-alias 'foo) 'bar) (defvaralias 'bar 'foo) (Check-Error cyclic-variable-indirection (symbol-value 'foo)) (Check-Error cyclic-variable-indirection (symbol-value 'bar)) (defvaralias 'foo nil) - (Assert (eq foo 0)) + (Assert-eq foo 0) (defvaralias 'bar nil) - (Assert (eq bar 1))) + (Assert-eq bar 1)) ;;----------------------------------------------------- ;; Keywords @@ -187,10 +187,10 @@ ;; that is interned in the global obarray. ;; In Elisp, a keyword is interned as any other symbol. -(Assert (eq (read ":foo") (intern ":foo"))) +(Assert-eq (read ":foo") (intern ":foo")) ;; A keyword is self-quoting and evaluates to itself. -(Assert (eq (eval (intern ":foo")) :foo)) +(Assert-eq (eval (intern ":foo")) :foo) ;; Keywords are recognized as such only if interned in the global ;; obarray, and `keywordp' is aware of that. @@ -208,14 +208,14 @@ ;; keyword. (let* ((fresh-keyword-name (ts-fresh-symbol-name ":foo")) (fresh-keyword (intern fresh-keyword-name))) - (Assert (eq (symbol-value fresh-keyword) fresh-keyword)) + (Assert-eq (symbol-value fresh-keyword) fresh-keyword) (Assert (keywordp fresh-keyword))) ;; Likewise, reading a fresh keyword string should produce a regular ;; keyword. (let* ((fresh-keyword-name (ts-fresh-symbol-name ":foo")) (fresh-keyword (read fresh-keyword-name))) - (Assert (eq (symbol-value fresh-keyword) fresh-keyword)) + (Assert-eq (symbol-value fresh-keyword) fresh-keyword) (Assert (keywordp fresh-keyword))) ;;; Assigning to keywords @@ -236,19 +236,19 @@ ;; But symbols not interned in the global obarray are not real ;; keywords (in elisp): -(Assert (eq (set (intern ":foo" [0]) 5) 5)) +(Assert-eq (set (intern ":foo" [0]) 5) 5) ;;; Printing keywords (let ((print-gensym t)) - (Assert (equal (prin1-to-string :foo) ":foo")) - (Assert (equal (prin1-to-string (intern ":foo")) ":foo")) - (Assert (equal (prin1-to-string (intern ":foo" [0])) "#::foo"))) + (Assert-equal (prin1-to-string :foo) ":foo") + (Assert-equal (prin1-to-string (intern ":foo")) ":foo") + (Assert-equal (prin1-to-string (intern ":foo" [0])) "#::foo")) (let ((print-gensym nil)) - (Assert (equal (prin1-to-string :foo) ":foo")) - (Assert (equal (prin1-to-string (intern ":foo")) ":foo")) - (Assert (equal (prin1-to-string (intern ":foo" [0])) ":foo"))) + (Assert-equal (prin1-to-string :foo) ":foo") + (Assert-equal (prin1-to-string (intern ":foo")) ":foo") + (Assert-equal (prin1-to-string (intern ":foo" [0])) ":foo")) ;; #### Add many more tests for printing and reading symbols, as well ;; as print-gensym and print-gensym-alist! @@ -270,17 +270,17 @@ (lambda (&rest args) (throw 'test-tag args))) (Assert (not (boundp mysym))) - (Assert (equal (catch 'test-tag + (Assert-equal (catch 'test-tag (set mysym 'foo)) - `(,mysym (foo) set nil nil))) + `(,mysym (foo) set nil nil)) (Assert (not (boundp mysym))) (dontusethis-set-symbol-value-handler mysym 'set-value (lambda (&rest args) (setq save (nth 1 args)))) (set mysym 'foo) - (Assert (equal save '(foo))) - (Assert (eq (symbol-value mysym) 'foo)) + (Assert-equal save '(foo)) + (Assert-eq (symbol-value mysym) 'foo) ) (let ((mysym (make-symbol "test-symbol")) @@ -290,9 +290,9 @@ 'make-unbound (lambda (&rest args) (throw 'test-tag args))) - (Assert (equal (catch 'test-tag + (Assert-equal (catch 'test-tag (makunbound mysym)) - `(,mysym nil makunbound nil nil))) + `(,mysym nil makunbound nil nil)) (dontusethis-set-symbol-value-handler mysym 'make-unbound @@ -300,27 +300,27 @@ (Assert (not (boundp mysym))) (set mysym 'bar) (Assert (null save)) - (Assert (eq (symbol-value mysym) 'bar)) + (Assert-eq (symbol-value mysym) 'bar) (makunbound mysym) (Assert (not (boundp mysym))) - (Assert (eq save 'makunbound)) + (Assert-eq save 'makunbound) ) ;; pathname-coding-system is no more. ; (when (featurep 'file-coding) -; (Assert (eq pathname-coding-system file-name-coding-system)) +; (Assert-eq pathname-coding-system file-name-coding-system) ; (let ((val1 file-name-coding-system) ; (val2 pathname-coding-system)) -; (Assert (eq val1 val2)) +; (Assert-eq val1 val2) ; (let ((file-name-coding-system 'no-conversion-dos)) -; (Assert (eq file-name-coding-system 'no-conversion-dos)) -; (Assert (eq pathname-coding-system file-name-coding-system))) +; (Assert-eq file-name-coding-system 'no-conversion-dos) +; (Assert-eq pathname-coding-system file-name-coding-system)) ; (let ((pathname-coding-system 'no-conversion-mac)) -; (Assert (eq file-name-coding-system 'no-conversion-mac)) -; (Assert (eq pathname-coding-system file-name-coding-system))) -; (Assert (eq file-name-coding-system pathname-coding-system)) -; (Assert (eq val1 file-name-coding-system))) -; (Assert (eq pathname-coding-system file-name-coding-system))) +; (Assert-eq file-name-coding-system 'no-conversion-mac) +; (Assert-eq pathname-coding-system file-name-coding-system)) +; (Assert-eq file-name-coding-system pathname-coding-system) +; (Assert-eq val1 file-name-coding-system)) +; (Assert-eq pathname-coding-system file-name-coding-system)) ;(let ((mysym (make-symbol "test-symbol")))
--- a/tests/automated/syntax-tests.el Thu Jan 14 01:25:16 2010 -0600 +++ b/tests/automated/syntax-tests.el Thu Jan 14 02:18:03 2010 -0600 @@ -49,7 +49,7 @@ (insert string) (goto-char point) (forward-word 1) - (Assert (eq (point) (+ point stop))))) + (Assert-eq (point) (+ point stop)))) (with-temp-buffer ;; -!- W NW @@ -77,7 +77,7 @@ (insert string) (let ((point (point))) (backward-word 1) - (Assert (eq (point) (- point stop))))) + (Assert-eq (point) (- point stop)))) (with-temp-buffer ;; NW W -!- @@ -120,7 +120,7 @@ 'syntax-table apply-syntax) (goto-char point) (forward-word 1) - (Assert (eq (point) (+ point stop)))))) + (Assert-eq (point) (+ point stop))))) ;; test syntax-table extents (with-temp-buffer @@ -143,7 +143,7 @@ (with-syntax-table (make-syntax-table) (insert "foo bar") (backward-sexp 1) - (Assert (eql (point) 5)))) + (Assert-eql (point) 5))) ;; Test forward-comment at buffer boundaries ;; #### The second Assert fails (once interpreted, once compiled) on 21.4.9 @@ -156,13 +156,13 @@ (insert "// comment\n") (forward-comment -2) - (Assert (eq (point) (point-min))) + (Assert-eq (point) (point-min)) (let ((point (point))) (insert "/* comment */") (goto-char point) (forward-comment 2) - (Assert (eq (point) (point-max))) + (Assert-eq (point) (point-max)) ;; this last used to crash (parse-partial-sexp point (point-max))))) @@ -203,7 +203,7 @@ "Unbalanced parentheses" (backward-up-list-moves-point-from-to 25 nil)) ;; special-case check that point didn't move - (Assert (= (point) 25)))) + (Assert= (point) 25))) (loop with envvar-not-existing = (symbol-name (gensym "whatever"))
--- a/tests/automated/tag-tests.el Thu Jan 14 01:25:16 2010 -0600 +++ b/tests/automated/tag-tests.el Thu Jan 14 02:18:03 2010 -0600 @@ -70,7 +70,7 @@ ;; Search for the tag "mystruct"; this should succeed (Silence-Message (find-tag "mystruct")) - (Assert (eq (point) 2)) + (Assert-eq (point) 2) ;; Search again. The search should fail, based on the patch that ;; Sven Grundmann submitted for 21.4.16. @@ -86,7 +86,7 @@ (Silence-Message (find-tag "require")) (t t)) - (Assert (eq (point) 52))) + (Assert-eq (point) 52)) (kill-buffer testfile) (delete-file testfile)
--- a/tests/automated/test-harness.el Thu Jan 14 01:25:16 2010 -0600 +++ b/tests/automated/test-harness.el Thu Jan 14 02:18:03 2010 -0600 @@ -291,6 +291,88 @@ (incf other-failures) ))) + (defmacro Assert-test (test testval expected &optional failing-case + description) + "Test passes if TESTVAL is equal to EXPECTED, using TEST as comparator. +TEST should be a function such as `eq', `equal', `equalp', `=', `<=', etc. +Optional FAILING-CASE describes the particular failure; any value given +here will be concatenated with a phrase describing the expected and actual +values of the comparison. Optional DESCRIPTION describes the assertion; by +default, the unevalated comparison expressions are given. FAILING-CASE and +DESCRIPTION are useful when Assert is used in a loop." + (let* ((assertion `(,test ,testval ,expected)) + (failmsg `(format "expected %S, got %S" ,expected ,testval)) + (failmsg2 (if failing-case `(concat + (format "%S, " ,failing-case) + ,failmsg) + failmsg))) + `(Assert ,assertion ,failmsg2 ,description))) + + (defmacro Assert-eq (testval expected &optional failing-case description) + "Test passes if TESTVAL is 'eq' to EXPECTED. +Optional FAILING-CASE describes the particular failure; any value given +here will be concatenated with a phrase describing the expected and actual +values of the comparison. Optional DESCRIPTION describes the assertion; by +default, the unevalated comparison expressions are given. FAILING-CASE and +DESCRIPTION are useful when Assert is used in a loop." + `(Assert-test eq ,testval ,expected ,failing-case ,description)) + + (defmacro Assert-eql (testval expected &optional failing-case description) + "Test passes if TESTVAL is 'eql' to EXPECTED. +Optional FAILING-CASE describes the particular failure; any value given +here will be concatenated with a phrase describing the expected and actual +values of the comparison. Optional DESCRIPTION describes the assertion; by +default, the unevalated comparison expressions are given. FAILING-CASE and +DESCRIPTION are useful when Assert is used in a loop." + `(Assert-test eql ,testval ,expected ,failing-case ,description)) + + (defmacro Assert-equal (testval expected &optional failing-case + description) + "Test passes if TESTVAL is 'equal' to EXPECTED. +Optional FAILING-CASE describes the particular failure; any value given +here will be concatenated with a phrase describing the expected and actual +values of the comparison. Optional DESCRIPTION describes the assertion; by +default, the unevalated comparison expressions are given. FAILING-CASE and +DESCRIPTION are useful when Assert is used in a loop." + `(Assert-test equal ,testval ,expected ,failing-case ,description)) + + (defmacro Assert-equalp (testval expected &optional failing-case + description) + "Test passes if TESTVAL is 'equalp' to EXPECTED. +Optional FAILING-CASE describes the particular failure; any value given +here will be concatenated with a phrase describing the expected and actual +values of the comparison. Optional DESCRIPTION describes the assertion; by +default, the unevalated comparison expressions are given. FAILING-CASE and +DESCRIPTION are useful when Assert is used in a loop." + `(Assert-test equalp ,testval ,expected ,failing-case ,description)) + + (defmacro Assert-string= (testval expected &optional failing-case + description) + "Test passes if TESTVAL is 'string=' to EXPECTED. +Optional FAILING-CASE describes the particular failure; any value given +here will be concatenated with a phrase describing the expected and actual +values of the comparison. Optional DESCRIPTION describes the assertion; by +default, the unevalated comparison expressions are given. FAILING-CASE and +DESCRIPTION are useful when Assert is used in a loop." + `(Assert-test string= ,testval ,expected ,failing-case ,description)) + + (defmacro Assert= (testval expected &optional failing-case description) + "Test passes if TESTVAL is '=' to EXPECTED. +Optional FAILING-CASE describes the particular failure; any value given +here will be concatenated with a phrase describing the expected and actual +values of the comparison. Optional DESCRIPTION describes the assertion; by +default, the unevalated comparison expressions are given. FAILING-CASE and +DESCRIPTION are useful when Assert is used in a loop." + `(Assert-test = ,testval ,expected ,failing-case ,description)) + + (defmacro Assert<= (testval expected &optional failing-case description) + "Test passes if TESTVAL is '<=' to EXPECTED. +Optional FAILING-CASE describes the particular failure; any value given +here will be concatenated with a phrase describing the expected and actual +values of the comparison. Optional DESCRIPTION describes the assertion; by +default, the unevalated comparison expressions are given. FAILING-CASE and +DESCRIPTION are useful when Assert is used in a loop." + `(Assert-test <= ,testval ,expected ,failing-case ,description)) (defmacro Check-Error (expected-error &rest body) (let ((quoted-body (if (= 1 (length body))
--- a/tests/automated/weak-tests.el Thu Jan 14 01:25:16 2010 -0600 +++ b/tests/automated/weak-tests.el Thu Jan 14 02:18:03 2010 -0600 @@ -40,7 +40,7 @@ ;; tests for weak-boxes (let ((w (make-weak-box (cons 2 3)))) - (Assert (equal (cons 2 3) (weak-box-ref w))) + (Assert-equal (cons 2 3) (weak-box-ref w)) (garbage-collect) (Assert (not (weak-box-ref w)))) @@ -53,7 +53,7 @@ #'(lambda (value) (setq finalized-p t)))) (eph2 (make-ephemeron p p))) - (Assert (eq p (ephemeron-ref (make-ephemeron (cons 1 2) p)))) + (Assert-eq p (ephemeron-ref (make-ephemeron (cons 1 2) p))) (Assert (ephemeron-p (make-ephemeron (cons 1 2) p))) (garbage-collect) @@ -64,7 +64,7 @@ (garbage-collect) - (Assert (eq p (ephemeron-ref eph2)))) + (Assert-eq p (ephemeron-ref eph2))) (garbage-collect) @@ -81,20 +81,20 @@ (set-weak-list-list weaklist3 (list a (cons 1 2) b)) (set-weak-list-list weaklist4 (list a b (cons 1 2))) (Assert (weak-list-p weaklist1)) - (Assert (eq (weak-list-type weaklist1) 'simple)) + (Assert-eq (weak-list-type weaklist1) 'simple) (Assert (weak-list-p weaklist2)) - (Assert (eq (weak-list-type weaklist2) 'simple)) + (Assert-eq (weak-list-type weaklist2) 'simple) (Assert (weak-list-p weaklist3)) - (Assert (eq (weak-list-type weaklist3) 'simple)) + (Assert-eq (weak-list-type weaklist3) 'simple) (Assert (weak-list-p weaklist4)) - (Assert (eq (weak-list-type weaklist4) 'simple)) + (Assert-eq (weak-list-type weaklist4) 'simple) (garbage-collect) - (Assert (eq (weak-list-list weaklist1) testlist)) - (Assert (equal (weak-list-list weaklist2) testlist)) - (Assert (equal (weak-list-list weaklist3) testlist)) - (Assert (equal (weak-list-list weaklist4) testlist))) + (Assert-eq (weak-list-list weaklist1) testlist) + (Assert-equal (weak-list-list weaklist2) testlist) + (Assert-equal (weak-list-list weaklist3) testlist) + (Assert-equal (weak-list-list weaklist4) testlist)) (garbage-collect) @@ -111,20 +111,20 @@ (set-weak-list-list weaklist3 (list b (cons a (cons 1 2)) b)) (set-weak-list-list weaklist4 (list b (cons (cons 1 2) (cons 3 4)) b)) (Assert (weak-list-p weaklist1)) - (Assert (eq (weak-list-type weaklist1) 'assoc)) + (Assert-eq (weak-list-type weaklist1) 'assoc) (Assert (weak-list-p weaklist2)) - (Assert (eq (weak-list-type weaklist2) 'assoc)) + (Assert-eq (weak-list-type weaklist2) 'assoc) (Assert (weak-list-p weaklist3)) - (Assert (eq (weak-list-type weaklist3) 'assoc)) + (Assert-eq (weak-list-type weaklist3) 'assoc) (Assert (weak-list-p weaklist4)) - (Assert (eq (weak-list-type weaklist4) 'assoc)) + (Assert-eq (weak-list-type weaklist4) 'assoc) (garbage-collect) - (Assert (eq (weak-list-list weaklist1) testlist)) - (Assert (equal (weak-list-list weaklist2) testlist)) - (Assert (equal (weak-list-list weaklist3) testlist)) - (Assert (equal (weak-list-list weaklist4) testlist))) + (Assert-eq (weak-list-list weaklist1) testlist) + (Assert-equal (weak-list-list weaklist2) testlist) + (Assert-equal (weak-list-list weaklist3) testlist) + (Assert-equal (weak-list-list weaklist4) testlist)) (garbage-collect) @@ -141,20 +141,20 @@ (set-weak-list-list weaklist3 (list b (cons a (cons 1 2)) b)) (set-weak-list-list weaklist4 (list b (cons (cons 1 2) (cons 3 4)) b)) (Assert (weak-list-p weaklist1)) - (Assert (eq (weak-list-type weaklist1) 'key-assoc)) + (Assert-eq (weak-list-type weaklist1) 'key-assoc) (Assert (weak-list-p weaklist2)) - (Assert (eq (weak-list-type weaklist2) 'key-assoc)) + (Assert-eq (weak-list-type weaklist2) 'key-assoc) (Assert (weak-list-p weaklist3)) - (Assert (eq (weak-list-type weaklist3) 'key-assoc)) + (Assert-eq (weak-list-type weaklist3) 'key-assoc) (Assert (weak-list-p weaklist4)) - (Assert (eq (weak-list-type weaklist4) 'key-assoc)) + (Assert-eq (weak-list-type weaklist4) 'key-assoc) (garbage-collect) - (Assert (eq (weak-list-list weaklist1) testlist)) - (Assert (equal (weak-list-list weaklist2) testlist)) - (Assert (equal (weak-list-list weaklist3) (list b (cons a (cons 1 2)) b))) - (Assert (equal (weak-list-list weaklist4) testlist))) + (Assert-eq (weak-list-list weaklist1) testlist) + (Assert-equal (weak-list-list weaklist2) testlist) + (Assert-equal (weak-list-list weaklist3) (list b (cons a (cons 1 2)) b)) + (Assert-equal (weak-list-list weaklist4) testlist)) (garbage-collect) @@ -171,20 +171,20 @@ (set-weak-list-list weaklist3 (list b (cons a (cons 1 2)) b)) (set-weak-list-list weaklist4 (list b (cons (cons 1 2) (cons 3 4)) b)) (Assert (weak-list-p weaklist1)) - (Assert (eq (weak-list-type weaklist1) 'value-assoc)) + (Assert-eq (weak-list-type weaklist1) 'value-assoc) (Assert (weak-list-p weaklist2)) - (Assert (eq (weak-list-type weaklist2) 'value-assoc)) + (Assert-eq (weak-list-type weaklist2) 'value-assoc) (Assert (weak-list-p weaklist3)) - (Assert (eq (weak-list-type weaklist3) 'value-assoc)) + (Assert-eq (weak-list-type weaklist3) 'value-assoc) (Assert (weak-list-p weaklist4)) - (Assert (eq (weak-list-type weaklist4) 'value-assoc)) + (Assert-eq (weak-list-type weaklist4) 'value-assoc) (garbage-collect) - (Assert (eq (weak-list-list weaklist1) testlist)) - (Assert (equal (weak-list-list weaklist2) (list b (cons (cons 1 2) a) b))) - (Assert (equal (weak-list-list weaklist3) testlist)) - (Assert (equal (weak-list-list weaklist4) testlist))) + (Assert-eq (weak-list-list weaklist1) testlist) + (Assert-equal (weak-list-list weaklist2) (list b (cons (cons 1 2) a) b)) + (Assert-equal (weak-list-list weaklist3) testlist) + (Assert-equal (weak-list-list weaklist4) testlist)) (garbage-collect) @@ -201,20 +201,20 @@ (set-weak-list-list weaklist3 (list b (cons a (cons 1 2)) b)) (set-weak-list-list weaklist4 (list b (cons (cons 1 2) (cons 3 4)) b)) (Assert (weak-list-p weaklist1)) - (Assert (eq (weak-list-type weaklist1) 'full-assoc)) + (Assert-eq (weak-list-type weaklist1) 'full-assoc) (Assert (weak-list-p weaklist2)) - (Assert (eq (weak-list-type weaklist2) 'full-assoc)) + (Assert-eq (weak-list-type weaklist2) 'full-assoc) (Assert (weak-list-p weaklist3)) - (Assert (eq (weak-list-type weaklist3) 'full-assoc)) + (Assert-eq (weak-list-type weaklist3) 'full-assoc) (Assert (weak-list-p weaklist4)) - (Assert (eq (weak-list-type weaklist4) 'full-assoc)) + (Assert-eq (weak-list-type weaklist4) 'full-assoc) (garbage-collect) - (Assert (eq (weak-list-list weaklist1) testlist)) - (Assert (equal (weak-list-list weaklist2) (list b (cons (cons 1 2) a) b))) - (Assert (equal (weak-list-list weaklist3) (list b (cons a (cons 1 2)) b))) - (Assert (equal (weak-list-list weaklist4) testlist))) + (Assert-eq (weak-list-list weaklist1) testlist) + (Assert-equal (weak-list-list weaklist2) (list b (cons (cons 1 2) a) b)) + (Assert-equal (weak-list-list weaklist3) (list b (cons a (cons 1 2)) b)) + (Assert-equal (weak-list-list weaklist4) testlist)) (garbage-collect)