[funds-cvs] r12 - trunk/funds/src/trees/tests

[abaine at common-lisp.net]

Author: abaine
Date: Wed Jun 13 22:09:33 2007
New Revision: 12

Added:
   trunk/funds/src/trees/tests/
   trunk/funds/src/trees/tests/avl-tree-test.lisp
   trunk/funds/src/trees/tests/package.lisp
Log:
Began to implement unit tests for AVL Trees

Added: trunk/funds/src/trees/tests/avl-tree-test.lisp
==============================================================================
--- (empty file)
+++ trunk/funds/src/trees/tests/avl-tree-test.lisp	Wed Jun 13 22:09:33 2007
@@ -0,0 +1,32 @@
+
+(in-package :funds-trees-tests)
+
+(defun random-tree ()
+  (reduce #'(lambda (tr v)
+	    (avl-insert tr v v))
+	  (loop for i below 100 collect (random 10000))
+	  :initial-value (empty-avl-tree)))
+
+(define-test empty-avl-tree
+  (assert-true (avl-empty-p (empty-avl-tree)))
+  (assert-equal 0 (avl-height (empty-avl-tree))))
+
+
+(define-test avl-insert
+  (assert-true (balanced (random-tree))))
+
+(defun balanced (tree)
+  (or (avl-empty-p tree)
+      (and (balanced (avl-left tree))
+	   (balanced (avl-right tree))
+	   (< -2 (- (avl-height (avl-left tree))
+		    (avl-height (avl-right tree)))
+	      2))))
+
+
+(defun root-height-correct (tree)
+  (let* ((a (avl-height (avl-left tree)))
+	 (b (avl-height (avl-right tree)))
+	 (c (if (> a b) a b))) 
+    (eql (1+ c) (avl-height tree))))
+

Added: trunk/funds/src/trees/tests/package.lisp
==============================================================================
--- (empty file)
+++ trunk/funds/src/trees/tests/package.lisp	Wed Jun 13 22:09:33 2007
@@ -0,0 +1,7 @@
+
+(in-package :cl-user)
+
+(defpackage funds-trees-tests
+  (:use :cl
+	:funds-trees
+	:lisp-unit))