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

fix *list/c so that it returns a flat contract when given flat contracts and a chaperone contract when given chaperone contracts

Browse Source
This commit is contained in:
Robby Findler 2021-04-09 22:17:38 -05:00
parent 16bc937e7f
commit 1244396d01
3 changed files with 10 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
pkgs/racket-test/tests/racket/contract/flat-contracts.rkt
View File

@ -168,6 +168,7 @@
(test-flat-contract '(listof boolean?) (list #t #f) (list #f 3 #t)) (test-flat-contract '(listof boolean?) (list #t #f) (list #f 3 #t))
(test-flat-contract '(listof any/c) (list #t #f) 3) (test-flat-contract '(listof any/c) (list #t #f) 3)
(test-flat-contract '(*list/c boolean? integer?) (list #t #f 1) (list #t #f))
(test-flat-contract '(vectorof boolean? #:flat? #t) (vector #t #f) (vector #f 3 #t)) (test-flat-contract '(vectorof boolean? #:flat? #t) (vector #t #f) (vector #f 3 #t))
(test-flat-contract '(vectorof any/c #:flat? #t) (vector #t #f) 3) (test-flat-contract '(vectorof any/c #:flat? #t) (vector #t #f) 3)

6
pkgs/racket-test/tests/racket/contract/list.rkt
View File

@ -205,5 +205,9 @@
'((caddr (contract (*list/c (-> integer? integer?) (-> boolean? boolean?) (-> char? char?)) '((caddr (contract (*list/c (-> integer? integer?) (-> boolean? boolean?) (-> char? char?))
(list (λ (x) x) (λ (y) y) (λ (y) 'not-a-bool) (λ (y) y)) 'pos 'neg)) (list (λ (x) x) (λ (y) y) (λ (y) 'not-a-bool) (λ (y) y)) 'pos 'neg))
#f)) #f))
(test/spec-passed/result
'*list/c8
'(chaperone-contract? (*list/c (-> integer? integer?) boolean?))
#t)
) )

8
racket/collects/racket/contract/private/list.rkt
View File

@ -1025,8 +1025,8 @@
#:property prop:custom-write custom-write-property-proc) #:property prop:custom-write custom-write-property-proc)
(struct flat-*list/c *list-ctc () (struct flat-*list/c *list-ctc ()
#:property prop:contract #:property prop:flat-contract
(build-contract-property (build-flat-contract-property
#:trusted trust-me #:trusted trust-me
#:name *list/c-name-proc #:name *list/c-name-proc
#:first-order *list/c-first-order #:first-order *list/c-first-order
@ -1037,8 +1037,8 @@
#:late-neg-projection (λ (ctc) (*list/c-late-neg-projection ctc #f #t)) #:late-neg-projection (λ (ctc) (*list/c-late-neg-projection ctc #f #t))
#:list-contract? (λ (c) #t))) #:list-contract? (λ (c) #t)))
(struct chaperone-*list/c *list-ctc () (struct chaperone-*list/c *list-ctc ()
#:property prop:contract #:property prop:chaperone-contract
(build-contract-property (build-chaperone-contract-property
#:trusted trust-me #:trusted trust-me
#:name *list/c-name-proc #:name *list/c-name-proc
#:first-order *list/c-first-order #:first-order *list/c-first-order