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

Fix bug in hash-table key-value match pattern (#1532)

Browse Source 
Match pattern allowed `(hash-table)' to match on non-empty hashes
This commit is contained in:
Justin Slepak 2017-10-12 01:11:00 -04:00 committed by Ben Greenman
parent 0130662581
commit 3935824922
4 changed files with 31 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
pkgs/racket-test/tests/match/examples.rkt
View File

@ -357,6 +357,15 @@
[(hash-table (key val) ...) key]
[_ 'no])))
(comp "non-empty"
(match #hash((1 . 2))
[(hash-table) "empty"]
[_ "non-empty"]))
(comp "empty"
(match #hash()
[(hash-table) "empty"]
[_ "non-empty"]))
(comp
(match #(1 (2) (2) (2) 5)
[(vector 1 (list a) ..3 5) a]

5
pkgs/racket-test/tests/match/match-tests.rkt
View File

@ -40,6 +40,11 @@
(else #f)))
(check-true (origin? (make-point 0 0)))
(check-false (origin? (make-point 1 1)))))
(test-case "empty hash-table pattern bug"
(check string=? "non-empty"
(match #hash((1 . 2))
[(hash-table) "empty"]
[_ "non-empty"])))
))
(define nonlinear-tests

8
pkgs/racket-test/tests/match/other-plt-tests.rkt
View File

@ -320,6 +320,14 @@
(mytest (match (hash-table)
((hash-table) 5))
5)
(mytest (match #hash((1 . 2))
[(hash-table) "empty"]
[_ "non-empty"])
"non-empty")
(mytest (match #hash()
[(hash-table) "empty"]
[_ "non-empty"])
"empty")
; These cases work but I need a better way of testing them.
; (mytest (match (hash-table ('a "hey") ('b "sup") ('c "sup") ('d "sup") ('e "down") ('f "dat"))

16
racket/collects/racket/match/parse.rkt
View File

@ -95,13 +95,15 @@
(raise-syntax-error
'match "dot dot k can only appear at the end of hash-table patterns" stx
(ormap (lambda (e) (and (ddk? e) e)) (syntax->list #'(p ...))))]
[(hash-table (k v) ...)
(andmap (λ (p) (and (literal-pat? p) (not (identifier? p)))) (syntax->list #'(k ...)))
(let ([keys (map Exact-v (map literal-pat? (syntax->list #'(k ...))))])
(trans-match*
(cons #'hash? (for/list ([k (in-list keys)]) (λ (e) #`(hash-has-key? #,e '#,k))))
(for/list ([k (in-list keys)]) (λ (e) #`(hash-ref #,e '#,k)))
(map parse (syntax->list #'(v ...)))))]
[(hash-table (k0 v0) (k1 v1) ...)
(andmap (λ (p) (and (literal-pat? p) (not (identifier? p)))) (syntax->list #'(k0 k1 ...)))
(with-syntax ([(k ...) #'(k0 k1 ...)]
[(v ...) #'(v0 v1 ...)])
(let ([keys (map Exact-v (map literal-pat? (syntax->list #'(k ...))))])
(trans-match*
(cons #'hash? (for/list ([k (in-list keys)]) (λ (e) #`(hash-has-key? #,e '#,k))))
(for/list ([k (in-list keys)]) (λ (e) #`(hash-ref #,e '#,k)))
(map parse (syntax->list #'(v ...))))))]
[(hash-table p ...)
(trans-match #'hash?
#'(lambda (e) (hash-map e list))