Mercurial > hg > xemacs-beta

diff lisp/test-harness.el @ 5136:0f66906b6e37

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
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 b24cf478a45e
children ecdd1daab447
line wrap: on
line diff
--- 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)))))