source: project/nondescript/binary-tree/tests/binary-tree-test.scm @ 8915

;;;; binary-tree-test.scm

(use testbase testbase-output-human)
(use avltree)
(use srfi-1 srfi-13)

;;;

(define-inline (->boolean obj)
        (and obj #t) )

(define (random-alist n #!optional (lim (* n 10)))
        (let loop ([n n] [al '()])
                (if (zero? n)
        al
        (loop (sub1 n) (alist-cons (random lim) (gensym) al)) ) ) )

(define (alist-same? al1 al2)
        (every
                (lambda (pare)
                        (and-let* ([v2 (alist-ref (car pare) al2 equal?)])
                                (equal? v2 (cdr pare)) ) )
                al1) )

(define (list-same? l1 l2)
        (every (lambda (x) (->boolean (member x l2))) l1) )

(define (random-tree n)
        (alist->avltree (random-alist n) <) )

;;;

(define-expect-binary alist-same? alist-same "alist same key-value pairs, w/o ordering")

(define-expect-binary list-same? list-same "list same values, w/o ordering")

;;;

(define-test avltree-test "Avl-Tree"
  (initial
                (define t1 #f) )

        (expect-set! t1
                (alist->avltree
                        '(("phone" . 3456) ("fax" . 2345) ("name" . "foo") ("address" . "23 Marylane Ave"))
                        string<))

        (test/case "Avl-Tree Basic"

                (expect-true (avltree? t1))
                (expect-false (avltree? 23))

                (expect-false (avltree-empty? t1))
                (expect-eqv 4 (avltree-size t1))

                (expect-true (avltree-exists? t1 "name"))
                (expect-false (avltree-exists? t1 "foo"))

                (expect-eqv 2345 (avltree-ref t1 "fax"))
                (expect-false (avltree-ref/default t1 "foo" #f))
                (expect-failure (avltree-ref t1 "foo"))

                (expect-alist-same
                        '(("phone" . 3456) ("fax" . 2345) ("name" . "foo") ("address" . "23 Marylane Ave"))
                        (avltree->alist t1))

                (expect-list-same
                        '("phone" "fax" "name" "address")
                        (avltree-keys t1))
                (expect-list-same
                        '(3456 2345 "foo" "23 Marylane Ave")
                        (avltree-values t1))
        )

        (test/case "Avl-Tree Delete" (
                        [t2 #f] )

                (expect-false (avltree-delete! t1 "foo"))
                (expect-success (avltree-delete! t1 "name"))
                (expect-eqv 3 (avltree-size t1))
                (expect-failure (avltree-ref t1 "name"))
                (expect-failure (avltree-update! t1 "name" (lambda (v) v)))

                (expect-set! t2 (avltree-delete t1 "fax"))
                (expect-eqv 2 (avltree-size t2))
                (expect-eqv 3 (avltree-size t1))
                (expect-failure (avltree-ref t2 "fax"))
                (expect-failure (avltree-update t2 "fax" (lambda (v) v)))

                (expect-set! t2 (avltree-set t2 "name" "bar"))
                (expect-eqv 3 (avltree-size t2))
                (expect-equal "bar" (avltree-ref t2 "name"))
                (expect-set! t2 (avltree-update t2 "name" (lambda (v) "baz")))
                (expect-equal "baz" (avltree-ref t2 "name"))
                (expect-eqv 3 (avltree-size t2))

                (expect-success (avltree-set! t1 "name" "bar"))
                (expect-eqv 4 (avltree-size t1))
                (expect-equal "bar" (avltree-ref t1 "name"))
                (expect-success (avltree-update! t1 "name" (lambda (v) "baz")))
                (expect-equal "baz" (avltree-ref t1 "name"))
                (expect-eqv 4 (avltree-size t1))

                (expect-success (avltree-delete! t1 "fax"))
                (expect-success (avltree-vacuum! t1))
                (expect-eqv 3 (avltree-size t1))
                (expect-alist-same
                        '(("phone" . 3456) ("name" . "baz") ("address" . "23 Marylane Ave"))
                        (avltree->alist t1))

                (expect-set! t2 (avltree-copy t2))
                (expect-eqv 3 (avltree-size t2))
                (expect-alist-same
                        '(("phone" . 3456) ("name" . "baz") ("address" . "23 Marylane Ave"))
                        (avltree->alist t1))

                (expect-success (avltree-delete! t1 "phone"))
                (expect-success (avltree-delete! t1 "name"))
                (expect-success (avltree-delete! t1 "address"))
                (expect-eqv 0 (avltree-size t1))
                (expect-alist-same
                        '()
                        (avltree->alist t1))
                (expect-success (avltree-vacuum! t1))
                (expect-eqv 0 (avltree-size t1))
                (expect-alist-same
                        '()
                        (avltree->alist t1))
        )
)

(test::styler-set! avltree-test test::output-style-human)
(run-test "AVL Tree Tests")

(test::forget!)