suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

move commented-out tests to `test' submodule

Browse Source 
original commit: c747af21e3
This commit is contained in:
Matthew Flatt 2012-07-13 12:27:32 -06:00
parent 45ee870f98
commit bf4ad3fdb6
1 changed files with 90 additions and 92 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

182
collects/net/private/rbtree.rkt
View File

@ -273,108 +273,106 @@
(loop (tree-right t) (+ d (kv (tree-v t))))) (loop (tree-right t) (+ d (kv (tree-v t)))))
null))) null)))
#|
Tests: (module+ test
(require racket/pretty)
(print-struct #t)
(require rbtree racket/pretty) (define t (new-tree))
(print-struct #t)
(define t (new-tree)) (define (test n v)
(define (test n v) (expunge-insert! t n)
(expunge-insert! t n) (unless (equal? (expunge-tree->list t) v)
(unless (equal? (expunge-tree->list t) v) (error 'bad "~s != ~s" (expunge-tree->list t) v)))
(error 'bad "~s != ~s" (tree->list t) v)))
(test 12 '(12)) (test 12 '(12))
(test 8 '(8 12)) (test 8 '(8 12))
(test 1 '(1 8 12)) (test 1 '(1 8 12))
(define t (new-tree)) (set! t (new-tree))
(test 10 '(10)) (test 10 '(10))
(test 8 '(8 10)) (test 8 '(8 10))
(test 10 '(8 10 12)) (test 10 '(8 10 12))
(test 8 '(8 9 10 12)) (test 8 '(8 9 10 12))
(test 8 '(8 9 10 11 12)) (test 8 '(8 9 10 11 12))
(test 100 '(8 9 10 11 12 105)) (test 100 '(8 9 10 11 12 105))
(test 1 '(1 8 9 10 11 12 105)) (test 1 '(1 8 9 10 11 12 105))
(test 105 '(1 8 9 10 11 12 105 112)) (test 105 '(1 8 9 10 11 12 105 112))
(test 99 '(1 8 9 10 11 12 105 106 112)) (test 99 '(1 8 9 10 11 12 105 106 112))
(test 2 '(1 3 8 9 10 11 12 105 106 112)) (test 2 '(1 3 8 9 10 11 12 105 106 112))
(test 6 '(1 3 8 9 10 11 12 13 105 106 112)) (test 6 '(1 3 8 9 10 11 12 13 105 106 112))
(test 5 '(1 3 7 8 9 10 11 12 13 105 106 112)) (test 5 '(1 3 7 8 9 10 11 12 13 105 106 112))
(test 15 '(1 3 7 8 9 10 11 12 13 24 105 106 112)) (test 15 '(1 3 7 8 9 10 11 12 13 24 105 106 112))
(test 15 '(1 3 7 8 9 10 11 12 13 24 25 105 106 112)) (test 15 '(1 3 7 8 9 10 11 12 13 24 25 105 106 112))
(test 15 '(1 3 7 8 9 10 11 12 13 24 25 26 105 106 112)) (test 15 '(1 3 7 8 9 10 11 12 13 24 25 26 105 106 112))
(define t (new-tree)) (set! t (new-tree))
(define (test n v)
(cond
[(< n 0) (fetch-delete! t (- n))]
[(inexact? n) (fetch-shift! t (inexact->exact n))]
[else (fetch-insert! t (list n))])
(printf "Check ~a\n" v)
(let ([v (map list v)])
(unless (equal? (fetch-tree->list t) v)
(error 'bad "~s != ~s" (fetch-tree->list t) v))))
(test 10 '(10)) (define (test2 n v)
(test 12 '(10 12)) (cond
(test 8 '(8 10 12)) [(< n 0) (fetch-delete! t (- n))]
(test 10 '(8 10 12)) [(inexact? n) (fetch-shift! t (inexact->exact n))]
(test -10 '(8 12)) [else (fetch-insert! t (list n))])
(test -10 '(8 12)) ;; (printf "Check ~a\n" v)
(test 10.0 '(8 11)) (let ([v (map list v)])
(test 100.0 '(8 11)) (unless (equal? (fetch-tree->list t) v)
(test 5.0 '(7 10)) (error 'bad "~s != ~s" (fetch-tree->list t) v))))
(test 1 '(1 7 10))
(test 2 '(1 2 7 10))
(test 3 '(1 2 3 7 10))
(test 4 '(1 2 3 4 7 10))
(test 5 '(1 2 3 4 5 7 10))
(test 6 '(1 2 3 4 5 6 7 10))
(test -6 '(1 2 3 4 5 7 10))
(test -5 '(1 2 3 4 7 10))
(test -4 '(1 2 3 7 10))
(test -3 '(1 2 7 10))
(test -2 '(1 7 10))
(test -7 '(1 10))
(test -1 '(10))
(test -10 '())
(define (in-all-positions n l) (test2 10 '(10))
(if (null? l) (test2 12 '(10 12))
(list (list n)) (test2 8 '(8 10 12))
(cons (test2 10 '(8 10 12))
(cons n l) (test2 -10 '(8 12))
(map (lambda (r) (cons (car l) r)) (test2 -10 '(8 12))
(in-all-positions n (cdr l)))))) (test2 10.0 '(8 11))
(test2 100.0 '(8 11))
(test2 5.0 '(7 10))
(test2 1 '(1 7 10))
(test2 2 '(1 2 7 10))
(test2 3 '(1 2 3 7 10))
(test2 4 '(1 2 3 4 7 10))
(test2 5 '(1 2 3 4 5 7 10))
(test2 6 '(1 2 3 4 5 6 7 10))
(test2 -6 '(1 2 3 4 5 7 10))
(test2 -5 '(1 2 3 4 7 10))
(test2 -4 '(1 2 3 7 10))
(test2 -3 '(1 2 7 10))
(test2 -2 '(1 7 10))
(test2 -7 '(1 10))
(test2 -1 '(10))
(test2 -10 '())
(define (permutations l) (define (in-all-positions n l)
(if (or (null? l) (if (null? l)
(null? (cdr l))) (list (list n))
(list l) (cons
(apply (cons n l)
append (map (lambda (r) (cons (car l) r))
(map (lambda (lol) (in-all-positions n (cdr l))))))
(in-all-positions (car l) lol))
(permutations (cdr l))))))
(define perms (permutations '(1 2 3 4 5 6 7 8))) (define (permutations l)
(if (or (null? l)
(null? (cdr l)))
(list l)
(apply
append
(map (lambda (lol)
(in-all-positions (car l) lol))
(permutations (cdr l))))))
(for-each (lambda (l) (define perms (permutations '(1 2 3 4 5 6 7 8)))
(let ([t (new-tree)])
(for-each (lambda (i)
(fetch-insert! t (list i)))
l)
(unless (equal? (fetch-tree->list t) '((1) (2) (3) (4) (5) (6) (7) (8)))
(error 'perms "bad: ~a" l))
(for-each (lambda (i)
(fetch-delete! t i))
l)
(unless (equal? (fetch-tree->list t) '())
(error 'perms "remove bad: ~a" l))))
perms)
|# (for-each (lambda (l)
(let ([t (new-tree)])
(for-each (lambda (i)
(fetch-insert! t (list i)))
l)
(unless (equal? (fetch-tree->list t) '((1) (2) (3) (4) (5) (6) (7) (8)))
(error 'perms "bad: ~a" l))
(for-each (lambda (i)
(fetch-delete! t i))
l)
(unless (equal? (fetch-tree->list t) '())
(error 'perms "remove bad: ~a" l))))
perms))