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

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

@ -87,7 +87,7 @@
"self-contract violation:"))
(string-append
(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
(if (regexp-match #rx"\n" positive-message)
" "
@ -105,7 +105,7 @@
"contract violation:"))
(string-append
(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
(if (regexp-match #rx"\n" negative-message)
" "

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

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

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

@ -99,9 +99,9 @@
(when first-order?
(for ([(k v) (in-hash val)])
(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)
(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)))
(define (hash/c-first-order ctc)

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

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

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

@ -148,7 +148,7 @@
(raise-blame-error
blame
val
"expected <~s>, given: ~e"
"expected: ~s, given: ~e"
(contract-name ctc)
val)))
lifts3
@ -186,7 +186,7 @@
(raise-blame-error
blame
val
"expected <~s>, given: ~e"
"expected: ~s, given: ~e"
(contract-name ctc)
val)))
lifts3
@ -268,7 +268,7 @@
(raise-blame-error
blame
val
"expected <~s>, given: ~e"
"expected: ~s, given: ~e"
(contract-name ctc)
val))))
(append
@ -329,7 +329,7 @@
(raise-blame-error
blame
val
"expected <~s>, given: ~e"
"expected: ~s, given: ~e"
(contract-name ctc)
val))))
(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)
(if (first-order 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)))])
(λ (val fail [first-order? #f])
(unless (pred? val)
(fail "expected <~s>, got ~e" name val))
(fail "expected: ~s, got ~e" name val))
(when first-order?
(for ([p (in-list ctc/ref-pairs)])
(let ([c (car p)] [v ((cdr p) val)])
(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)))
(define (struct/c-first-order ctc)

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

@ -62,7 +62,7 @@
(for ([e (in-vector val)]
[n (in-naturals)])
(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)))
(define (vectorof-first-order ctc)
@ -196,7 +196,7 @@
[n (in-naturals)]
[c (in-list elem-ctcs)])
(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)))
(define (vector/c-first-order ctc)

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

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