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

can use keywords with test

Browse Source 
svn: r9372
This commit is contained in:
Eli Barzilay 2008-04-19 14:16:50 +00:00
parent 4fea43c61f
commit 352036ea42
1 changed files with 21 additions and 22 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

29
collects/tests/mzscheme/list.ss
View File

@ -97,15 +97,14 @@
(let () (let ()
(define l '((0) (9) (1) (8) (2) (7) (3) (6) (4) (5))) (define l '((0) (9) (1) (8) (2) (7) (3) (6) (4) (5)))
(define sorted '((0) (1) (2) (3) (4) (5) (6) (7) (8) (9))) (define sorted '((0) (1) (2) (3) (4) (5) (6) (7) (8) (9)))
;; can't use keyword args, so use values and the sort call (test sorted sort l < #:key car)
(test sorted values (sort l < #:key car))
(let ([c1 0] [c2 0] [touched '()]) (let ([c1 0] [c2 0] [touched '()])
(test sorted values (test sorted
(sort l (lambda (x y) (set! c1 (add1 c1)) (< x y)) sort l (lambda (x y) (set! c1 (add1 c1)) (< x y))
#:key (lambda (x) #:key (lambda (x)
(set! c2 (add1 c2)) (set! c2 (add1 c2))
(set! touched (cons x touched)) (set! touched (cons x touched))
(car x)))) (car x)))
;; test that the number of key uses is half the number of comparisons ;; test that the number of key uses is half the number of comparisons
(test #t = (* 2 c1) c2) (test #t = (* 2 c1) c2)
;; and that this is larger than the number of items in the list ;; and that this is larger than the number of items in the list
@ -114,32 +113,32 @@
(test null remove* touched l)) (test null remove* touched l))
(let ([c 0] [touched '()]) (let ([c 0] [touched '()])
;; now cache the keys ;; now cache the keys
(test sorted values (test sorted
(sort l < sort l <
#:key (lambda (x) #:key (lambda (x)
(set! c (add1 c)) (set! c (add1 c))
(set! touched (cons x touched)) (set! touched (cons x touched))
(car x)) (car x))
#:cache-keys? #t)) #:cache-keys? #t)
;; test that the number of key uses is the same as the list length ;; test that the number of key uses is the same as the list length
(test #t = c (length l)) (test #t = c (length l))
;; and that every item was touched ;; and that every item was touched
(test null remove* touched l)) (test null remove* touched l))
(let* ([c 0] [getkey (lambda (x) (set! c (add1 c)) x)]) (let* ([c 0] [getkey (lambda (x) (set! c (add1 c)) x)])
;; either way, we never use the key proc on no arguments ;; either way, we never use the key proc on no arguments
(test '() values (sort '() < #:key getkey #:cache-keys? #f)) (test '() sort '() < #:key getkey #:cache-keys? #f)
(test '() values (sort '() < #:key getkey #:cache-keys? #t)) (test '() sort '() < #:key getkey #:cache-keys? #t)
(test #t = c 0) (test #t = c 0)
;; we also don't use it for 1-arg lists ;; we also don't use it for 1-arg lists
(test '(1) values (sort '(1) < #:key getkey #:cache-keys? #f)) (test '(1) sort '(1) < #:key getkey #:cache-keys? #f)
(test #t = c 0) (test #t = c 0)
;; but we do use it once if caching happens (it's a consistent interface) ;; but we do use it once if caching happens (it's a consistent interface)
(test '(1) values (sort '(1) < #:key getkey #:cache-keys? #t)) (test '(1) sort '(1) < #:key getkey #:cache-keys? #t)
(test #t = c 1) (test #t = c 1)
;; check a few other short lists ;; check a few other short lists
(test '(1 2) values (sort '(2 1) < #:key getkey #:cache-keys? #t)) (test '(1 2) sort '(2 1) < #:key getkey #:cache-keys? #t)
(test '(1 2 3) values (sort '(2 3 1) < #:key getkey #:cache-keys? #t)) (test '(1 2 3) sort '(2 3 1) < #:key getkey #:cache-keys? #t)
(test '(1 2 3 4) values (sort '(4 2 3 1) < #:key getkey #:cache-keys? #t)) (test '(1 2 3 4) sort '(4 2 3 1) < #:key getkey #:cache-keys? #t)
(test #t = c 10))) (test #t = c 10)))
;; ---------- take/drop ---------- ;; ---------- take/drop ----------