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

Add error checking to check-duplicate.

Browse Source 
To replace its original contract, and avoid introducing a dependecy to contracts.
This commit is contained in:
Vincent St-Amour 2015-07-16 13:20:53 -05:00
parent 4d9751e98c
commit 6b9fc4551d
2 changed files with 13 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
pkgs/racket-test-core/tests/racket/list.rktl
View File

@ -336,6 +336,9 @@
(test 'a check-duplicate '(a a b))
(test '(a 3) check-duplicate '((a 1) (b 2) (a 3)) #:key car)
(test 4 check-duplicate '(1 2 3 4 5 6) (lambda (x y) (equal? (modulo x 3) (modulo y 3))))
(err/rt-test (check-duplicate 'a))
(err/rt-test (check-duplicate '(1) #f))
(err/rt-test (check-duplicate '(1) #:key #f))
;; ---------- remove-duplicates ----------
(let ()

10
racket/collects/racket/list.rkt
View File

@ -355,6 +355,11 @@
(define (check-duplicate items
[same? equal?]
#:key [key values])
(unless (list? items)
(raise-argument-error 'check-duplicate "list?" items))
(unless (and (procedure? key)
(procedure-arity-includes? key 1))
(raise-argument-error 'check-duplicate "(-> any/c any/c)" key))
(cond [(eq? same? equal?)
(check-duplicate/t items key (make-hash))]
[(eq? same? eq?)
@ -362,6 +367,11 @@
[(eq? same? eqv?)
(check-duplicate/t items key (make-hasheqv))]
[else
(unless (and (procedure? same?)
(procedure-arity-includes? same? 2))
(raise-argument-error 'check-duplicate
"(any/c any/c . -> . any/c)"
same?))
(check-duplicate/list items key same?)]))
(define (check-duplicate/t items key table)
(let loop ([items items])