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

fix struct/dc chaperone/flat/impersonator-ness when #:inv is used

Browse Source
This commit is contained in:
Robby Findler 2014-05-05 11:07:37 -05:00
parent 31e02a5da2
commit 1f212a2fe4
2 changed files with 12 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
pkgs/racket-pkgs/racket-test/tests/racket/contract/predicates.rkt
View File

@ -215,6 +215,11 @@
(ctest #t flat-contract? (let ()
(struct s (a b))
(struct/dc s [a integer?] [b (a) #:flat (>=/c a)])))
(ctest #t chaperone-contract?
(let ()
(struct s (x))
(struct/dc s [x () any/c] #:inv (x) #t)))
(contract-error-test
'struct/dc-not-really-flat-dep-field
#'(let ()

10
racket/collects/racket/contract/private/struct-dc.rkt
View File

@ -81,7 +81,7 @@
;; the order specified in the contract itself)
;; muts : (listof mutator) -- the field mutators for mutable fields
;; on which the invariant depends
(struct invariant (dep-proc fields sels muts))
(struct invariant (dep-proc fields sels muts) #:transparent)
(define (subcontract-mutable-field? x)
(or (mutable? x)
@ -672,12 +672,16 @@
(define (flat-subcontract? subcontract)
(cond
[(indep? subcontract) (flat-contract? (indep-ctc subcontract))]
[(dep? subcontract) (eq? '#:flat (dep-type subcontract))]))
[(dep? subcontract) (equal? '#:flat (dep-type subcontract))]
[(invariant? subcontract) #t]
[else (error 'struct-dc.rkt "internal error")]))
(define (impersonator-subcontract? subcontract)
(cond
[(indep? subcontract) (impersonator-contract? (indep-ctc subcontract))]
[(dep? subcontract) (eq? '#:impersonator (dep-type subcontract))]))
[(dep? subcontract) (equal? '#:impersonator (dep-type subcontract))]
[(invariant? subcontract) #f]
[else (error 'struct-dc.rkt "internal error")]))
(cond
[(and (andmap flat-subcontract? subcontracts)
(not (ormap subcontract-mutable-field? subcontracts)))