(load-relative "../mzscheme/loadtest.ss")
(require (lib "class.ss")
         (lib "token-tree.ss" "syntax-color"))

(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)