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

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

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