[funds-cvs] r88 - trunk/funds/tests/trees

[abaine at common-lisp.net]

Author: abaine
Date: Wed Jul 11 16:41:24 2007
New Revision: 88

Modified:
   trunk/funds/tests/trees/avl-tree-test.lisp
Log:
Corrected assert-avl-valid macro per Rahul Jain's suggestion.

Modified: trunk/funds/tests/trees/avl-tree-test.lisp
==============================================================================
--- trunk/funds/tests/trees/avl-tree-test.lisp	(original)
+++ trunk/funds/tests/trees/avl-tree-test.lisp	Wed Jul 11 16:41:24 2007
@@ -17,19 +17,17 @@
 
 (in-package :funds-tests)
 
-(defun random-tree (&key (test #'eql) (order #'<))
-  (reduce #'(lambda (tr v)
-	      (tree-insert  tr v v :test test :order order))
-	  (loop for i below 40 collect (random 20))
-	  :initial-value (make-avl-tree)))
-
-(defconstant +never-equal+ #'(lambda (a b) (declare (ignore a b)) nil))
-
 (defmacro assert-avl-valid (tree &key (order #'<))
-  `(progn
-    (assert-true (height-correct-p ,tree) (funds::tree-as-pre-order-alist ,tree))
-    (assert-true (balanced-p ,tree) (funds::tree-as-pre-order-alist ,tree))
-    (assert-true (ordered-p ,tree :order ,order) (funds::tree-as-pre-order-alist ,tree))))
+  (let ((tree-var (gensym "TREE-"))
+	(order-var (gensym "ORDER-")))
+    `(let ((,tree-var ,tree)
+	   (,order-var ,order))
+      (assert-true (height-correct-p ,tree-var) 
+       (funds::tree-as-pre-order-alist ,tree-var))
+      (assert-true (balanced-p ,tree-var) 
+       (funds::tree-as-pre-order-alist ,tree-var))
+      (assert-true (ordered-p ,tree-var :order ,order-var) 
+       (funds::tree-as-pre-order-alist ,tree-var)))))
 
 (define-test test-tree-empty-p
   (assert-true (tree-empty-p (make-avl-tree)))
@@ -39,6 +37,12 @@
   (let ((tree (random-tree)))
     (assert-avl-valid tree)))
 
+(defun random-tree (&key (test #'eql) (order #'<))
+  (reduce #'(lambda (tr v)
+	      (tree-insert  tr v v :test test :order order))
+	  (loop for i below 40 collect (random 20))
+	  :initial-value (make-avl-tree)))
+
 (defun height-correct-p (tree)
   "Whether (tree-height tree) returns the correct height of the given 
 AVL Tree.  The height is correct if (a) the tree is empty and zero