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

(define t (new paren-tree% (matches '((|(| |)|)
                                      (|[| |]|)))))


(Section 'add-token)
(send t add-token #f 12)
(test '(((0 12 (#f . 0))) ())
      'add-token
      (send t test))
(send t add-token #f 1)
(test '(((0 13 (#f . 0))) ())
      'add-token
      (send t test))
(send t add-token '|)| 3)
(test '(((0 13 (#f . 0))
         (13 3 (|)| . 3)))
        ())
      'add-token
      (send t test))
(send t add-token #f 3)
(test '(((0 13 (#f . 0))
         (13 6 (|)| . 3)))
        ())
      'add-token
      (send t test))

(Section 'split-tree)
(define (build-tree)
  (set! t (new paren-tree% (matches '((|(| |)|) (|[| |]|)))))
  (send t add-token #f 2)
  (send t add-token #f 2)
  (send t add-token '|(| 2)
  (send t add-token #f 2)
  (send t add-token '|(| 2)
  (send t add-token '|(| 2)
  (send t add-token #f 2)
  (send t add-token #f 2))
(build-tree)
(test '(((0 4 (#f . 0))
         (4 4 (|(| . 2))
         (8 2 (|(| . 2))
         (10 6 (|(| . 2)))
        ())
      'add-token
      (send t test))
(define (split-test pos res)
  (send t split-tree pos)
  (test res 'split-tree (send t test)))
(split-test 16 '(((0 4 (#f . 0))
                  (4 4 (|(| . 2))
                  (8 2 (|(| . 2))
                  (10 6 (|(| . 2)))
                 ((0 0 (#f . 0)))))
(split-test 14 '(((0 4 (#f . 0))
                  (4 4 (|(| . 2))
                  (8 2 (|(| . 2))
                  (10 4 (|(| . 2)))
                 ((0 2 (#f . 0)))))
(split-test 12 '(((0 4 (#f . 0))
                  (4 4 (|(| . 2))
                  (8 2 (|(| . 2))
                  (10 2 (|(| . 2)))
                 ((0 2 (#f . 0)))))
(split-test 10 '(((0 4 (#f . 0))
                  (4 4 (|(| . 2))
                  (8 2 (|(| . 2)))
                 ((0 2 (|(| . 2)))))
(split-test 8 '(((0 4 (#f . 0))
                  (4 4 (|(| . 2)))
                 ((0 2 (|(| . 2)))))
(split-test 6 '(((0 4 (#f . 0))
                 (4 2 (|(| . 2)))
                ((0 2 (#f . 0)))))
(split-test 4 '(((0 4 (#f . 0)))
                ((0 2 (|(| . 2)))))
(split-test 2 '(((0 2 (#f . 0)))
                ((0 2 (#f . 0)))))
(split-test 0 '(()
                ((0 2 (#f . 0)))))
(build-tree)
(split-test 6 '(((0 4 (#f . 0))
                 (4 2 (|(| . 2)))
                ((0 2 (#f . 0))
                 (2 2 (|(| . 2))
                 (4 6 (|(| . 2)))))

(set! t (new paren-tree% (matches '((|(| |)|) (|[| |]|)))))
(split-test 0 '(()()))

(Section 'merge-tree)
(build-tree)
(send t split-tree 6)
(send t merge-tree 10)
(test '(((0 4 (#f . 0))
         (4 4 (|(| . 2))
         (8 2 (|(| . 2))
         (10 6 (|(| . 2)))
        ())
      'merge-tree
      (send t test))
(send t split-tree 6)
(send t merge-tree 0)
(test '(((0 4 (#f . 0))
         (4 2 (|(| . 2)))
        ())
      'merge-tree
      (send t test))
(send t split-tree 6)
(send t merge-tree 0)
(test '(((0 4 (#f . 0))
         (4 2 (|(| . 2)))
        ())
      'merge-tree
      (send t test))

(Section 'truncate)
(build-tree)
(send t truncate 0)
(test '(()())
      'truncate
      (send t test))
(build-tree)
(send t truncate 6)
(test '(((0 4 (#f . 0))
         (4 2 (|(| . 2)))
        ())
      'truncate
      (send t test))

(define (build-tree)
  (set! t (new paren-tree% (matches '((|(| |)|) (|[| |]|)))))
  (send t add-token '|(| 2)
  (send t add-token '|[| 2)
  (send t add-token '|]| 2)
  (send t add-token #f 2)
  (send t add-token '|[| 2)
  (send t add-token #f 2)
  (send t add-token '|]| 2)
  (send t add-token '|)| 2))
(build-tree)
(test '(((0 2 (|(| . 2))
         (2 2 (|[| . 2))
         (4 4 (|]| . 2))
         (8 4 (|[| . 2))
         (12 2 (|]| . 2))
         (14 2 (|)| . 2)))
        ())
      'add-token
      (send t test))

(Section 'is-open-pos?)
(build-tree)
(test '|)| 'is-open-pos? (send t is-open-pos? 0))
(test '|]| 'is-open-pos? (send t is-open-pos? 2))
(test #f 'is-open-pos? (send t is-open-pos? 4))
(test #f 'is-open-pos? (send t is-open-pos? 6))
(test '|]| 'is-open-pos? (send t is-open-pos? 8))
(test #f 'is-open-pos? (send t is-open-pos? 10))
(test #f 'is-open-pos? (send t is-open-pos? 12))
(test #f 'is-open-pos? (send t is-open-pos? 14))
(test #f 'is-open-pos? (send t is-open-pos? 16))

(Section 'is-close-pos?)
(test #f 'is-close-pos? (send t is-close-pos? 0))
(test #f 'is-close-pos? (send t is-close-pos? 2))
(test '|[| 'is-close-pos? (send t is-close-pos? 4))
(test #f 'is-close-pos? (send t is-close-pos? 6))
(test #f 'is-close-pos? (send t is-close-pos? 8))
(test #f 'is-close-pos? (send t is-close-pos? 10))
(test '|[| 'is-close-pos? (send t is-close-pos? 12))
(test '|(| 'is-close-pos? (send t is-close-pos? 14))
(test #f 'is-close-pos? (send t is-close-pos? 16))

(Section 'match)
(define (test-match-forward num res)
  (let-values (((a b c) (send t match-forward num)))
    (test res 'match-forward (list a b c))))
(define (test-match-backward num res)
  (let-values (((a b c) (send t match-backward num)))
    (test res 'match-backward (list a b c))))
(test-match-forward 0 '(0 16 #f))
(test-match-forward 2 '(2 6 #f))
(test-match-forward 4 '(#f #f #f))
(test-match-forward 6 '(#f #f #f))
(test-match-forward 8 '(8 14 #f))
(test-match-forward 10 '(#f #f #f))
(test-match-forward 12 '(#f #f #f))
(test-match-forward 14 '(#f #f #f))
(test-match-forward 16 '(#f #f #f))

(test-match-backward 0 '(#f #f #f))
(test-match-backward 2 '(#f #f #f))
(test-match-backward 4 '(#f #f #f))
(test-match-backward 6 '(2 6 #f))
(test-match-backward 8 '(#f #f #f))
(test-match-backward 10 '(#f #f #f))
(test-match-backward 12 '(#f #f #f))
(test-match-backward 14 '(8 14 #f))
(test-match-backward 16 '(0 16 #f))

(define (build-tree)
  (set! t (new paren-tree% (matches '((|(| |)|) (|[| |]|)))))
  (send t add-token '|(| 2)
  (send t add-token '|[| 2)
  (send t add-token '|)| 2)
  (send t add-token #f 2)
  (send t add-token '|[| 2)
  (send t add-token #f 2)
  (send t add-token '|]| 2)
  (send t add-token '|)| 2))
(build-tree)
(test-match-forward 0 '(0 2 16))
(test-match-backward 14 '(8 14 #f))
(test-match-backward 16 '(14 16 #t))
(test-match-backward 100 '(#f #f #f))

(set! t (new paren-tree% (matches '((|(| |)|) (|[| |]|)))))
(send t add-token '|(| 2)
(test-match-forward 0 '(0 2 2))

(set! t (new paren-tree% (matches '((|(| |)|) (|[| |]|)))))
(send t add-token '|)| 2)
(test-match-backward 2 '(0 2 #t))


(report-errs)



;match-forward
;match-backward