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

a first attempt at a rewording of the blame error messages to admit the possibility that the contract was wrong and also to claim that fixing the blamed module or the contract is all that is required

Browse Source 
note that two test cases are failing, but only because they depend on the wording of the error messages; once that is set, I'll fix them.
This commit is contained in:
Robby Findler 2010-12-09 10:20:34 -06:00
parent 092b966b83
commit 18dacad6c8
2 changed files with 33 additions and 18 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

38
collects/racket/contract/private/blame.rkt
View File

@ -19,19 +19,19 @@
(struct-out exn:fail:contract:blame))
(define (blame=? a b equal?/recur)
(and (equal?/recur (blame-positive a) (blame-positive b))
(equal?/recur (blame-negative a) (blame-negative b))
(equal?/recur (blame-contract a) (blame-contract b))
(and (equal?/recur (blame-source a) (blame-source b))
(equal?/recur (blame-value a) (blame-value b))
(equal?/recur (blame-source a) (blame-source b))
(equal?/recur (blame-contract a) (blame-contract b))
(equal?/recur (blame-positive a) (blame-positive b))
(equal?/recur (blame-negative a) (blame-negative b))
(equal?/recur (blame-original? a) (blame-original? b))))
(define (blame-hash b hash/recur)
(bitwise-xor (hash/recur (blame-positive b))
(hash/recur (blame-negative b))
(hash/recur (blame-contract b))
(bitwise-xor (hash/recur (blame-source b))
(hash/recur (blame-value b))
(hash/recur (blame-source b))
(hash/recur (blame-contract b))
(hash/recur (blame-positive b))
(hash/recur (blame-negative b))
(hash/recur (blame-original? b))))
(define-struct blame
@ -65,6 +65,7 @@
(define (default-blame-format b x custom-message)
(let* ([source-message (source-location->prefix (blame-source b))]
[positive-message (show/display (blame-positive b))]
[negative-message (show/display (blame-negative b))]
[contract-message (show/write (blame-contract b))]
[value-message (if (blame-value b)
(format " on ~a" (show/display (blame-value b)))
@ -73,13 +74,28 @@
(equal? (blame-positive b) (blame-user b)))
""
(format " given to ~a" (show/display (blame-user b))))])
(format "~a~a broke the contract ~a~a~a; ~a"
(cond
[(blame-original? b)
(format "~afound a contradiction between the contract ~a~a for ~a and its implementation~a; ~a; to fix adjust either the contract or the implementation of ~a"
source-message
positive-message
contract-message
value-message
positive-message
user-message
custom-message)))
custom-message
positive-message)]
[else
(format "~afound a contradiction between the contract ~a~a for ~a and its client ~a~a; ~a; to fix adjust either the contract on ~a or the implementation of ~a"
source-message
contract-message
value-message
negative-message
positive-message
user-message
custom-message
negative-message
positive-message)])))
(define ((show f) v)
(let* ([line

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

@ -89,9 +89,8 @@
(define (test/spec-failed name expression blame)
(let ()
(define (has-proper-blame? msg)
(regexp-match?
(string-append "(^| )" (regexp-quote blame) " broke")
msg))
(define reg (string-append "the implementation of " (regexp-quote blame)))
(regexp-match? reg msg))
(printf "testing: ~s\n" name)
(contract-eval
`(,thunk-error-test