Mercurial > hg > xemacs-beta

changeset 2056:ab71063baf27

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
[xemacs-hg @ 2004-05-03 15:08:41 by james] Add failing-case parameter to Assert and use it in lisp-tests.
author james
date Mon, 03 May 2004 15:08:51 +0000
parents 512c8189d646
children 471242c84954
files tests/ChangeLog tests/automated/lisp-tests.el tests/automated/test-harness.el
diffstat 3 files changed, 137 insertions(+), 108 deletions(-) [+]
line wrap: on
line diff
--- a/tests/ChangeLog	Sun May 02 21:50:42 2004 +0000
+++ b/tests/ChangeLog	Mon May 03 15:08:51 2004 +0000
@@ -1,3 +1,12 @@
+2004-04-21  Jerry James  <james@xemacs.org>
+
+	* automated/test-harness.el (Assert): Add an optional failing-case
+	arg so we can see what the test was trying to do when it failed.
+	* automated/lisp-tests.el: Use the failing-case arg for Asserts
+	with variables.  Use eql on tests that might produce bignums.  Fix
+	test for non-bignum XEmacsen that fails because
+	(eq most-negative-fixnum (- most-negative-fixnum)).
+
 2004-04-19  Stephen J. Turnbull  <turnbull@sk.tsukuba.ac.jp>
 
 	* automated/mule-tests.el: Inhibit GC to speed up BIG_STRING tests.
--- a/tests/automated/lisp-tests.el	Sun May 02 21:50:42 2004 +0000
+++ b/tests/automated/lisp-tests.el	Mon May 03 15:08:51 2004 +0000
@@ -266,12 +266,12 @@
   (Assert (= (- 0 one one) -2))
   (Assert (= (+ one 1) 2))
   (dolist (zero '(0 0.0 ?\0))
-    (Assert (= (+ 1 zero) 1))
-    (Assert (= (+ zero 1) 1))
-    (Assert (= (- zero) zero))
-    (Assert (= (- zero) 0))
-    (Assert (= (- zero zero) 0))
-    (Assert (= (- zero one one) -2))))
+    (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)))
@@ -318,12 +318,12 @@
 (dolist (six '(6 6.0 ?\06))
   (dolist (two '(2 2.0 ?\02))
     (dolist (three '(3 3.0 ?\03))
-      (Assert (= (/ six two) three)))))
+      (Assert (= (/ six two) three) (list six two three)))))
 
 (dolist (three '(3 3.0 ?\03))
-  (Assert (= (/ three 2.0) 1.5)))
+  (Assert (= (/ three 2.0) 1.5) three))
 (dolist (two '(2 2.0 ?\02))
-  (Assert (= (/ 3.0 two) 1.5)))
+  (Assert (= (/ 3.0 two) 1.5) two))
 
 (when (featurep 'bignum)
   (let* ((million 1000000)
@@ -351,21 +351,21 @@
 (Assert (= 1 (*)))
 
 (dolist (one `(1 1.0 ?\01 ,(Int-to-Marker 1)))
-  (Assert (= 1 (* one))))
+  (Assert (= 1 (* one)) one))
 
 (dolist (two '(2 2.0 ?\02))
-  (Assert (= 2 (* 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)))))
+      (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))
+    (Assert (= (* 1.5 two) three) (list two three))
     (dolist (five '(5 5.0 ?\05))
-      (Assert (= 30 (* five two three))))))
+      (Assert (= 30 (* five two three)) (list five two three)))))
 
 (when (featurep 'bignum)
   (let ((64K 65536))
@@ -384,32 +384,32 @@
 (Assert (= 0 (+)))
 
 (dolist (one `(1 1.0 ?\01 ,(Int-to-Marker 1)))
-  (Assert (= 1 (+ one))))
+  (Assert (= 1 (+ one)) one))
 
 (dolist (two '(2 2.0 ?\02))
-  (Assert (= 2 (+ 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))
-      (Assert (= 10 (+ 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)))
-  (Assert (= one (max one one)))
-  (Assert (= one (max one one one)))
-  (Assert (= one (min one)))
-  (Assert (= one (min one one)))
-  (Assert (= one (min 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)))
-    (Assert (= one (min one two two)))
-    (Assert (= one (min two two one)))
-    (Assert (= two (max one two)))
-    (Assert (= two (max one two two)))
-    (Assert (= two (max two two one)))))
+    (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))
@@ -470,22 +470,22 @@
 (Check-Error wrong-type-argument (logand 3.0))
 
 (dolist (three '(3 ?\03))
-  (Assert (eq 3 (logand three)))
-  (Assert (eq 3 (logxor three)))
-  (Assert (eq 3 (logior three)))
-  (Assert (eq 3 (logand three three)))
-  (Assert (eq 0 (logxor three three)))
-  (Assert (eq 3 (logior 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)))
-    (Assert (eq 3 (logior one two)))
-    (Assert (eq 3 (logxor 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)))
-    (Assert (eq 3 (logior one three)))
-    (Assert (eq 2 (logxor 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,12 +501,25 @@
 (Check-Error wrong-type-argument (% 10.0 2))
 (Check-Error wrong-type-argument (% 10 2.0))
 
-(dotimes (j 30)
-  (let ((x (- (random) (random))))
-    (Assert (eq x (+ (% x 17) (* (/ x 17) 17))))
-    (Assert (eq (- x) (+ (% (- x) 17) (* (/ (- x) 17) 17))))
-    (Assert (eq (% x -17) (- (% (- x) 17))))
-    ))
+(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)))
+  (test1 most-negative-fixnum)
+  (if (featurep 'bignum)
+      (test2 most-negative-fixnum) 
+    (test3 most-negative-fixnum))
+  (test4 most-negative-fixnum)
+  (test1 most-positive-fixnum)
+  (test2 most-positive-fixnum)
+  (test4 most-positive-fixnum)
+  (dotimes (j 30)
+    (let ((x (random)))
+      (if (eq x most-negative-fixnum) (setq x (1+ x)))
+      (if (eq x most-positive-fixnum) (setq x (1- x)))
+      (test1 x)
+      (test2 x)
+      (test4 x))))
 
 (macrolet
     ((division-test (seven)
@@ -584,12 +597,12 @@
 
 ;; One argument always yields t
 (loop for x in `(1 1.0 ,(Int-to-Marker 1) ?z) do
-  (Assert (eq t (=  x)))
-  (Assert (eq t (<  x)))
-  (Assert (eq t (>  x)))
-  (Assert (eq t (>= x)))
-  (Assert (eq t (<= x)))
-  (Assert (eq t (/= 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
@@ -603,44 +616,44 @@
 ;; Meat
 (dolist (one `(1 1.0 ,(Int-to-Marker 1) ?\01))
   (dolist (two '(2 2.0 ?\02))
-    (Assert (<  one two))
-    (Assert (<= one two))
-    (Assert (<= two two))
-    (Assert (>  two one))
-    (Assert (>= two one))
-    (Assert (>= two two))
-    (Assert (/= one two))
-    (Assert (not (/= two two)))
-    (Assert (not (< one one)))
-    (Assert (not (> one one)))
-    (Assert (<= one one two two))
-    (Assert (not (< one one two two)))
-    (Assert (>= two two one one))
-    (Assert (not (> two two one one)))
-    (Assert (= one one one))
-    (Assert (not (= one one one two)))
-    (Assert (not (/= one two one)))
+    (Assert (<  one two) (list one two))
+    (Assert (<= one two) (list one two))
+    (Assert (<= two two) two)
+    (Assert (>  two one) (list one two))
+    (Assert (>= two one) (list one two))
+    (Assert (>= two two) two)
+    (Assert (/= one two) (list one two))
+    (Assert (not (/= two two)) two)
+    (Assert (not (< one one)) one)
+    (Assert (not (> one one)) one)
+    (Assert (<= one one two two) (list one two))
+    (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 (not (= one one one two)) (list one two))
+    (Assert (not (/= one two one)) (list one two))
     ))
 
 (dolist (one `(1 1.0 ,(Int-to-Marker 1) ?\01))
   (dolist (two '(2 2.0 ?\02))
-    (Assert (<  one two))
-    (Assert (<= one two))
-    (Assert (<= two two))
-    (Assert (>  two one))
-    (Assert (>= two one))
-    (Assert (>= two two))
-    (Assert (/= one two))
-    (Assert (not (/= two two)))
-    (Assert (not (< one one)))
-    (Assert (not (> one one)))
-    (Assert (<= one one two two))
-    (Assert (not (< one one two two)))
-    (Assert (>= two two one one))
-    (Assert (not (> two two one one)))
-    (Assert (= one one one))
-    (Assert (not (= one one one two)))
-    (Assert (not (/= one two one)))
+    (Assert (<  one two) (list one two))
+    (Assert (<= one two) (list one two))
+    (Assert (<= two two) two)
+    (Assert (>  two one) (list one two))
+    (Assert (>= two one) (list one two))
+    (Assert (>= two two) two)
+    (Assert (/= one two) (list one two))
+    (Assert (not (/= two two)) two)
+    (Assert (not (< one one)) one)
+    (Assert (not (> one one)) one)
+    (Assert (<= one one two two) (list one two))
+    (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 (not (= one one one two)) (list one two))
+    (Assert (not (/= one two one)) (list one two))
     ))
 
 ;; ad-hoc
@@ -1108,18 +1121,18 @@
 	(make-extent nil nil nil)
 	(make-face 'test-face))
   do
-  (Assert (eq 2 (get obj ?1 2)))
-  (Assert (eq 4 (put obj ?3 4)))
-  (Assert (eq 4 (get obj ?3)))
+  (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))))
-  (Assert (eq t (remprop obj ?3)))
+    (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))))
-  (Assert (eq nil (remprop obj ?3)))
+    (Assert (eq '() (object-plist obj)) obj))
+  (Assert (eq nil (remprop obj ?3)) obj)
   (when (or (stringp obj) (symbolp obj))
-    (Assert (eq '() (object-plist obj))))
-  (Assert (eq 5 (get obj ?3 5)))
+    (Assert (eq '() (object-plist obj)) obj))
+  (Assert (eq 5 (get obj ?3 5)) obj)
   )
 
 (Check-Error-Message
--- a/tests/automated/test-harness.el	Sun May 02 21:50:42 2004 +0000
+++ b/tests/automated/test-harness.el	Mon May 03 15:08:51 2004 +0000
@@ -210,18 +210,25 @@
 	       (Print-Skip ,description ,reason))
 	   ,@body))
 
-      (defmacro Assert (assertion)
+      (defmacro Assert (assertion &optional failing-case)
 	`(condition-case error-info
-	     (progn
-	       (assert ,assertion)
-	       (Print-Pass "%S" (quote ,assertion))
-	       (incf passes))
-	   (cl-assertion-failed
-	    (Print-Failure "Assertion failed: %S" (quote ,assertion))
-	    (incf assertion-failures))
-	   (t (Print-Failure "%S ==> error: %S" (quote ,assertion) error-info)
-	      (incf other-failures)
-	      )))
+	  (progn
+	    (assert ,assertion)
+	    (Print-Pass "%S" (quote ,assertion))
+	    (incf passes))
+	  (cl-assertion-failed
+	   (Print-Failure (if ,failing-case
+			      "Assertion failed: %S; failing case = %S"
+			    "Assertion failed: %S")
+			  (quote ,assertion) ,failing-case)
+	   (incf assertion-failures))
+	  (t (Print-Failure (if ,failing-case
+				"%S ==> error: %S; failing case =  %S"
+			      "%S ==> error: %S")
+			    (quote ,assertion) error-info ,failing-case)
+	     (incf other-failures)
+	     )))
+
 
       (defmacro Check-Error (expected-error &rest body)
 	(let ((quoted-body (if (= 1 (length body))