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

fix struct/dc's flat-contract mode predicate

Browse Source
This commit is contained in:
Robby Findler 2014-05-12 10:04:13 -05:00
parent a1fd690201
commit 8b0e23d15a
2 changed files with 25 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
pkgs/racket-pkgs/racket-test/tests/racket/contract/struct-dc.rkt
View File

@ -1074,6 +1074,20 @@
'pos
'neg)))
(test/spec-passed/result
'struct/dc-inv6
'(let ()
(struct s (f))
((struct/dc s [f any/c] #:inv (f) (equal? f 11)) (s 12)))
#f)
(test/spec-passed/result
'struct/dc-inv7
'(let ()
(struct s (f))
((struct/dc s [f any/c] #:inv (f) (equal? f 11)) (s 11)))
#t)
(contract-error-test
'struct/dc-imp-nondep-runtime-error
'(let ()

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

@ -176,15 +176,19 @@
(cond
[(null? subcs) #t]
[else
(define subc (car subcs))
(define val ((subcontract-ref subc) v))
(define subc (car subcs))
(cond
[(indep? subc)
(and ((flat-contract-predicate (indep-ctc subc)) val)
(loop (cdr subcs) (cons val args)))]
[(invariant? subc)
(apply (invariant-dep-proc subc) args)]
[else
(and ((flat-contract-predicate (apply (dep-dep-proc subc) args)) val)
(loop (cdr subcs) (cons val args)))])])))))
(define val ((subcontract-ref subc) v))
(cond
[(indep? subc)
(and ((flat-contract-predicate (indep-ctc subc)) val)
(loop (cdr subcs) (cons val args)))]
[else
(and ((flat-contract-predicate (apply (dep-dep-proc subc) args)) val)
(loop (cdr subcs) (cons val args)))])])])))))
(define (struct/dc-first-order ctc)
(base-struct/dc-pred ctc))