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

Fix bug in struct-wrap signature checking.

Browse Source 
Only check the fields if we know the struct type is right.
This commit is contained in:
Mike Sperber 2011-01-06 13:53:51 +01:00
parent 7cac1f6ac2
commit 69963a1f2c
1 changed files with 23 additions and 23 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

46
collects/deinprogramm/signature/signature-unit.rkt
View File

@ -484,32 +484,32 @@
(make-signature (make-signature
name name
(lambda (self thing) (lambda (self thing)
(if (not (predicate thing)) (if (not (predicate thing))
(signature-violation thing self #f #f) (signature-violation thing self #f #f)
(let ((log (wrap-ref thing))) (begin
(cond (let ((log (wrap-ref thing)))
((not log) (cond
(wrap-set! thing ((not log)
(make-lazy-wrap-log (list not-checked) '()))) (wrap-set! thing
((not (let () (make-lazy-wrap-log (list not-checked) '())))
(define (<=? sigs1 sigs2) ((not (let ()
(andmap signature<=? sigs1 sigs2)) (define (<=? sigs1 sigs2)
(define (check wrap-field-signatures) (andmap signature<=? sigs1 sigs2))
(ormap (lambda (field-signatures) (define (check wrap-field-signatures)
(<=? wrap-field-signatures field-signatures)) (ormap (lambda (field-signatures)
field-signatures-list)) (<=? wrap-field-signatures field-signatures))
(or (ormap (lambda (wrap-not-checked) field-signatures-list))
(andmap check (or (ormap (lambda (wrap-not-checked)
(lazy-log-not-checked-field-signatures-list wrap-not-checked))) (andmap check
(lazy-wrap-log-not-checked log)) (lazy-log-not-checked-field-signatures-list wrap-not-checked)))
(ormap check (lazy-wrap-log-checked log))))) (lazy-wrap-log-not-checked log))
(wrap-set! thing (ormap check (lazy-wrap-log-checked log)))))
(make-lazy-wrap-log (cons not-checked (lazy-wrap-log-not-checked log)) (wrap-set! thing
(lazy-wrap-log-checked log))))))) (make-lazy-wrap-log (cons not-checked (lazy-wrap-log-not-checked log))
(lazy-wrap-log-checked log))))))
(when eager-checking? (when eager-checking?
(check-lazy-wraps! type-descriptor thing)) (check-lazy-wraps! type-descriptor thing))))
thing) thing)
(delay syntax) (delay syntax)