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

Make sequence/c first-order check more specific

Browse Source 
closes PR 14983
This commit is contained in:
Alexis King 2015-03-05 07:34:41 -06:00 committed by Robby Findler
parent ab68a4dc38
commit 30610babe3
2 changed files with 30 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

26
pkgs/racket-test/tests/racket/contract/first-order.rkt
View File

@ -6,7 +6,8 @@
(make-basic-contract-namespace
'racket/contract
'racket/promise
'racket/class)])
'racket/class
'racket/sequence)])
(contract-eval '(define-contract-struct couple (hd tl)))
@ -203,4 +204,25 @@
(ctest #t contract-first-order-passes?
(class/c [m (-> any/c integer? integer?)])
(class* object% ((interface () [m (-> any/c integer? integer?)]))
(define/public (m x) x))))
(define/public (m x) x)))
(ctest #t contract-first-order-passes?
(sequence/c any/c)
(list 1 2 3))
(ctest #t contract-first-order-passes?
(sequence/c any/c)
(vector 1 2 3))
(ctest #f contract-first-order-passes?
(sequence/c any/c)
(hash 'x 1 'y 2))
(ctest #f contract-first-order-passes?
(sequence/c any/c any/c)
(list 1 2 3))
(ctest #f contract-first-order-passes?
(sequence/c any/c any/c)
(vector 1 2 3))
(ctest #t contract-first-order-passes?
(sequence/c any/c any/c)
(hash 'x 1 'y 2))
)

7
racket/collects/racket/sequence.rkt
View File

@ -183,7 +183,12 @@
(list '#:min-count min-count)
'())
ctcs))
#:first-order sequence?
#:first-order
(λ (val)
(and (sequence? val)
(if (vector? val) (= n-cs 1) #t)
(if (list? val) (= n-cs 1) #t)
(if (hash? val) (= n-cs 2) #t)))
#:projection
(λ (orig-blame)
(define blame (blame-add-context orig-blame "an element of"))