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

improved the error messages for #:pre and #:post violations in ->i by including the bindings for the variables

Browse Source
This commit is contained in:
Robby Findler 2011-03-26 08:12:30 -05:00
parent 3b4ba31d74
commit f3b0a7454a
2 changed files with 51 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

45
collects/racket/contract/private/arr-i.rkt
View File

@ -337,32 +337,47 @@
(define-for-syntax (maybe-generate-temporary x)
(and x (car (generate-temporaries (list x)))))
(define (check-pre bool val str blame)
(unless bool
(raise-blame-error blame val (or str "#:pre condition violation"))))
(define (check-post bool val str blame)
(unless bool
(raise-blame-error blame val (or str "#:post condition violation"))))
(define (signal-pre/post pre? val str blame . var-infos)
(define pre-str (or str
(string-append
(if pre? "#:pre" "#:post")
" condition violation"
(if (null? var-infos)
""
"; variables are:"))))
(raise-blame-error blame val
(apply
string-append
pre-str
(for/list ([var-info (in-list var-infos)])
(format "\n ~s: ~e"
(list-ref var-info 0)
(list-ref var-info 1))))))
(define-for-syntax (add-pre-cond an-istx arg/res-to-indy-var call-stx)
#`(begin #,@(for/list ([pre (in-list (istx-pre an-istx))]
[i (in-naturals)])
(define id (string->symbol (format "pre-proc~a" i)))
#`(check-pre (#,id #,@(map arg/res-to-indy-var (pre/post-vars pre)))
val
#,(pre/post-str pre)
swapped-blame))
#`(unless (#,id #,@(map arg/res-to-indy-var (pre/post-vars pre)))
(signal-pre/post #t
val
#,(pre/post-str pre)
swapped-blame
#,@(map (λ (x) #`(list '#,x #,(arg/res-to-indy-var x)))
(pre/post-vars pre)))))
#,call-stx))
(define-for-syntax (add-post-cond an-istx arg/res-to-indy-var call-stx)
#`(begin #,@(for/list ([post (in-list (istx-post an-istx))]
[i (in-naturals)])
(define id (string->symbol (format "post-proc~a" i)))
#`(check-post (#,id #,@(map arg/res-to-indy-var (pre/post-vars post)))
val
#,(pre/post-str post)
blame))
#`(unless (#,id #,@(map arg/res-to-indy-var (pre/post-vars post)))
(signal-pre/post #f
val
#,(pre/post-str post)
blame
#,@(map (λ (x) #`(list '#,x #,(arg/res-to-indy-var x)))
(pre/post-vars post)))))
#,call-stx))
;; add-wrapper-let : syntax

21
collects/tests/racket/contract-test.rktl
View File

@ -2901,6 +2901,27 @@
'neg)
1))
;; test to make sure the values are in the error messages
(contract-error-test
#'((contract (->i ([x number?]) #:pre (x) #f any)
(λ (x) x)
'pos
'neg)
123456789)
(λ (x)
(and (exn? x)
(regexp-match #rx"x: 123456789" (exn-message x)))))
(contract-error-test
#'((contract (->i ([|x y| number?]) #:pre (|x y|) #f any)
(λ (x) x)
'pos
'neg)
123456789)
(λ (x)
(and (exn? x)
(regexp-match (regexp-quote "|x y|: 123456789") (exn-message x)))))
(test/neg-blame
'->i-protect-shared-state
'(let ([x 1])