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

improved error checking for provide/contract struct clauses

Browse Source 
svn: r6155
This commit is contained in:
Robby Findler 2007-05-05 17:50:19 +00:00
parent 53b5917fec
commit e41ff4705e
8 changed files with 51 additions and 21 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
collects/mrflow/assoc-set-hash.ss
View File

@ -21,11 +21,11 @@
(provide/contract
(exn:assoc-set? (any/c . -> . boolean?))
(struct (exn:assoc-set:key-not-found exn:assoc-set) ((message (and/c string? immutable?))
(continuation-mark-set continuation-mark-set?)
(continuation-marks continuation-mark-set?)
(assoc-set assoc-set?)
(key any/c)))
(struct (exn:assoc-set:duplicate-key exn:assoc-set) ((message (and/c string? immutable?))
(continuation-mark-set continuation-mark-set?)
(continuation-marks continuation-mark-set?)
(assoc-set assoc-set?)
(key any/c)))
(assoc-set-make (() ((symbols 'equal)) . opt-> . assoc-set?))

4
collects/mrflow/assoc-set-list.ss
View File

@ -23,11 +23,11 @@
(provide/contract
(exn:assoc-set? (any/c . -> . boolean?))
(struct (exn:assoc-set:key-not-found exn:assoc-set) ((message (and/c string? immutable?))
(continuation-mark-set continuation-mark-set?)
(continuation-marks continuation-mark-set?)
(assoc-set assoc-set?)
(key any/c)))
(struct (exn:assoc-set:duplicate-key exn:assoc-set) ((message (and/c string? immutable?))
(continuation-mark-set continuation-mark-set?)
(continuation-marks continuation-mark-set?)
(assoc-set assoc-set?)
(key any/c)))
(assoc-set-make (() ((symbols 'equal)) . opt-> . assoc-set?))

4
collects/mrflow/set-hash.ss
View File

@ -20,11 +20,11 @@
(provide/contract
(exn:set? (any/c . -> . boolean?))
(struct (exn:set:value-not-found exn:set) ((message (and/c string? immutable?))
(continuation-mark-set continuation-mark-set?)
(continuation-marks continuation-mark-set?)
(set set?)
(value any/c)))
(struct (exn:set:duplicate-value exn:set) ((message (and/c string? immutable?))
(continuation-mark-set continuation-mark-set?)
(continuation-marks continuation-mark-set?)
(set set?)
(value any/c)))
(set-make (() ((symbols 'equal)) . opt-> . set?))

4
collects/mrflow/set-list.ss
View File

@ -23,11 +23,11 @@
(provide/contract
(exn:set? (any/c . -> . boolean?))
(struct (exn:set:value-not-found exn:set) ((message (and/c string? immutable?))
(continuation-mark-set continuation-mark-set?)
(continuation-marks continuation-mark-set?)
(set set?)
(value any/c)))
(struct (exn:set:duplicate-value exn:set) ((message (and/c string? immutable?))
(continuation-mark-set continuation-mark-set?)
(continuation-marks continuation-mark-set?)
(set set?)
(value any/c)))
(set-make (() ((symbols 'equal)) . opt-> . set?))

19
collects/mzlib/private/contract.ss
View File

@ -331,22 +331,24 @@ improve method arity mismatch contract violation error messages?
(unless (andmap/count is-id-ok? selector-ids)
(unknown-info "selectors"
(map (λ (x) (if (syntax? x)
(syntax-object->datum x)
x))
selector-ids)))
(syntax-object->datum x)
x))
selector-ids)))
(unless (andmap/count is-id-ok? mutator-ids)
(unknown-info "mutators"
(map (λ (x) (if (syntax? x)
(syntax-object->datum x)
x))
(syntax-object->datum x)
x))
mutator-ids))))
(unless (equal? (length selector-ids)
(length field-contract-ids))
(raise-syntax-error 'provide/contract
(format "found ~a fields in struct, but ~a contracts"
(format "found ~a field~a in struct, but ~a contract~a"
(length selector-ids)
(length field-contract-ids))
(if (= 1 (length selector-ids)) "" "s")
(length field-contract-ids)
(if (= 1 (length field-contract-ids)) "" "s"))
provide-stx
struct-name))
(unless (equal? (length mutator-ids)
@ -374,9 +376,8 @@ improve method arity mismatch contract violation error messages?
[names (cdr names)]
[selector-strs (reverse (map (λ (x) (format "~a" (syntax-e x))) selector-ids))]
[field-names (reverse field-names)])
(cond
[(or (null? counts) (null? names) (null? selector-strs) (null? field-names))
[(or (null? selector-strs) (null? field-names))
(void)]
[(zero? count)
(loop (car counts) (car names) (cdr counts) (cdr names)

31
collects/tests/mzscheme/contract-test.ss
View File

@ -5135,7 +5135,36 @@ so that propagation occurs.
(λ (x)
(and (exn? x)
(regexp-match #rx"on the-defined-variable4" (exn-message x)))))
(contract-error-test
#'(begin
(eval '(module pce5-bug mzscheme
(require (lib "contract.ss"))
(define-struct bad (a b))
(provide/contract
[struct bad ((string? a) (string? b))])))
(eval '(require pce5-bug)))
(λ (x)
(and (exn? x)
(regexp-match #rx"expected field name to be b, but found string?" (exn-message x)))))
(contract-error-test
#'(begin
(eval '(module pce6-bug mzscheme
(require (lib "contract.ss"))
(define-struct bad-parent (a))
(define-struct (bad bad-parent) (b))
(provide/contract
[struct bad ((a string?) (string? b))])))
(eval '(require pce6-bug)))
(λ (x)
(and (exn? x)
(regexp-match #rx"expected field name to be b, but found string?" (exn-message x)))))
(contract-eval `(,test 'pos guilty-party (with-handlers ((void values)) (contract not #t 'pos 'neg))))
(report-errs)

4
collects/web-server/managers/manager.ss
View File

@ -24,10 +24,10 @@
[continuation-store! (number? any/c expiration-handler? . -> . (list/c number? number?))]
[continuation-lookup (number? number? number? . -> . any/c)])]
[struct (exn:fail:servlet-manager:no-instance exn:fail)
([msg string?]
([message string?]
[continuation-marks continuation-mark-set?]
[expiration-handler expiration-handler?])]
[struct (exn:fail:servlet-manager:no-continuation exn:fail)
([msg string?]
([message string?]
[continuation-marks continuation-mark-set?]
[expiration-handler expiration-handler?])]))

2
collects/web-server/private/servlet.ss
View File

@ -33,7 +33,7 @@
(provide/contract
[struct (exn:fail:servlet:instance exn:fail)
([msg string?]
([message string?]
[continuation-marks continuation-mark-set?])]
[struct servlet
([custodian custodian?]