suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
c7b51cfd2d
racket/collects/tests/syntax-color/paren-tree.ss
Eli Barzilay 7d50e61c7f * Newlines at EOFs 
* Another big chunk of v4-require-isms
* Allow `#lang framework/keybinding-lang' for keybinding files
* Move hierlist sources into "mrlib/hierlist", leave stub behind

svn: r10689
2008-07-09 07:18:06 +00:00

236 lines
6.3 KiB
Scheme
Raw Blame History

(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
Reference in New Issue View Git Blame Copy Permalink