Author: abaine Date: Wed Jun 20 18:28:06 2007 New Revision: 36 Modified: trunk/funds/tests/trees/avl-tree-test.lisp Log: Modified tests to include keyword arguments to avl-insert. 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 Jun 20 18:28:06 2007 @@ -1,17 +1,19 @@ (in-package :funds.tests.trees) -(defun random-tree () - (reduce #'(lambda (tr v) - (avl-insert tr v v)) - (loop for i below 20 collect (random 10)) - :initial-value (empty-avl-tree))) +(defun random-tree (&key (test #'eql) (order #'<)) + (print (reduce #'(lambda (tr v) + (avl-insert tr v v :test test :order order)) + (loop for i below 40 collect (random 20)) + :initial-value (empty-avl-tree)))) -(defmacro assert-avl-valid (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) ,tree) (assert-true (balanced-p ,tree) ,tree) - (assert-true (ordered-p ,tree) ,tree))) + (assert-true (ordered-p ,tree :order ,order) ,tree))) (define-test test-avl-empty-p (assert-true (avl-empty-p (empty-avl-tree))) @@ -49,7 +51,7 @@ (avl-height (avl-right tree))) 2)))) -(defun ordered-p (tree &optional (less-than #'<)) +(defun ordered-p (tree &key (order #'<)) "Whether this AVL tree is properly ordered. To be ordered, the tree must be either (a) empty or (b) satisfy each of the following requirements: @@ -64,10 +66,10 @@ (and (ordered-p (avl-left tree)) (ordered-p (avl-right tree)) (or (avl-empty-p (avl-left tree)) - (not (funcall less-than (avl-key tree) + (not (funcall order (avl-key tree) (greatest-key (avl-left tree))))) (or (avl-empty-p (avl-right tree)) - (not (funcall less-than (least-key (avl-right tree)) + (not (funcall order (least-key (avl-right tree)) (avl-key tree))))))) (defun least-key (tree)