Mercurial > hg > xemacs-beta
changeset 5136:0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
-------------------- ChangeLog entries follow: --------------------
lisp/ChangeLog addition:
2010-03-12 Ben Wing <ben@xemacs.org>
* test-harness.el (test-harness-from-buffer):
Undo change of e.g. (Assert (equalp ...)) to (Assert-equalp ...).
Get rid of `Assert-equalp' and friends, `Assert-test', and
`Assert-test-not'. Instead, make `Assert' smart enough to do the
equivalent functionality when an expression like (Assert (equalp ...))
is seen.
tests/ChangeLog addition:
2010-03-12 Ben Wing <ben@xemacs.org>
* automated/base64-tests.el (bt-base64-encode-string):
* automated/base64-tests.el (bt-base64-decode-string):
* automated/base64-tests.el (for):
* automated/byte-compiler-tests.el:
* automated/byte-compiler-tests.el (before-and-after-compile-equal):
* automated/case-tests.el (downcase-string):
* automated/case-tests.el (uni-mappings):
* automated/ccl-tests.el (ccl-test-normal-expr):
* automated/ccl-tests.el (ccl-test-map-instructions):
* automated/ccl-tests.el (ccl-test-suites):
* automated/database-tests.el (delete-database-files):
* automated/extent-tests.el (let):
* automated/extent-tests.el (insert):
* automated/extent-tests.el (props):
* automated/file-tests.el:
* automated/file-tests.el (for):
* automated/hash-table-tests.el (test):
* automated/hash-table-tests.el (for):
* automated/hash-table-tests.el (ht):
* automated/hash-table-tests.el (iterations):
* automated/hash-table-tests.el (h1):
* automated/hash-table-tests.el (equal):
* automated/hash-table-tests.el (=):
* automated/lisp-tests.el:
* automated/lisp-tests.el (eq):
* automated/lisp-tests.el (test-setq):
* automated/lisp-tests.el (my-vector):
* automated/lisp-tests.el (x):
* automated/lisp-tests.el (equal):
* automated/lisp-tests.el (y):
* automated/lisp-tests.el (featurep):
* automated/lisp-tests.el (=):
* automated/lisp-tests.el (six):
* automated/lisp-tests.el (three):
* automated/lisp-tests.el (one):
* automated/lisp-tests.el (two):
* automated/lisp-tests.el (five):
* automated/lisp-tests.el (test1):
* automated/lisp-tests.el (division-test):
* automated/lisp-tests.el (for):
* automated/lisp-tests.el (check-function-argcounts):
* automated/lisp-tests.el (z):
* automated/lisp-tests.el (eql):
* automated/lisp-tests.el (test-harness-risk-infloops):
* automated/lisp-tests.el (erase-buffer):
* automated/lisp-tests.el (sym):
* automated/lisp-tests.el (new-char):
* automated/lisp-tests.el (new-load-file-name):
* automated/lisp-tests.el (cl-floor):
* automated/lisp-tests.el (foo):
* automated/md5-tests.el (lambda):
* automated/md5-tests.el (large-string):
* automated/md5-tests.el (mapcar):
* automated/md5-tests.el (insert):
* automated/mule-tests.el:
* automated/mule-tests.el (test-chars):
* automated/mule-tests.el (existing-file-name):
* automated/mule-tests.el (featurep):
* automated/query-coding-tests.el (featurep):
* automated/regexp-tests.el:
* automated/regexp-tests.el (insert):
* automated/regexp-tests.el (Assert):
* automated/regexp-tests.el (=):
* automated/regexp-tests.el (featurep):
* automated/regexp-tests.el (text):
* automated/regexp-tests.el (text1):
* automated/regexp-tests.el ("aáa"):
* automated/regexp-tests.el (eql):
* automated/search-tests.el (insert):
* automated/search-tests.el (featurep):
* automated/search-tests.el (let):
* automated/search-tests.el (boundp):
* automated/symbol-tests.el:
* automated/symbol-tests.el (name):
* automated/symbol-tests.el (check-weak-list-unique):
* automated/symbol-tests.el (string):
* automated/symbol-tests.el (list):
* automated/symbol-tests.el (foo):
* automated/symbol-tests.el (eq):
* automated/symbol-tests.el (fresh-keyword-name):
* automated/symbol-tests.el (print-gensym):
* automated/symbol-tests.el (mysym):
* automated/syntax-tests.el (test-forward-word):
* automated/syntax-tests.el (test-backward-word):
* automated/syntax-tests.el (test-syntax-table):
* automated/syntax-tests.el (with-syntax-table):
* automated/syntax-tests.el (Skip-Test-Unless):
* automated/syntax-tests.el (with):
* automated/tag-tests.el (testfile):
* automated/weak-tests.el (w):
* automated/weak-tests.el (p):
* automated/weak-tests.el (a):
Undo change of e.g. (Assert (equalp ...)) to (Assert-equalp ...).
Get rid of `Assert-equalp' and friends, `Assert-test', and
`Assert-test-not'. Instead, make `Assert' smart enough to do the
equivalent functionality when an expression like (Assert (equalp ...))
is seen.
author | Ben Wing <ben@xemacs.org> |
---|---|
date | Fri, 12 Mar 2010 18:27:51 -0600 |
parents | b2dcf6a6d8ab |
children | 0ac12485616c |
files | lisp/ChangeLog lisp/test-harness.el tests/ChangeLog 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/file-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/search-tests.el tests/automated/symbol-tests.el tests/automated/syntax-tests.el tests/automated/tag-tests.el tests/automated/weak-tests.el |
diffstat | 22 files changed, 1302 insertions(+), 1250 deletions(-) [+] |
line wrap: on
line diff
--- a/lisp/ChangeLog Sun Mar 07 06:43:19 2010 -0600 +++ b/lisp/ChangeLog Fri Mar 12 18:27:51 2010 -0600 @@ -1,3 +1,12 @@ +2010-03-12 Ben Wing <ben@xemacs.org> + + * test-harness.el (test-harness-from-buffer): + Undo change of e.g. (Assert (equalp ...)) to (Assert-equalp ...). + Get rid of `Assert-equalp' and friends, `Assert-test', and + `Assert-test-not'. Instead, make `Assert' smart enough to do the + equivalent functionality when an expression like (Assert (equalp ...)) + is seen. + 2010-03-07 Ben Wing <ben@xemacs.org> * disp-table.el:
--- a/lisp/test-harness.el Sun Mar 07 06:43:19 2010 -0600 +++ b/lisp/test-harness.el Fri Mar 12 18:27:51 2010 -0600 @@ -398,6 +398,29 @@ DESCRIPTION describes the assertion; by default, the unevalated assertion expression is given. FAILING-CASE and DESCRIPTION are useful when Assert is used in a loop." + (let ((test-assertion assertion) + (negated nil)) + (when (and (listp test-assertion) + (= 2 (length test-assertion)) + (memq (car test-assertion) '(not null))) + (setq test-assertion (cadr test-assertion)) + (setq negated t)) + (when (and (listp test-assertion) + (= 3 (length test-assertion)) + (member (car test-assertion) + '(eq eql equal equalp = string= < <= > >=))) + (let* ((test (car test-assertion)) + (testval (second test-assertion)) + (expected (third test-assertion)) + (failmsg `(format ,(if negated + "%S shouldn't be `%s' to %S but is" + "%S should be `%s' to %S but isn't") + ,testval ',test ,expected))) + (setq failing-case (if failing-case + `(concat + (format "%S, " ,failing-case) + ,failmsg) + failmsg))))) (let ((description (or description `(quote ,assertion)))) `(condition-case nil @@ -425,95 +448,6 @@ (incf passes))) (cl-assertion-failed nil)))) -;;;;; BEGIN DEFINITION OF SPECIFIC KINDS OF ASSERT MACROS - - (defmacro Assert-test (test testval expected &optional failing-case - description) - "Test passes if TESTVAL compares correctly to EXPECTED using TEST. -TEST should be a two-argument predicate (i.e. a function of two arguments -that returns t or nil), such as `eq', `eql', `equal', `equalp', `=', `<=', -'>', 'file-newer-than-file-p' 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 "%S should be `%s' to %S but isn't" - ,testval ',test ,expected)) - (failmsg2 (if failing-case `(concat - (format "%S, " ,failing-case) - ,failmsg) - failmsg))) - `(Assert ,assertion ,failmsg2 ,description))) - - (defmacro Assert-test-not (test testval expected &optional failing-case - description) - "Test passes if TESTVAL does not compare correctly to EXPECTED using TEST. -TEST should be a two-argument predicate (i.e. a function of two arguments -that returns t or nil), such as `eq', `eql', `equal', `equalp', `=', `<=', -'>', 'file-newer-than-file-p' 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 `(not (,test ,testval ,expected))) - (failmsg `(format "%S shouldn't be `%s' to %S but is" - ,testval ',test ,expected)) - (failmsg2 (if failing-case `(concat - (format "%S, " ,failing-case) - ,failmsg) - failmsg))) - `(Assert ,assertion ,failmsg2 ,description))) - - ;; Specific versions of `Assert-test'. These are just convenience - ;; functions, functioning identically to `Assert-test', and duplicating - ;; the doc string for each would be too annoying. - (defmacro Assert-eq (testval expected &optional failing-case - description) - `(Assert-test eq ,testval ,expected ,failing-case ,description)) - (defmacro Assert-eql (testval expected &optional failing-case - description) - `(Assert-test eql ,testval ,expected ,failing-case ,description)) - (defmacro Assert-equal (testval expected &optional failing-case - description) - `(Assert-test equal ,testval ,expected ,failing-case ,description)) - (defmacro Assert-equalp (testval expected &optional failing-case - description) - `(Assert-test equalp ,testval ,expected ,failing-case ,description)) - (defmacro Assert-string= (testval expected &optional failing-case - description) - `(Assert-test string= ,testval ,expected ,failing-case ,description)) - (defmacro Assert= (testval expected &optional failing-case - description) - `(Assert-test = ,testval ,expected ,failing-case ,description)) - (defmacro Assert<= (testval expected &optional failing-case - description) - `(Assert-test <= ,testval ,expected ,failing-case ,description)) - - ;; Specific versions of `Assert-test-not'. These are just convenience - ;; functions, functioning identically to `Assert-test-not', and - ;; duplicating the doc string for each would be too annoying. - (defmacro Assert-not-eq (testval expected &optional failing-case - description) - `(Assert-test-not eq ,testval ,expected ,failing-case ,description)) - (defmacro Assert-not-eql (testval expected &optional failing-case - description) - `(Assert-test-not eql ,testval ,expected ,failing-case ,description)) - (defmacro Assert-not-equal (testval expected &optional failing-case - description) - `(Assert-test-not equal ,testval ,expected ,failing-case ,description)) - (defmacro Assert-not-equalp (testval expected &optional failing-case - description) - `(Assert-test-not equalp ,testval ,expected ,failing-case ,description)) - (defmacro Assert-not-string= (testval expected &optional failing-case - description) - `(Assert-test-not string= ,testval ,expected ,failing-case ,description)) - (defmacro Assert-not= (testval expected &optional failing-case - description) - `(Assert-test-not = ,testval ,expected ,failing-case ,description)) - (defmacro Check-Error (expected-error &rest body) (let ((quoted-body (if (= 1 (length body)) `(quote ,(car body)) `(quote (progn ,@body)))))
--- a/tests/ChangeLog Sun Mar 07 06:43:19 2010 -0600 +++ b/tests/ChangeLog Fri Mar 12 18:27:51 2010 -0600 @@ -1,3 +1,103 @@ +2010-03-12 Ben Wing <ben@xemacs.org> + + * automated/base64-tests.el (bt-base64-encode-string): + * automated/base64-tests.el (bt-base64-decode-string): + * automated/base64-tests.el (for): + * automated/byte-compiler-tests.el: + * automated/byte-compiler-tests.el (before-and-after-compile-equal): + * automated/case-tests.el (downcase-string): + * automated/case-tests.el (uni-mappings): + * automated/ccl-tests.el (ccl-test-normal-expr): + * automated/ccl-tests.el (ccl-test-map-instructions): + * automated/ccl-tests.el (ccl-test-suites): + * automated/database-tests.el (delete-database-files): + * automated/extent-tests.el (let): + * automated/extent-tests.el (insert): + * automated/extent-tests.el (props): + * automated/file-tests.el: + * automated/file-tests.el (for): + * automated/hash-table-tests.el (test): + * automated/hash-table-tests.el (for): + * automated/hash-table-tests.el (ht): + * automated/hash-table-tests.el (iterations): + * automated/hash-table-tests.el (h1): + * automated/hash-table-tests.el (equal): + * automated/hash-table-tests.el (=): + * automated/lisp-tests.el: + * automated/lisp-tests.el (eq): + * automated/lisp-tests.el (test-setq): + * automated/lisp-tests.el (my-vector): + * automated/lisp-tests.el (x): + * automated/lisp-tests.el (equal): + * automated/lisp-tests.el (y): + * automated/lisp-tests.el (featurep): + * automated/lisp-tests.el (=): + * automated/lisp-tests.el (six): + * automated/lisp-tests.el (three): + * automated/lisp-tests.el (one): + * automated/lisp-tests.el (two): + * automated/lisp-tests.el (five): + * automated/lisp-tests.el (test1): + * automated/lisp-tests.el (division-test): + * automated/lisp-tests.el (for): + * automated/lisp-tests.el (check-function-argcounts): + * automated/lisp-tests.el (z): + * automated/lisp-tests.el (eql): + * automated/lisp-tests.el (test-harness-risk-infloops): + * automated/lisp-tests.el (erase-buffer): + * automated/lisp-tests.el (sym): + * automated/lisp-tests.el (new-char): + * automated/lisp-tests.el (new-load-file-name): + * automated/lisp-tests.el (cl-floor): + * automated/lisp-tests.el (foo): + * automated/md5-tests.el (lambda): + * automated/md5-tests.el (large-string): + * automated/md5-tests.el (mapcar): + * automated/md5-tests.el (insert): + * automated/mule-tests.el: + * automated/mule-tests.el (test-chars): + * automated/mule-tests.el (existing-file-name): + * automated/mule-tests.el (featurep): + * automated/query-coding-tests.el (featurep): + * automated/regexp-tests.el: + * automated/regexp-tests.el (insert): + * automated/regexp-tests.el (Assert): + * automated/regexp-tests.el (=): + * automated/regexp-tests.el (featurep): + * automated/regexp-tests.el (text): + * automated/regexp-tests.el (text1): + * automated/regexp-tests.el ("aáa"): + * automated/regexp-tests.el (eql): + * automated/search-tests.el (insert): + * automated/search-tests.el (featurep): + * automated/search-tests.el (let): + * automated/search-tests.el (boundp): + * automated/symbol-tests.el: + * automated/symbol-tests.el (name): + * automated/symbol-tests.el (check-weak-list-unique): + * automated/symbol-tests.el (string): + * automated/symbol-tests.el (list): + * automated/symbol-tests.el (foo): + * automated/symbol-tests.el (eq): + * automated/symbol-tests.el (fresh-keyword-name): + * automated/symbol-tests.el (print-gensym): + * automated/symbol-tests.el (mysym): + * automated/syntax-tests.el (test-forward-word): + * automated/syntax-tests.el (test-backward-word): + * automated/syntax-tests.el (test-syntax-table): + * automated/syntax-tests.el (with-syntax-table): + * automated/syntax-tests.el (Skip-Test-Unless): + * automated/syntax-tests.el (with): + * automated/tag-tests.el (testfile): + * automated/weak-tests.el (w): + * automated/weak-tests.el (p): + * automated/weak-tests.el (a): + Undo change of e.g. (Assert (equalp ...)) to (Assert-equalp ...). + Get rid of `Assert-equalp' and friends, `Assert-test', and + `Assert-test-not'. Instead, make `Assert' smart enough to do the + equivalent functionality when an expression like (Assert (equalp ...)) + is seen. + 2010-03-07 Stephen J. Turnbull <stephen@xemacs.org> * automated/mule-tests.el (string character conversion):
--- a/tests/automated/base64-tests.el Sun Mar 07 06:43:19 2010 -0600 +++ b/tests/automated/base64-tests.el Fri Mar 12 18:27:51 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 Sun Mar 07 06:43:19 2010 -0600 +++ b/tests/automated/byte-compiler-tests.el Fri Mar 12 18:27:51 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 Sun Mar 07 06:43:19 2010 -0600 +++ b/tests/automated/case-tests.el Fri Mar 12 18:27:51 2010 -0600 @@ -109,10 +109,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))) @@ -1507,19 +1507,19 @@ ;; using downcase and upcase, however, won't necessarily work in ;; the presence of such mappings -- that's what the internal canon ;; and eqv tables are for. - (Assert-equalp lowermulti uppermulti) - (Assert-equalp loweruppermulti upperlowermulti) - (Assert-equal lower (downcase upper)) - (Assert-equal upper (upcase lower)) - (Assert-equal (downcase lower) (downcase (downcase lower))) - (Assert-equal (upcase lowerupper) (upcase upperlower)) - (Assert-equal (downcase lowerupper) (downcase upperlower)) + (Assert (equalp lowermulti uppermulti)) + (Assert (equalp loweruppermulti upperlowermulti)) + (Assert (equal lower (downcase upper))) + (Assert (equal upper (upcase lower))) + (Assert (equal (downcase lower) (downcase (downcase lower)))) + (Assert (equal (upcase lowerupper) (upcase upperlower))) + (Assert (equal (downcase lowerupper) (downcase upperlower))) ;; Individually -- we include multi-mappings since we're using ;; `equalp'. (loop for (uc lc) in uni-mappings do - (Assert-equalp uc lc) - (Assert-equalp (string uc) (string lc))) + (Assert (equalp uc lc)) + (Assert (equalp (string uc) (string lc)))) ) ;; Here we include multi-mappings -- searching should be able to @@ -1532,14 +1532,14 @@ (,upperlowermulti ,loweruppermulti)) do (erase-buffer) - (Assert= (point-min) 1) - (Assert= (point) 1) + (Assert (= (point-min) 1)) + (Assert (= (point) 1)) (insert str1) (let ((point (point)) (case-fold-search t)) - (Assert= (length str1) (1- point)) + (Assert (= (length str1) (1- point))) (goto-char (point-min)) - (Assert-eql (search-forward str2 nil t) point))) + (Assert (eql (search-forward str2 nil t) point)))) (loop for (uc lc) in uni-mappings do (loop for (ch1 ch2) in `((,uc ,lc) (,lc ,uc)) @@ -1549,8 +1549,8 @@ (insert ch1) (insert ?1) (goto-char (point-min)) - (Assert-eql (search-forward (char-to-string ch2) nil t) 3 - (format "Case-folded searching doesn't equate %s and %s" - (char-as-unicode-escape ch1) - (char-as-unicode-escape ch2)))))) + (Assert (eql (search-forward (char-to-string ch2) nil t) 3) + (format "Case-folded searching doesn't equate %s and %s" + (char-as-unicode-escape ch1) + (char-as-unicode-escape ch2)))))) )))
--- a/tests/automated/ccl-tests.el Sun Mar 07 06:43:19 2010 -0600 +++ b/tests/automated/ccl-tests.el Fri Mar 12 18:27:51 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 Sun Mar 07 06:43:19 2010 -0600 +++ b/tests/automated/database-tests.el Fri Mar 12 18:27:51 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 Sun Mar 07 06:43:19 2010 -0600 +++ b/tests/automated/extent-tests.el Fri Mar 12 18:27:51 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/file-tests.el Sun Mar 07 06:43:19 2010 -0600 +++ b/tests/automated/file-tests.el Fri Mar 12 18:27:51 2010 -0600 @@ -40,6 +40,6 @@ (make-temp-name "foo") ) do - (Assert-equal (file-truename (file-truename file)) (file-truename file))) + (Assert (equal (file-truename (file-truename file)) (file-truename file))))
--- a/tests/automated/hash-table-tests.el Sun Mar 07 06:43:19 2010 -0600 +++ b/tests/automated/hash-table-tests.el Fri Mar 12 18:27:51 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 Sun Mar 07 06:43:19 2010 -0600 +++ b/tests/automated/lisp-tests.el Fri Mar 12 18:27:51 2010 -0600 @@ -1,4 +1,5 @@ ;; Copyright (C) 1998 Free Software Foundation, Inc. -*- coding: iso-8859-1 -*- +;; Copyright (C) 2010 Ben Wing. ;; Author: Martin Buchholz <martin@xemacs.org> ;; Maintainer: Martin Buchholz <martin@xemacs.org> @@ -42,19 +43,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 +70,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 +125,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 +151,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 +179,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 +213,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 +223,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 +248,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 +296,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 +313,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 +502,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 +528,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 +601,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 +634,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 +655,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 +675,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 +701,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 +738,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 +869,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 +897,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 +919,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. @@ -973,38 +974,38 @@ (car y)) x))) -(Assert-eql +(Assert (eql (length (multiple-value-list (car (mapcar #'(lambda (argument) (floor argument)) (list pi e))))) - 1 + 1) "checking multiple values are correctly discarded in mapcar") ;;----------------------------------------------------- ;; 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 @@ -1022,59 +1023,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"))) ;;----------------------------------------------------- ;; Test split-string-by-char @@ -1151,50 +1152,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 @@ -1203,18 +1204,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 @@ -1240,15 +1241,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)) @@ -1257,7 +1258,7 @@ ;;----------------------------------------------------- ;; Time-related tests ;;----------------------------------------------------- -(Assert= (length (current-time-string)) 24) +(Assert (= (length (current-time-string)) 24)) ;;----------------------------------------------------- ;; format test @@ -1347,20 +1348,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? @@ -1418,12 +1419,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.\")) ") @@ -1467,137 +1468,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) @@ -2033,34 +2034,34 @@ (foo-zero 400 (1+ most-positive-fixnum))))) "Checking multiple values are discarded correctly when forced") (Check-Error setting-constant (setq multiple-values-limit 20)) - (Assert-equal '(-1 1) - (multiple-value-list (floor -3 4)) - "Checking #'multiple-value-list gives a sane result") + (Assert (equal '(-1 1) + (multiple-value-list (floor -3 4))) + "Checking #'multiple-value-list gives a sane result") (let ((ey 40000) (bee "this is a string") (cee #s(hash-table size 256 data (969 ?\xF9)))) - (Assert-equal - (multiple-value-list (values ey bee cee)) - (multiple-value-list (values-list (list ey bee cee))) - "Checking that #'values and #'values-list are correctly related") - (Assert-equal - (multiple-value-list (values-list (list ey bee cee))) - (multiple-value-list (apply #'values (list ey bee cee))) - "Checking #'values-list and #'apply with #values are correctly related")) - (Assert= (multiple-value-call #'+ (floor 5 3) (floor 19 4)) 10 - "Checking #'multiple-value-call gives reasonable results.") - (Assert= (multiple-value-call (values '+ '*) (floor 5 3) (floor 19 4)) 10 - "Checking #'multiple-value-call correct when first arg multiple.") - (Assert= 1 (length (multiple-value-list (prog1 (floor pi) "hi there"))) - "Checking #'prog1 does not pass back multiple values") - (Assert= 2 (length (multiple-value-list - (multiple-value-prog1 (floor pi) "hi there"))) - "Checking #'multiple-value-prog1 passes back multiple values") + (Assert (equal + (multiple-value-list (values ey bee cee)) + (multiple-value-list (values-list (list ey bee cee)))) + "Checking that #'values and #'values-list are correctly related") + (Assert (equal + (multiple-value-list (values-list (list ey bee cee))) + (multiple-value-list (apply #'values (list ey bee cee)))) + "Checking #'values-list and #'apply with #values are correctly related")) + (Assert (= (multiple-value-call #'+ (floor 5 3) (floor 19 4)) 10) + "Checking #'multiple-value-call gives reasonable results.") + (Assert (= (multiple-value-call (values '+ '*) (floor 5 3) (floor 19 4)) 10) + "Checking #'multiple-value-call correct when first arg multiple.") + (Assert (= 1 (length (multiple-value-list (prog1 (floor pi) "hi there")))) + "Checking #'prog1 does not pass back multiple values") + (Assert (= 2 (length (multiple-value-list + (multiple-value-prog1 (floor pi) "hi there")))) + "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")) @@ -2069,62 +2070,62 @@ (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)))) - "Checking #'eval passes back multiple values") - (Assert= 2 (length (multiple-value-list (apply #'floor '(5 3)))) - "Checking #'apply passes back multiple values") - (Assert= 2 (length (multiple-value-list (funcall #'floor 5 3))) - "Checking #'funcall passes back multiple values") - (Assert-equal '(1 2) (multiple-value-list - (multiple-value-call #'floor (values 5 3))) - "Checking #'multiple-value-call passes back multiple values correctly") - (Assert= 1 (length (multiple-value-list - (and (multiple-value-function-returning-nil) t))) - "Checking multiple values from non-trailing forms discarded by #'and") - (Assert= 5 (length (multiple-value-list - (and t (multiple-value-function-returning-nil)))) - "Checking multiple values from final forms not discarded by #'and") - (Assert= 1 (length (multiple-value-list - (or (multiple-value-function-returning-t) t))) - "Checking multiple values from non-trailing forms discarded by #'and") - (Assert= 5 (length (multiple-value-list - (or nil (multiple-value-function-returning-t)))) - "Checking multiple values from final forms not discarded by #'and") - (Assert= 1 (length (multiple-value-list - (cond ((multiple-value-function-returning-t))))) - "Checking cond doesn't pass back multiple values in tests.") - (Assert-equal (list nil pi e radians-to-degrees degrees-to-radians) + (Assert (= 3 (length (multiple-value-list (eval '(values nil t pi))))) + "Checking #'eval passes back multiple values") + (Assert (= 2 (length (multiple-value-list (apply #'floor '(5 3))))) + "Checking #'apply passes back multiple values") + (Assert (= 2 (length (multiple-value-list (funcall #'floor 5 3)))) + "Checking #'funcall passes back multiple values") + (Assert (equal '(1 2) (multiple-value-list + (multiple-value-call #'floor (values 5 3)))) + "Checking #'multiple-value-call passes back multiple values correctly") + (Assert (= 1 (length (multiple-value-list + (and (multiple-value-function-returning-nil) t)))) + "Checking multiple values from non-trailing forms discarded by #'and") + (Assert (= 5 (length (multiple-value-list + (and t (multiple-value-function-returning-nil))))) + "Checking multiple values from final forms not discarded by #'and") + (Assert (= 1 (length (multiple-value-list + (or (multiple-value-function-returning-t) t)))) + "Checking multiple values from non-trailing forms discarded by #'and") + (Assert (= 5 (length (multiple-value-list + (or nil (multiple-value-function-returning-t))))) + "Checking multiple values from final forms not discarded by #'and") + (Assert (= 1 (length (multiple-value-list + (cond ((multiple-value-function-returning-t)))))) + "Checking cond doesn't pass back multiple values in tests.") + (Assert (equal (list nil pi e radians-to-degrees degrees-to-radians) + (multiple-value-list + (cond (t (multiple-value-function-returning-nil))))) + "Checking cond passes back multiple values in clauses.") + (Assert (= 1 (length (multiple-value-list + (prog1 (multiple-value-function-returning-nil))))) + "Checking prog1 discards multiple values correctly.") + (Assert (= 5 (length (multiple-value-list + (multiple-value-prog1 + (multiple-value-function-returning-nil))))) + "Checking multiple-value-prog1 passes back multiple values correctly.") + (Assert (equal (list t pi e degrees-to-radians radians-to-degrees) (multiple-value-list - (cond (t (multiple-value-function-returning-nil)))) - "Checking cond passes back multiple values in clauses.") - (Assert= 1 (length (multiple-value-list - (prog1 (multiple-value-function-returning-nil)))) - "Checking prog1 discards multiple values correctly.") - (Assert= 5 (length (multiple-value-list - (multiple-value-prog1 - (multiple-value-function-returning-nil)))) - "Checking multiple-value-prog1 passes back multiple values correctly.") - (Assert-equal (list t pi e degrees-to-radians radians-to-degrees) - (multiple-value-list - (catch 'VoN61Lo4Y (function-throwing-multiple-values)))) - (Assert-equal (list t pi e degrees-to-radians radians-to-degrees) + (catch 'VoN61Lo4Y (function-throwing-multiple-values))))) + (Assert (equal (list t pi e degrees-to-radians radians-to-degrees) (multiple-value-list (loop for eye in `(a b c d ,e f g ,nil ,pi) do (when (null eye) - (return (multiple-value-function-returning-t))))) + (return (multiple-value-function-returning-t)))))) "Checking #'loop passes back multiple values correctly.") (Assert (null (or)) "Checking #'or behaves correctly with zero arguments.") - (Assert-eq t (and) + (Assert (eq t (and)) "Checking #'and behaves correctly with zero arguments.") - (Assert= (* 3.0 (- pi 3.0)) + (Assert (= (* 3.0 (- pi 3.0)) (letf (((values three one-four-one-five-nine) (floor pi))) - (* three one-four-one-five-nine)) + (* three one-four-one-five-nine))) "checking letf handles #'values in a basic sense")) ;; #'equalp tests. @@ -2152,8 +2153,8 @@ (loop for li in equal-lists do (loop for (x . tail) on li do (loop for y in tail do - (Assert-equalp x y) - (Assert-equalp y x))))) + (Assert (equalp x y)) + (Assert (equalp y x)))))) (let ((diff-list `(0 1 2 3 1000 5000000000 5555555555555555555555555555555555555 @@ -2164,73 +2165,73 @@ 1e+300 1e+301 -1e+300 -1e+301))) (loop for (x . tail) on diff-list do (loop for y in tail do - (Assert-not-equalp x y) - (Assert-not-equalp y x)))) + (Assert (not (equalp x y))) + (Assert (not (equalp y x)))))) - (Assert-equalp "hi there" "Hi There" - "checking equalp isn't case-sensitive") - (Assert-equalp 99 99.0 - "checking equalp compares numerical values of different types") + (Assert (equalp "hi there" "Hi There") + "checking equalp isn't case-sensitive") + (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-equalp "ABCDEEFGH\u00CDJ" string-variable - "checking #'equalp is case-insensitive with an upcased constant") - (Assert-equalp "abcdeefgh\xedj" string-variable - "checking #'equalp is case-insensitive with a downcased constant") - (Assert-equalp string-variable string-variable - "checking #'equalp works when handed the same string twice") - (Assert-equalp string-variable "aBcDeeFgH\u00Edj" - "check #'equalp is case-insensitive with a variable-cased constant") - (Assert-equalp "" (bit-vector) - "check empty string and empty bit-vector are #'equalp.") - (Assert-equalp (string) (bit-vector) - "check empty string and empty bit-vector are #'equalp, no constants") - (Assert-equalp "hi there" (vector ?h ?i ?\ ?t ?h ?e ?r ?e) - "check string and vector with same contents #'equalp") - (Assert-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-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-equalp [0 1.0 0.0 0 1] - (bit-vector 0 1 0 0 1) - "check vector and bit-vector with same contents #'equalp,\ + (Assert (equalp "ABCDEEFGH\u00CDJ" string-variable) + "checking #'equalp is case-insensitive with an upcased constant") + (Assert (equalp "abcdeefgh\xedj" string-variable) + "checking #'equalp is case-insensitive with a downcased constant") + (Assert (equalp string-variable string-variable) + "checking #'equalp works when handed the same string twice") + (Assert (equalp string-variable "aBcDeeFgH\u00Edj") + "check #'equalp is case-insensitive with a variable-cased constant") + (Assert (equalp "" (bit-vector)) + "check empty string and empty bit-vector are #'equalp.") + (Assert (equalp (string) (bit-vector)) + "check empty string and empty bit-vector are #'equalp, no constants") + (Assert (equalp "hi there" (vector ?h ?i ?\ ?t ?h ?e ?r ?e)) + "check string and vector with same contents #'equalp") + (Assert (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 (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 (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-not-equalp [0 2 0.0 0 1] - (bit-vector 0 1 0 0 1) - "check vector and bit-vector with different contents not #'equalp,\ + (Assert (not (equalp [0 2 0.0 0 1] + (bit-vector 0 1 0 0 1))) + "check vector and bit-vector with different contents not #'equalp,\ vector constant") - (Assert-equalp #*01001 - (vector 0 1.0 0.0 0 1) - "check vector and bit-vector with same contents #'equalp,\ + (Assert (equalp #*01001 + (vector 0 1.0 0.0 0 1)) + "check vector and bit-vector with same contents #'equalp,\ bit-vector constant") - (Assert-equalp ?\u00E9 Eacute-character - "checking characters are case-insensitive, one constant") - (Assert-not-equalp ?\u00E9 (aref (format "%c" ?a) 0) - "checking distinct characters are not equalp, one constant") - (Assert-equalp t (and) - "checking symbols are correctly #'equalp") - (Assert-not-equalp t (or nil '#:t) - "checking distinct symbols with the same name are not #'equalp") - (Assert-equalp #s(char-table type generic data (?\u0080 "hi-there")) - (let ((aragh (make-char-table 'generic))) - (put-char-table ?\u0080 "hi-there" aragh) - aragh) - "checking #'equalp succeeds correctly, char-tables") - (Assert-equalp #s(char-table type generic data (?\u0080 "hi-there")) - (let ((aragh (make-char-table 'generic))) - (put-char-table ?\u0080 "HI-THERE" aragh) - aragh) - "checking #'equalp succeeds correctly, char-tables") - (Assert-not-equalp #s(char-table type generic data (?\u0080 "hi-there")) - (let ((aragh (make-char-table 'generic))) - (put-char-table ?\u0080 "hi there" aragh) - aragh) - "checking #'equalp fails correctly, char-tables")) + (Assert (equalp ?\u00E9 Eacute-character) + "checking characters are case-insensitive, one constant") + (Assert (not (equalp ?\u00E9 (aref (format "%c" ?a) 0))) + "checking distinct characters are not equalp, one constant") + (Assert (equalp t (and)) + "checking symbols are correctly #'equalp") + (Assert (not (equalp t (or nil '#:t))) + "checking distinct symbols with the same name are not #'equalp") + (Assert (equalp #s(char-table type generic data (?\u0080 "hi-there")) + (let ((aragh (make-char-table 'generic))) + (put-char-table ?\u0080 "hi-there" aragh) + aragh)) + "checking #'equalp succeeds correctly, char-tables") + (Assert (equalp #s(char-table type generic data (?\u0080 "hi-there")) + (let ((aragh (make-char-table 'generic))) + (put-char-table ?\u0080 "HI-THERE" aragh) + aragh)) + "checking #'equalp succeeds correctly, char-tables") + (Assert (not (equalp #s(char-table type generic data (?\u0080 "hi-there")) + (let ((aragh (make-char-table 'generic))) + (put-char-table ?\u0080 "hi there" aragh) + aragh))) + "checking #'equalp fails correctly, char-tables") ;; There are more tests available for equalp here: ;; @@ -2279,33 +2280,33 @@ (1- most-negative-fixnum)) (*-2-most-positive-fixnum () (* 2 most-positive-fixnum))) - (Assert-eq - (member* (1+ most-positive-fixnum) member*-list) - (member* (1+ most-positive-fixnum) member*-list :test #'eql) - "checking #'member* correct if #'eql not explicitly specified") - (Assert-eq - (assoc* (1+ most-positive-fixnum) assoc*-list) - (assoc* (1+ most-positive-fixnum) assoc*-list :test #'eql) - "checking #'assoc* correct if #'eql not explicitly specified") - (Assert-eq - (rassoc* (1- most-negative-fixnum) assoc*-list) - (rassoc* (1- most-negative-fixnum) assoc*-list :test #'eql) - "checking #'rassoc* correct if #'eql not explicitly specified") - (Assert-eql (1+most-positive-fixnum) (1+ most-positive-fixnum) - "checking #'eql handles a bignum literal properly.") - (Assert-eq - (member* (1+most-positive-fixnum) member*-list) - (member* (1+ most-positive-fixnum) member*-list :test #'equal) - "checking #'member* compiler macro correct with literal bignum") - (Assert-eq - (assoc* (1+most-positive-fixnum) assoc*-list) - (assoc* (1+ most-positive-fixnum) assoc*-list :test #'equal) - "checking #'assoc* compiler macro correct with literal bignum") + (Assert (eq + (member* (1+ most-positive-fixnum) member*-list) + (member* (1+ most-positive-fixnum) member*-list :test #'eql)) + "checking #'member* correct if #'eql not explicitly specified") + (Assert (eq + (assoc* (1+ most-positive-fixnum) assoc*-list) + (assoc* (1+ most-positive-fixnum) assoc*-list :test #'eql)) + "checking #'assoc* correct if #'eql not explicitly specified") + (Assert (eq + (rassoc* (1- most-negative-fixnum) assoc*-list) + (rassoc* (1- most-negative-fixnum) assoc*-list :test #'eql)) + "checking #'rassoc* correct if #'eql not explicitly specified") + (Assert (eql (1+most-positive-fixnum) (1+ most-positive-fixnum)) + "checking #'eql handles a bignum literal properly.") + (Assert (eq + (member* (1+most-positive-fixnum) member*-list) + (member* (1+ most-positive-fixnum) member*-list :test #'equal)) + "checking #'member* compiler macro correct with literal bignum") + (Assert (eq + (assoc* (1+most-positive-fixnum) assoc*-list) + (assoc* (1+ most-positive-fixnum) assoc*-list :test #'equal)) + "checking #'assoc* compiler macro correct with literal bignum") (puthash (setq hashed-bignum (*-2-most-positive-fixnum)) (gensym) hashing) - (Assert-eq - (gethash (* 2 most-positive-fixnum) hashing) - (gethash hashed-bignum hashing) - "checking hashing works correctly with #'eql tests and bignums")))) + (Assert (eq + (gethash (* 2 most-positive-fixnum) hashing) + (gethash hashed-bignum hashing)) + "checking hashing works correctly with #'eql tests and bignums")))) ;;; end of lisp-tests.el
--- a/tests/automated/md5-tests.el Sun Mar 07 06:43:19 2010 -0600 +++ b/tests/automated/md5-tests.el Fri Mar 12 18:27:51 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 Sun Mar 07 06:43:19 2010 -0600 +++ b/tests/automated/mule-tests.el Fri Mar 12 18:27:51 2010 -0600 @@ -1,4 +1,5 @@ ;; Copyright (C) 1999 Free Software Foundation, Inc. +;; Copyright (C) 2010 Ben Wing. ;; Author: Hrvoje Niksic <hniksic@xemacs.org> ;; Maintainers: Hrvoje Niksic <hniksic@xemacs.org>, @@ -65,7 +66,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 +153,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 +178,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 +189,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 +211,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 +220,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 +229,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 +267,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 +276,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 +352,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 string character conversion @@ -438,8 +439,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))) @@ -457,8 +458,8 @@ do (progn (set-unicode-conversion scaron code) - (Assert-eq code (char-to-unicode scaron)) - (Assert-eq scaron (unicode-to-char code '(latin-iso8859-2)))) + (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))) @@ -473,37 +474,37 @@ (let* ((xemacs-character (car (append (decode-coding-string utf-8-char 'utf-8) nil))) - (xemacs-charset (char-charset xemacs-character))) + (xemacs-charset (car (split-char 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))) ;;--------------------------------------------------------------- @@ -520,11 +521,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 @@ -562,11 +563,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)))) ;;--------------------------------------------------------------- @@ -580,17 +581,17 @@ hebrew-iso8859-8 japanese-jisx0208 japanese-jisx0212 katakana-jisx0201 korean-ksc5601 latin-iso8859-1 latin-iso8859-2 vietnamese-viscii-lower))) - (Assert-equal + (Assert (equal ;; The sort is to make the algorithm of charsets-in-region ;; irrelevant. (sort (charsets-in-region (point-min) (point-max)) #'string<) - sorted-charsets-in-HELLO) - (Assert-equal + sorted-charsets-in-HELLO)) + (Assert (equal (sort (charsets-in-string (buffer-substring (point-min) (point-max))) #'string<) - sorted-charsets-in-HELLO))) + sorted-charsets-in-HELLO)))) ;;--------------------------------------------------------------- ;; Language environments, and whether the specified values are sane. @@ -603,7 +604,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)) @@ -623,7 +624,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 Sun Mar 07 06:43:19 2010 -0600 +++ b/tests/automated/query-coding-tests.el Fri Mar 12 18:27:51 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,19 +89,20 @@ (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) @@ -113,9 +114,10 @@ (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) @@ -159,17 +161,19 @@ (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) @@ -181,22 +185,24 @@ (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. @@ -213,7 +219,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")) @@ -277,15 +283,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) @@ -300,7 +306,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) @@ -336,11 +342,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))) @@ -390,23 +396,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 Sun Mar 07 06:43:19 2010 -0600 +++ b/tests/automated/regexp-tests.el Fri Mar 12 18:27:51 2010 -0600 @@ -1,6 +1,7 @@ ;;; -*- coding: iso-8859-1 -*- ;; Copyright (C) 2000, 2002, 2003 Free Software Foundation, Inc. +;; Copyright (C) 2010 Ben Wing. ;; Author: Yoshiki Hayashi <yoshiki@xemacs.org> ;; Maintainer: Stephen J. Turnbull <stephen@xemacs.org> @@ -96,40 +97,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)))) @@ -217,25 +218,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 @@ -315,15 +316,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 " \\< " " "))) @@ -351,17 +352,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)))) ) ) @@ -408,24 +409,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 @@ -440,7 +441,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))) @@ -449,14 +450,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))) @@ -531,14 +532,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 "[-"))) @@ -554,16 +555,16 @@ (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))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -584,16 +585,16 @@ ;; Control-1 characters were second-class citizens in regexp ranges ;; for a while there. Addressed in Ben's Mercurial changeset ;; 2e15c29cc2b3; attempt to ensure this doesn't happen again. -(Assert-eql (string-match "[\x00-\x7f\x80-\x9f]" "a") 0) -(Assert-eql (string-match "[\x00-\x7f\x80-\x9f]" "é") nil) +(Assert (eql (string-match "[\x00-\x7f\x80-\x9f]" "a") 0)) +(Assert (eql (string-match "[\x00-\x7f\x80-\x9f]" "é") nil)) ;; Gave nil in 21.5 for a couple of years. -(Assert-eql (string-match "[\x00-\x7f\x80-\x9f]" "\x80") 0) -(Assert-eql (string-match "[\x00-\x7f]\\|[\x80-\x9f]" "\x80") 0) +(Assert (eql (string-match "[\x00-\x7f\x80-\x9f]" "\x80") 0)) +(Assert (eql (string-match "[\x00-\x7f]\\|[\x80-\x9f]" "\x80") 0)) ;; Gave nil -(Assert-eql (string-match "[\x7f\x80-\x9f]" "\x80") 0) -(Assert-eql (string-match "[\x80-\x9f]" "\x80") 0) -(Assert-eql (string-match "[\x7f\x80-\x9e]" "\x80") 0) +(Assert (eql (string-match "[\x7f\x80-\x9f]" "\x80") 0)) +(Assert (eql (string-match "[\x80-\x9f]" "\x80") 0)) +(Assert (eql (string-match "[\x7f\x80-\x9e]" "\x80") 0)) ;; Used to succeed even with the bug. -(Assert-eql (string-match "[\x7f\x80\x9f]" "\x80") 0) -(Assert-eql (string-match "[\x7e\x80-\x9f]" "\x80") 0) -(Assert-eql (string-match "[\x7f\x81-\x9f]" "\x81") 0) +(Assert (eql (string-match "[\x7f\x80\x9f]" "\x80") 0)) +(Assert (eql (string-match "[\x7e\x80-\x9f]" "\x80") 0)) +(Assert (eql (string-match "[\x7f\x81-\x9f]" "\x81") 0))
--- a/tests/automated/region-tests.el Sun Mar 07 06:43:19 2010 -0600 +++ b/tests/automated/region-tests.el Fri Mar 12 18:27:51 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/search-tests.el Sun Mar 07 06:43:19 2010 -0600 +++ b/tests/automated/search-tests.el Fri Mar 12 18:27:51 2010 -0600 @@ -45,11 +45,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)) @@ -57,51 +57,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)))) @@ -120,26 +120,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 @@ -150,11 +150,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)))))) @@ -177,7 +177,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-searches) ; normal when we have DEBUG_XEMACS @@ -193,7 +193,7 @@ (insert "\n\nDer ber\xfchmte 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 ber\xfchmte deutsche Flei\xdf\n\n") @@ -201,15 +201,15 @@ (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)) (setq newcase (copy-case-table (standard-case-table))) (put-case-table-pair (make-char 'ethiopic #x23 #x23) (make-char 'ethiopic #x23 #x25) @@ -225,21 +225,21 @@ (insert (make-char 'ethiopic #x23 #x23)) (insert ?1) (goto-char (point-min)) - (Assert-eql (search-forward + (Assert (eql (search-forward (string (make-char 'ethiopic #x23 #x25)) nil t) - 3) - (Assert-eq 'simple-search search-algorithm-used) + 3)) + (Assert (eq 'simple-search search-algorithm-used)) (goto-char (point-min)) - (Assert-eql (search-forward + (Assert (eql (search-forward (string (make-char 'ethiopic #x23 #x27)) nil t) - nil) - (Assert-eq 'boyer-moore search-algorithm-used)))))) + nil)) + (Assert (eq 'boyer-moore search-algorithm-used))))))) ;; XEmacs bug of long standing. (with-temp-buffer (insert "foo\201bar") (goto-char (point-min)) - (Assert-eq (search-forward "\201" nil t) 5)) + (Assert (eq (search-forward "\201" nil t) 5)))
--- a/tests/automated/symbol-tests.el Sun Mar 07 06:43:19 2010 -0600 +++ b/tests/automated/symbol-tests.el Fri Mar 12 18:27:51 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 Sun Mar 07 06:43:19 2010 -0600 +++ b/tests/automated/syntax-tests.el Fri Mar 12 18:27:51 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))))) @@ -204,7 +204,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 Sun Mar 07 06:43:19 2010 -0600 +++ b/tests/automated/tag-tests.el Fri Mar 12 18:27:51 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/weak-tests.el Sun Mar 07 06:43:19 2010 -0600 +++ b/tests/automated/weak-tests.el Fri Mar 12 18:27:51 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)