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

adjusted the wording of the contract error messages to move away from <>'s and added more colons

Browse Source
This commit is contained in:
Robby Findler 2011-07-12 22:02:03 -06:00
parent b14ac37d99
commit 7b9b3c371b
11 changed files with 43 additions and 26 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
collects/racket/contract/private/basic-opters.rkt
View File

@ -22,7 +22,7 @@
(raise-blame-error (raise-blame-error
blame blame
val val
"expected <~s>, given: ~e" "expected: ~s, given: ~e"
(contract-name ctc) (contract-name ctc)
val)))) val))))
null null
@ -102,7 +102,7 @@
(raise-blame-error (raise-blame-error
blame blame
val val
"expected <~s>, given: ~e" "expected: ~s, given: ~e"
(contract-name ctc) (contract-name ctc)
val))) val)))
(interleave-lifts (interleave-lifts

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

@ -87,7 +87,7 @@
"self-contract violation:")) "self-contract violation:"))
(string-append (string-append
(format "~a ~a\n" start-of-message custom-message) (format "~a ~a\n" start-of-message custom-message)
(format " contract from ~a~a blaming ~a~a" (format " contract from: ~a~a blaming: ~a~a"
positive-message positive-message
(if (regexp-match #rx"\n" positive-message) (if (regexp-match #rx"\n" positive-message)
" " " "
@ -105,7 +105,7 @@
"contract violation:")) "contract violation:"))
(string-append (string-append
(format "~a ~a\n" start-of-message custom-message) (format "~a ~a\n" start-of-message custom-message)
(format " contract from ~a~a blaming ~a~a" (format " contract from: ~a~a blaming: ~a~a"
negative-message negative-message
(if (regexp-match #rx"\n" negative-message) (if (regexp-match #rx"\n" negative-message)
" " " "

2
collects/racket/contract/private/box.rkt
View File

@ -31,7 +31,7 @@
[(dont-care) (void)]) [(dont-care) (void)])
(when first-order? (when first-order?
(unless (contract-first-order-passes? elem-ctc (unbox val)) (unless (contract-first-order-passes? elem-ctc (unbox val))
(fail "expected <~s>, got ~v" (contract-name elem-ctc) val))) (fail "expected: ~s, got ~v" (contract-name elem-ctc) val)))
#t))) #t)))
(define (box/c-first-order ctc) (define (box/c-first-order ctc)

6
collects/racket/contract/private/ds.rkt
View File

@ -246,7 +246,7 @@ it around flattened out.
(raise-blame-error (raise-blame-error
blame blame
val val
"expected <~s>, got ~e" 'name val)) "expected: ~s, got ~e" 'name val))
(cond (cond
[(already-there? contract/info val lazy-depth-to-look) [(already-there? contract/info val lazy-depth-to-look)
val] val]
@ -299,7 +299,7 @@ it around flattened out.
(do-selection struct (+ i 1)) (do-selection struct (+ i 1))
(wrap-get struct (+ i 1)))] (wrap-get struct (+ i 1)))]
[else [else
(error selector-name "expected <~s>, got ~e" 'name struct)])) (error selector-name "expected: ~s, got ~e" 'name struct)]))
(define (lazy-contract-name ctc) (define (lazy-contract-name ctc)
(do-contract-name 'struct/c (do-contract-name 'struct/c
@ -452,7 +452,7 @@ it around flattened out.
(raise-blame-error (raise-blame-error
blame blame
val val
"expected <~s>, got ~e" "expected: ~s, got ~e"
(contract-name ctc) (contract-name ctc)
val)])) val)]))
lifts lifts

4
collects/racket/contract/private/hash.rkt
View File

@ -99,9 +99,9 @@
(when first-order? (when first-order?
(for ([(k v) (in-hash val)]) (for ([(k v) (in-hash val)])
(unless (contract-first-order-passes? dom-ctc k) (unless (contract-first-order-passes? dom-ctc k)
(fail "expected <~s> for key, got ~v" (contract-name dom-ctc) k)) (fail "expected: ~s for key, got ~v" (contract-name dom-ctc) k))
(unless (contract-first-order-passes? rng-ctc v) (unless (contract-first-order-passes? rng-ctc v)
(fail "expected <~s> for value, got ~v" (contract-name rng-ctc) v)))) (fail "expected: ~s for value, got ~v" (contract-name rng-ctc) v))))
#t))) #t)))
(define (hash/c-first-order ctc) (define (hash/c-first-order ctc)

4
collects/racket/contract/private/misc.rkt
View File

@ -327,7 +327,7 @@
(raise-blame-error (raise-blame-error
blame blame
val val
"expected <~s>, given ~a, which isn't ~s" "expected: ~s, given ~a, which isn't ~s"
(contract-name ctc) (contract-name ctc)
val val
(contract-name (car ctcs))))]))))) (contract-name (car ctcs))))])))))
@ -565,7 +565,7 @@
(λ (val) (λ (val)
(unless (predicate? val) (unless (predicate? val)
(raise-blame-error blame val (raise-blame-error blame val
"expected <~a>, given: ~e" "expected: ~s, given: ~e"
'type-name val)) 'type-name val))
(check-all p-app val)))) (check-all p-app val))))
(cond (cond

8
collects/racket/contract/private/opters.rkt
View File

@ -148,7 +148,7 @@
(raise-blame-error (raise-blame-error
blame blame
val val
"expected <~s>, given: ~e" "expected: ~s, given: ~e"
(contract-name ctc) (contract-name ctc)
val))) val)))
lifts3 lifts3
@ -186,7 +186,7 @@
(raise-blame-error (raise-blame-error
blame blame
val val
"expected <~s>, given: ~e" "expected: ~s, given: ~e"
(contract-name ctc) (contract-name ctc)
val))) val)))
lifts3 lifts3
@ -268,7 +268,7 @@
(raise-blame-error (raise-blame-error
blame blame
val val
"expected <~s>, given: ~e" "expected: ~s, given: ~e"
(contract-name ctc) (contract-name ctc)
val)))) val))))
(append (append
@ -329,7 +329,7 @@
(raise-blame-error (raise-blame-error
blame blame
val val
"expected <~s>, given: ~e" "expected: ~s, given: ~e"
(contract-name ctc) (contract-name ctc)
val)))) val))))
(append lifts-hdp lifts-tlp) (append lifts-hdp lifts-tlp)

2
collects/racket/contract/private/prop.rkt
View File

@ -211,7 +211,7 @@
(define (((first-order-projection name first-order) b) x) (define (((first-order-projection name first-order) b) x)
(if (first-order x) (if (first-order x)
x x
(raise-blame-error b x "expected <~s>, given: ~e" name x))) (raise-blame-error b x "expected: ~s, given: ~e" name x)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; ;;

4
collects/racket/contract/private/struct.rkt
View File

@ -36,12 +36,12 @@
(append (base-struct/c-immutables ctc) (base-struct/c-mutables ctc)))]) (append (base-struct/c-immutables ctc) (base-struct/c-mutables ctc)))])
(λ (val fail [first-order? #f]) (λ (val fail [first-order? #f])
(unless (pred? val) (unless (pred? val)
(fail "expected <~s>, got ~e" name val)) (fail "expected: ~s, got ~e" name val))
(when first-order? (when first-order?
(for ([p (in-list ctc/ref-pairs)]) (for ([p (in-list ctc/ref-pairs)])
(let ([c (car p)] [v ((cdr p) val)]) (let ([c (car p)] [v ((cdr p) val)])
(unless (contract-first-order-passes? c v) (unless (contract-first-order-passes? c v)
(fail "expected <~s>, got ~e" (contract-name c) v))))) (fail "expected: ~s, got ~e" (contract-name c) v)))))
#t))) #t)))
(define (struct/c-first-order ctc) (define (struct/c-first-order ctc)

4
collects/racket/contract/private/vector.rkt
View File

@ -62,7 +62,7 @@
(for ([e (in-vector val)] (for ([e (in-vector val)]
[n (in-naturals)]) [n (in-naturals)])
(unless (contract-first-order-passes? elem-ctc e) (unless (contract-first-order-passes? elem-ctc e)
(fail "expected <~s> for element ~v, got ~v" (contract-name elem-ctc) n e)))) (fail "expected: ~s for element ~v, got ~v" (contract-name elem-ctc) n e))))
#t))) #t)))
(define (vectorof-first-order ctc) (define (vectorof-first-order ctc)
@ -196,7 +196,7 @@
[n (in-naturals)] [n (in-naturals)]
[c (in-list elem-ctcs)]) [c (in-list elem-ctcs)])
(unless (contract-first-order-passes? c e) (unless (contract-first-order-passes? c e)
(fail "expected <~s> for element ~v, got ~v" (contract-name c) n val)))) (fail "expected: ~s for element ~v, got ~v" (contract-name c) n val))))
#t))) #t)))
(define (vector/c-first-order ctc) (define (vector/c-first-order ctc)

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

@ -35,9 +35,9 @@
[(_ a ...) [(_ a ...)
(syntax (contract-eval `(,test a ...)))])) (syntax (contract-eval `(,test a ...)))]))
(define (contract-error-test exp exn-ok?) (define (contract-error-test name exp exn-ok?)
(test #t (test #t
'contract-error-test name
(contract-eval `(with-handlers ((exn? (λ (x) (and (,exn-ok? x) #t)))) ,exp)))) (contract-eval `(with-handlers ((exn? (λ (x) (and (,exn-ok? x) #t)))) ,exp))))
(define (contract-syntax-error-test name exp [reg #rx""]) (define (contract-syntax-error-test name exp [reg #rx""])
@ -2916,6 +2916,7 @@
;; test to make sure the values are in the error messages ;; test to make sure the values are in the error messages
(contract-error-test (contract-error-test
'contract-error-test1
#'((contract (->i ([x number?]) #:pre (x) #f any) #'((contract (->i ([x number?]) #:pre (x) #f any)
(λ (x) x) (λ (x) x)
'pos 'pos
@ -2925,6 +2926,7 @@
(and (exn? x) (and (exn? x)
(regexp-match #rx"x: 123456789" (exn-message x))))) (regexp-match #rx"x: 123456789" (exn-message x)))))
(contract-error-test (contract-error-test
'contract-error-test2
#'((contract (->i ([|x y| number?]) #:pre (|x y|) #f any) #'((contract (->i ([|x y| number?]) #:pre (|x y|) #f any)
(λ (x) x) (λ (x) x)
'pos 'pos
@ -2936,6 +2938,7 @@
;; test to make sure the collects directories are appropriately prefixed ;; test to make sure the collects directories are appropriately prefixed
(contract-error-test (contract-error-test
'contract-error-test3
#'(contract symbol? "not a symbol" 'pos 'neg 'not-a-symbol #'here) #'(contract symbol? "not a symbol" 'pos 'neg 'not-a-symbol #'here)
(lambda (x) (lambda (x)
(and (exn? x) (and (exn? x)
@ -3547,6 +3550,7 @@
1) 1)
(contract-error-test (contract-error-test
'contract-error-test4
#'(contract (or/c (-> integer? integer?) (-> boolean? boolean?)) #'(contract (or/c (-> integer? integer?) (-> boolean? boolean?))
(λ (x) x) (λ (x) x)
'pos 'pos
@ -4019,6 +4023,7 @@
(ctest #f impersonator-contract? proj:bad-prime-box-list/c) (ctest #f impersonator-contract? proj:bad-prime-box-list/c)
(contract-error-test (contract-error-test
'contract-error-test5
'(contract proj:bad-prime-box-list/c (list (box 2) (box 3)) 'pos 'neg) '(contract proj:bad-prime-box-list/c (list (box 2) (box 3)) 'pos 'neg)
exn:fail?) exn:fail?)
@ -9414,6 +9419,7 @@ so that propagation occurs.
;; Make sure that proxies cannot be used as the domain contract in hash/c. ;; Make sure that proxies cannot be used as the domain contract in hash/c.
(contract-error-test (contract-error-test
'contract-error-test6
'(let ([proxy-ctc '(let ([proxy-ctc
(make-contract (make-contract
#:name 'proxy-ctc #:name 'proxy-ctc
@ -10937,6 +10943,7 @@ so that propagation occurs.
;; make sure unbound identifier exception is raised. ;; make sure unbound identifier exception is raised.
(contract-error-test (contract-error-test
'contract-error-test7
#'(begin #'(begin
(eval '(module pos scheme/base (eval '(module pos scheme/base
(require scheme/contract) (require scheme/contract)
@ -11345,6 +11352,7 @@ so that propagation occurs.
3) 3)
(contract-error-test (contract-error-test
'contract-error-test8
#'(begin #'(begin
(eval '(module pce1-bug scheme/base (eval '(module pce1-bug scheme/base
(require scheme/contract) (require scheme/contract)
@ -11356,6 +11364,7 @@ so that propagation occurs.
(regexp-match #rx"the-defined-variable1: self-contract violation" (exn-message x))))) (regexp-match #rx"the-defined-variable1: self-contract violation" (exn-message x)))))
(contract-error-test (contract-error-test
'contract-error-test9
#'(begin #'(begin
(eval '(module pce2-bug scheme/base (eval '(module pce2-bug scheme/base
(require scheme/contract) (require scheme/contract)
@ -11368,6 +11377,7 @@ so that propagation occurs.
(regexp-match #rx"the-defined-variable2: contract violation" (exn-message x))))) (regexp-match #rx"the-defined-variable2: contract violation" (exn-message x)))))
(contract-error-test (contract-error-test
'contract-error-test10
#'(begin #'(begin
(eval '(module pce3-bug scheme/base (eval '(module pce3-bug scheme/base
(require scheme/contract) (require scheme/contract)
@ -11380,6 +11390,7 @@ so that propagation occurs.
(regexp-match #rx"the-defined-variable3" (exn-message x))))) (regexp-match #rx"the-defined-variable3" (exn-message x)))))
(contract-error-test (contract-error-test
'contract-error-test11
#'(begin #'(begin
(eval '(module pce4-bug scheme/base (eval '(module pce4-bug scheme/base
(require scheme/contract) (require scheme/contract)
@ -11392,6 +11403,7 @@ so that propagation occurs.
(regexp-match #rx"^the-defined-variable4" (exn-message x))))) (regexp-match #rx"^the-defined-variable4" (exn-message x)))))
(contract-error-test (contract-error-test
'contract-error-test12
#'(begin #'(begin
(eval '(module pce5-bug scheme/base (eval '(module pce5-bug scheme/base
(require scheme/contract) (require scheme/contract)
@ -11406,6 +11418,7 @@ so that propagation occurs.
(regexp-match #rx"expected field name to be b, but found string?" (exn-message x))))) (regexp-match #rx"expected field name to be b, but found string?" (exn-message x)))))
(contract-error-test (contract-error-test
'contract-error-test13
#'(begin #'(begin
(eval '(module pce6-bug scheme/base (eval '(module pce6-bug scheme/base
(require scheme/contract) (require scheme/contract)
@ -11421,6 +11434,7 @@ so that propagation occurs.
(regexp-match #rx"expected field name to be b, but found string?" (exn-message x))))) (regexp-match #rx"expected field name to be b, but found string?" (exn-message x)))))
(contract-error-test (contract-error-test
'contract-error-test14
#'(begin #'(begin
(eval '(module pce7-bug scheme/base (eval '(module pce7-bug scheme/base
(require scheme/contract) (require scheme/contract)
@ -11434,6 +11448,7 @@ so that propagation occurs.
(regexp-match #rx"cannot set!" (exn-message x))))) (regexp-match #rx"cannot set!" (exn-message x)))))
(contract-error-test (contract-error-test
'contract-error-test15
#'(begin #'(begin
(eval '(module pce8-bug1 scheme/base (eval '(module pce8-bug1 scheme/base
(require scheme/contract) (require scheme/contract)
@ -11445,6 +11460,7 @@ so that propagation occurs.
(regexp-match #rx"pce8-bug" (exn-message x))))) (regexp-match #rx"pce8-bug" (exn-message x)))))
(contract-error-test (contract-error-test
'contract-error-test16
#'(begin #'(begin
(eval '(module pce9-bug scheme (eval '(module pce9-bug scheme
(define (f x) "wrong") (define (f x) "wrong")
@ -11455,9 +11471,10 @@ so that propagation occurs.
(eval '(g 12))) (eval '(g 12)))
(λ (x) (λ (x)
(and (exn? x) (and (exn? x)
(regexp-match #rx"^g.*contract from pce9-bug" (exn-message x))))) (regexp-match #rx"^g.*contract from: pce9-bug" (exn-message x)))))
(contract-error-test (contract-error-test
'contract-error-test17
#'(begin #'(begin
(eval '(module pce10-bug scheme (eval '(module pce10-bug scheme
(define (f x) "wrong") (define (f x) "wrong")
@ -11468,7 +11485,7 @@ so that propagation occurs.
(eval '(g 'a))) (eval '(g 'a)))
(λ (x) (λ (x)
(and (exn? x) (and (exn? x)
(regexp-match #rx"^g.*contract from pce10-bug" (exn-message x))))) (regexp-match #rx"^g.*contract from: pce10-bug" (exn-message x)))))
(contract-eval (contract-eval
`(,test `(,test