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

fix bug in flat struct/dc predicate implementation

Browse Source
This commit is contained in:
Robby Findler 2014-05-13 20:15:48 -05:00
parent efefe300f5
commit cfd1f46fa2
2 changed files with 32 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -1088,6 +1088,30 @@
((struct/dc s [f any/c] #:inv (f) (equal? f 11)) (s 11)))
#t)
(test/spec-passed/result
'struct/dc-inv8
'(let ()
(struct node (v l r))
((struct/dc node
[v any/c]
[l any/c]
[r any/c]
#:inv (l r) #f)
(node #f #f #f)))
#f)
(test/spec-passed/result
'struct/dc-inv9
'(let ()
(struct node (v l r))
((struct/dc node
[v any/c]
[l any/c]
[r any/c]
#:inv (l r) #t)
(node #f #f #f)))
#t)
(contract-error-test
'struct/dc-imp-nondep-runtime-error
'(let ()

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

@ -179,16 +179,21 @@
(define subc (car subcs))
(cond
[(invariant? subc)
(apply (invariant-dep-proc subc) args)]
(and (apply (invariant-dep-proc subc) args)
(loop (cdr subcs) args))]
[else
(define val ((subcontract-ref subc) v))
(define next-args
(if (subcontract-depended-on? subc)
(cons val args)
args))
(cond
[(indep? subc)
(and ((flat-contract-predicate (indep-ctc subc)) val)
(loop (cdr subcs) (cons val args)))]
(loop (cdr subcs) next-args))]
[else
(and ((flat-contract-predicate (apply (dep-dep-proc subc) args)) val)
(loop (cdr subcs) (cons val args)))])])])))))
(loop (cdr subcs) next-args))])])])))))
(define (struct/dc-first-order ctc)
(base-struct/dc-pred ctc))