179 lines
4.5 KiB
Racket
179 lines
4.5 KiB
Racket
(load-relative "../racket/loadtest.rktl")
|
|
(require mzlib/class
|
|
syntax-color/token-tree)
|
|
|
|
(define t (new token-tree% (length 1) (data 'a)))
|
|
|
|
(define (check-only-root)
|
|
(test #f 'get-root (not (send t get-root)))
|
|
(test #f node-left (send t get-root))
|
|
(test #f node-right (send t get-root)))
|
|
|
|
(define (check-root len dat sp ep)
|
|
(test len 'get-root-length (send t get-root-length))
|
|
(test dat 'get-root-data (send t get-root-data))
|
|
(test sp 'get-root-start-position (send t get-root-start-position))
|
|
(test ep 'get-root-end-position (send t get-root-end-position)))
|
|
|
|
(Section 'init-tree)
|
|
(test #f 'is-empty (send t is-empty?))
|
|
(check-only-root)
|
|
(check-root 1 'a 0 1)
|
|
|
|
(send t reset-tree)
|
|
(Section 'empty-tree)
|
|
(test #f 'get-root (send t get-root))
|
|
(test #t 'is-empty (send t is-empty?))
|
|
(check-root 0 #f 0 0)
|
|
|
|
(define (build-tree n len?)
|
|
(when (> n 0)
|
|
(insert-first! t (new token-tree% (length (if len? 5 n)) (data (list n 1))))
|
|
(insert-last! t (new token-tree% (length (if len? 5 n)) (data (list n 2))))
|
|
(build-tree (sub1 n) len?)))
|
|
(define (check-tree n)
|
|
(let ((tot-len (* n 10)))
|
|
(let loop ((i 0))
|
|
(when (< i n)
|
|
(let* ((x (* i 5))
|
|
(y (- tot-len x 5)))
|
|
(send t search! x)
|
|
(check-root 5 (list (add1 i) 1) x (+ 5 x))
|
|
(send t search! y)
|
|
(check-root 5 (list (add1 i) 2) y (+ 5 y)))
|
|
(loop (add1 i))))))
|
|
|
|
|
|
(build-tree 4 #t)
|
|
(Section 'check-tree)
|
|
(check-tree 4)
|
|
(send t search-min!)
|
|
(check-root 5 '(1 1) 0 5)
|
|
(send t search-max!)
|
|
(check-root 5 '(1 2) 35 40)
|
|
|
|
(Section 'remove-root)
|
|
(send t search! 20)
|
|
(send t remove-root!)
|
|
(send t search-max!)
|
|
(check-root 5 '(1 2) 30 35)
|
|
|
|
(Section 'add-to-root-length)
|
|
(send t search-min!)
|
|
(send t add-to-root-length 1)
|
|
(check-root 6 '(1 1) 0 6)
|
|
(send t search! 15)
|
|
(check-root 5 '(3 1) 11 16)
|
|
(send t search-max!)
|
|
(check-root 5 '(1 2) 31 36)
|
|
|
|
(Section 'for-each)
|
|
(send t reset-tree)
|
|
(build-tree 4 #f)
|
|
(let loop ((i 0))
|
|
(when (< i 1000)
|
|
(send t search! (random 20))
|
|
(loop (add1 i))))
|
|
(define (to-list t)
|
|
(let ((x null))
|
|
(send t for-each (lambda (start len data) (set! x (cons (list start len data) x))))
|
|
(reverse x)))
|
|
(test '((0 1 (1 1))
|
|
(1 2 (2 1))
|
|
(3 3 (3 1))
|
|
(6 4 (4 1))
|
|
(10 4 (4 2))
|
|
(14 3 (3 2))
|
|
(17 2 (2 2))
|
|
(19 1 (1 2)))
|
|
'for-each (to-list t))
|
|
|
|
(Section 'stress)
|
|
(send t reset-tree)
|
|
(build-tree 100 #f)
|
|
(let loop ((i 0))
|
|
(when (< i 10000)
|
|
(send t search! (random 10100))
|
|
(loop (add1 i))))
|
|
(send t search-max!)
|
|
(check-root 1 '(1 2) 10099 10100)
|
|
|
|
(Section 'splits)
|
|
(send t reset-tree)
|
|
(build-tree 5 #f)
|
|
(let-values (((s e t1 t2)
|
|
(send t split 16)))
|
|
(test 15 'split s)
|
|
(test 20 'split e)
|
|
(test '((0 1 (1 1))
|
|
(1 2 (2 1))
|
|
(3 3 (3 1))
|
|
(6 4 (4 1))
|
|
(10 5 (5 1)))
|
|
'split (to-list t1))
|
|
(test '((0 4 (4 2))
|
|
(4 3 (3 2))
|
|
(7 2 (2 2))
|
|
(9 1 (1 2)))
|
|
'split (to-list t2)))
|
|
(build-tree 5 #f)
|
|
(let-values (((s e t1 t2)
|
|
(send t split 15)))
|
|
(test 10 'split s)
|
|
(test 20 'split e)
|
|
(test '((0 1 (1 1))
|
|
(1 2 (2 1))
|
|
(3 3 (3 1))
|
|
(6 4 (4 1)))
|
|
'split (to-list t1))
|
|
(test '((0 4 (4 2))
|
|
(4 3 (3 2))
|
|
(7 2 (2 2))
|
|
(9 1 (1 2)))
|
|
'split (to-list t2)))
|
|
(send t reset-tree)
|
|
(build-tree 5 #f)
|
|
(send t search! 15)
|
|
(let-values (((t1 t2) (send t split-after)))
|
|
(test '((0 1 (1 1))
|
|
(1 2 (2 1))
|
|
(3 3 (3 1))
|
|
(6 4 (4 1))
|
|
(10 5 (5 1))
|
|
(15 5 (5 2)))
|
|
'split-after (to-list t1))
|
|
(test '((0 4 (4 2))
|
|
(4 3 (3 2))
|
|
(7 2 (2 2))
|
|
(9 1 (1 2)))
|
|
'split-after (to-list t2)))
|
|
(send t reset-tree)
|
|
(build-tree 5 #f)
|
|
(send t search! 15)
|
|
(let-values (((t1 t2) (send t split-before)))
|
|
(test '((0 1 (1 1))
|
|
(1 2 (2 1))
|
|
(3 3 (3 1))
|
|
(6 4 (4 1))
|
|
(10 5 (5 1)))
|
|
'split-before (to-list t1))
|
|
(test '((0 5 (5 2))
|
|
(5 4 (4 2))
|
|
(9 3 (3 2))
|
|
(12 2 (2 2))
|
|
(14 1 (1 2)))
|
|
'split-before (to-list t2)))
|
|
|
|
(send t reset-tree)
|
|
(insert-last! t (new token-tree% (length 1) (data 1)))
|
|
(insert-last! t (new token-tree% (length 1) (data 2)))
|
|
(insert-last! t (new token-tree% (length 1) (data 3)))
|
|
(test '((0 1 1) (1 1 2) (2 1 3)) 'insert-last (to-list t))
|
|
(let-values (((s e t1 t2) (send t split 2)))
|
|
(test 1 'split s)
|
|
(test 3 'split e)
|
|
(test '((0 1 1)) 'split (to-list t1))
|
|
(test '() 'split (to-list t2)))
|
|
|
|
(report-errs)
|