fix struct/dc's flatness test so that contracts with lazy fields aren't flat

closes PR 14558
This commit is contained in:
Robby Findler 2014-06-14 04:01:37 -05:00
parent 8b6d3e9117
commit fd3aaf6f20
2 changed files with 11 additions and 0 deletions

View File

@ -75,6 +75,10 @@
(define-struct s (a) #:mutable)
(define alpha (new-∃/c 'alpha))
(struct/c s alpha)))
(ctest #f flat-contract? (let ()
(define-struct s (a))
(struct/dc s [a #:lazy any/c])))
(ctest #t chaperone-contract?
(let ()

View File

@ -736,6 +736,8 @@
[else (error 'struct-dc.rkt "internal error")]))
(cond
[(and (andmap flat-subcontract? subcontracts)
(not (ormap lazy-immutable? subcontracts))
(not (ormap dep-lazy-immutable? subcontracts))
(not (ormap subcontract-mutable-field? subcontracts)))
(make-flat-struct/dc subcontracts constructor pred struct-name here name-info struct/c?)]
[(ormap impersonator-subcontract? subcontracts)
@ -894,6 +896,11 @@
[(#:depends-on-state . more-stuff) (loop #'more-stuff lazy? type #t)]
[(#:lazy . more-stuff) (loop #'more-stuff #t type depends-on-state?)]
[_ (raise-syntax-error 'struct/dc "could not parse clause" stx clause)])))
(when (and lazy? (equal? '#:flat (syntax-e type)))
(raise-syntax-error 'struct/dc
"cannot have #:lazy on a flat contract field"
stx
type))
(dep-clause ctc-exp lazy?
#'sel-name (name->sel-id #'id #'sel-name)
(if type (syntax-e type) '#:chaperone)