adjust the contract error messages to follow the error message
conventions in 9.2.1 of the reference (altho the messages do not yet do the extra level of indenting when a field is too long, nor are there any field names ending in ...) Also, fix the docs for the #:stronger argument to make-contract, make-chaperone-contract, and make-flat-contract
This commit is contained in:
Robby Findler
parent
34618708a6
commit
8a0b6549a5
|
|
@ -113,7 +113,7 @@ v4 todo:
|
|||
[res-checker (λ (res-x ...) (values (p-app-x res-x) ...))])
|
||||
(λ (val)
|
||||
(unless (procedure? val)
|
||||
(raise-blame-error orig-blame val '(expected: "a procedure," given: "~v") val))
|
||||
(raise-blame-error orig-blame val '(expected: "a procedure" given: "~v") val))
|
||||
(wrapper
|
||||
val
|
||||
(make-keyword-procedure
|
||||
|
|
@ -394,7 +394,7 @@ v4 todo:
|
|||
(define args-len (length args))
|
||||
(unless (valid-number-of-args? args)
|
||||
(raise-blame-error (blame-swap blame) val
|
||||
'("received ~a argument~a," expected: "~a")
|
||||
'("received ~a argument~a" expected: "~a")
|
||||
args-len (if (= args-len 1) "" "s") arity-string))
|
||||
|
||||
;; these two for loops are doing O(n^2) work that could be linear
|
||||
|
|
@ -416,7 +416,7 @@ v4 todo:
|
|||
(unless (valid-number-of-args? args)
|
||||
(define args-len (length args))
|
||||
(raise-blame-error (blame-swap blame) val
|
||||
'("received ~a argument~a," expected: "~a")
|
||||
'("received ~a argument~a" expected: "~a")
|
||||
args-len (if (= args-len 1) "" "s") arity-string))
|
||||
(apply basic-lambda args))
|
||||
(λ args
|
||||
|
|
@ -1876,7 +1876,7 @@ v4 todo:
|
|||
(raise-blame-error
|
||||
blame
|
||||
val
|
||||
'(expected" a ~a that accepts ~a~a~a argument~a~a~a," given: "~e")
|
||||
'(expected " a ~a that accepts ~a~a~a argument~a~a~a" given: "~e")
|
||||
(if mtd? "method" "procedure")
|
||||
(if (zero? dom-length) "no" dom-length)
|
||||
(if (null? optionals) "" " mandatory")
|
||||
|
|
@ -1951,7 +1951,7 @@ v4 todo:
|
|||
(raise-blame-error
|
||||
blame
|
||||
val
|
||||
'(expected "a ~a that accepts ~a argument~a and arbitrarily more~a," given: "~e")
|
||||
'(expected " a ~a that accepts ~a argument~a and arbitrarily more~a" given: "~e")
|
||||
(if mtd? "method" "procedure")
|
||||
(cond
|
||||
[(zero? dom-length) "no"]
|
||||
|
|
|
|||
|
|
@ -93,7 +93,7 @@
|
|||
(raise-blame-error
|
||||
blame
|
||||
val
|
||||
'(expected: "~s," given: "~e")
|
||||
'(expected: "~s" given: "~e")
|
||||
(contract-name ctc)
|
||||
val)))
|
||||
#:lifts
|
||||
|
|
|
|||
|
|
@ -107,30 +107,36 @@
|
|||
(apply string-append (reverse so-far))]
|
||||
[else
|
||||
(define fst (car strs))
|
||||
(define (add-indent s)
|
||||
(if (null? so-far)
|
||||
s
|
||||
(string-append "\n " s)))
|
||||
(define nxt
|
||||
(cond
|
||||
[(eq? 'given: fst) (if (blame-original? blame)
|
||||
"produced:"
|
||||
"given:")]
|
||||
[(eq? 'given: fst) (add-indent
|
||||
(if (blame-original? blame)
|
||||
"produced:"
|
||||
"given:"))]
|
||||
[(eq? 'given fst) (if (blame-original? blame)
|
||||
"produced"
|
||||
"given")]
|
||||
[(eq? 'expected: fst) (if (blame-original? blame)
|
||||
"promised:"
|
||||
"expected:")]
|
||||
[(eq? 'expected: fst) (add-indent
|
||||
(if (blame-original? blame)
|
||||
"promised:"
|
||||
"expected:"))]
|
||||
[(eq? 'expected fst) (if (blame-original? blame)
|
||||
"promised"
|
||||
"expected")]
|
||||
[else fst]))
|
||||
(define new-so-far
|
||||
(if (or last-ended-in-whitespace?
|
||||
(regexp-match #rx"^ " nxt))
|
||||
(regexp-match #rx"^[\n ]" nxt))
|
||||
(cons nxt so-far)
|
||||
(list* nxt " " so-far)))
|
||||
(loop (cdr strs)
|
||||
new-so-far
|
||||
(regexp-match #rx" $" nxt))]))]))
|
||||
|
||||
|
||||
(define (default-blame-format blme x custom-message)
|
||||
(define source-message (source-location->string (blame-source blme)))
|
||||
(define positive-message (show/display (convert-blame-party (blame-positive blme))))
|
||||
|
|
@ -142,13 +148,13 @@
|
|||
(for/list ([context (in-list context)]
|
||||
[n (in-naturals)])
|
||||
(format (if (zero? n)
|
||||
" in: ~a\n"
|
||||
" ~a\n")
|
||||
" in: ~a\n"
|
||||
" ~a\n")
|
||||
context)))))
|
||||
(define contract-line (show/write (blame-contract blme) #:alone? #t))
|
||||
(define at-line (if (string=? source-message "")
|
||||
#f
|
||||
(format " at: ~a" source-message)))
|
||||
(format " at: ~a" source-message)))
|
||||
|
||||
(define self-or-not (if (blame-original? blme)
|
||||
"broke its contract"
|
||||
|
|
@ -163,22 +169,22 @@
|
|||
[else
|
||||
(format "~a:" self-or-not)]))
|
||||
|
||||
(define blaming-line (format " blaming: ~a" positive-message))
|
||||
(define blaming-line (format " blaming: ~a" positive-message))
|
||||
|
||||
(define from-line
|
||||
(if (blame-original? blme)
|
||||
(format " contract from: ~a" positive-message)
|
||||
(format " contract from: ~a" positive-message)
|
||||
(let ([negative-message (show/display (convert-blame-party (blame-negative blme)))])
|
||||
(format " contract from: ~a" negative-message))))
|
||||
(format " contract from: ~a" negative-message))))
|
||||
|
||||
(combine-lines
|
||||
start-of-message
|
||||
(format " ~a" custom-message)
|
||||
(format " ~a" custom-message)
|
||||
context-lines
|
||||
(if context-lines
|
||||
contract-line
|
||||
(string-append
|
||||
" in:"
|
||||
" in:"
|
||||
(substring contract-line 5 (string-length contract-line))))
|
||||
from-line
|
||||
blaming-line
|
||||
|
|
|
|||
|
|
@ -18,14 +18,14 @@
|
|||
(define elem-ctc (base-box/c-content ctc))
|
||||
(define immutable (base-box/c-immutable ctc))
|
||||
(unless (box? val)
|
||||
(raise-blame-error blame val '(expected "a box," given: "~e") val))
|
||||
(raise-blame-error blame val '(expected "a box" given: "~e") val))
|
||||
(case immutable
|
||||
[(#t)
|
||||
(unless (immutable? val)
|
||||
(raise-blame-error blame val '(expected "an immutable box," given: "~e") val))]
|
||||
(raise-blame-error blame val '(expected "an immutable box" given: "~e") val))]
|
||||
[(#f)
|
||||
(when (immutable? val)
|
||||
(raise-blame-error blame val '(expected "a mutable box," given: "~e") val))]
|
||||
(raise-blame-error blame val '(expected "a mutable box" given: "~e") val))]
|
||||
[(dont-care) (void)]))
|
||||
|
||||
(define (box/c-first-order ctc)
|
||||
|
|
|
|||
|
|
@ -253,7 +253,7 @@ it around flattened out.
|
|||
(raise-blame-error
|
||||
blame
|
||||
val
|
||||
'(expected: "~s," given: "~e") 'name val))
|
||||
'(expected: "~s" given: "~e") 'name val))
|
||||
(cond
|
||||
[(already-there? contract/info val lazy-depth-to-look)
|
||||
val]
|
||||
|
|
@ -459,7 +459,7 @@ it around flattened out.
|
|||
(raise-blame-error
|
||||
blame
|
||||
val
|
||||
'(expected: "~s," given: "~e")
|
||||
'(expected: "~s" given: "~e")
|
||||
(contract-name ctc)
|
||||
val)]))
|
||||
#:lifts lifts
|
||||
|
|
@ -535,7 +535,7 @@ it around flattened out.
|
|||
(raise-blame-error
|
||||
(contract/info-blame contract/info)
|
||||
stct
|
||||
'("failed `and' clause," given: "~e")
|
||||
'("failed `and' clause" given: "~e")
|
||||
stct)))
|
||||
|
||||
(define-values (evaluate-attr-prop evaluate-attr-prop-predicate evaluate-attr-prop-accessor)
|
||||
|
|
|
|||
|
|
@ -82,22 +82,22 @@
|
|||
(define immutable (base-hash/c-immutable ctc))
|
||||
(define flat? (flat-hash/c? ctc))
|
||||
(unless (hash? val)
|
||||
(raise-blame-error blame val '(expected "a hash," given: "~e") val))
|
||||
(raise-blame-error blame val '(expected "a hash" given: "~e") val))
|
||||
(when (and (not flat?)
|
||||
(not (flat-contract? dom-ctc))
|
||||
(not (hash-equal? val)))
|
||||
(raise-blame-error blame val
|
||||
'(expected "equal?-based hash table due to higher-order domain contract," given: "~e")
|
||||
'(expected "equal?-based hash table due to higher-order domain contract" given: "~e")
|
||||
val))
|
||||
(case immutable
|
||||
[(#t)
|
||||
(unless (immutable? val)
|
||||
(raise-blame-error blame val
|
||||
'(expected "an immutable hash," given: "~e") val))]
|
||||
'(expected "an immutable hash" given: "~e") val))]
|
||||
[(#f)
|
||||
(when (immutable? val)
|
||||
(raise-blame-error blame val
|
||||
'(expected "a mutable hash," given: "~e") val))]
|
||||
'(expected "a mutable hash" given: "~e") val))]
|
||||
[(dont-care) (void)]))
|
||||
|
||||
(define (hash/c-first-order ctc)
|
||||
|
|
|
|||
|
|
@ -225,12 +225,12 @@
|
|||
(if candidate-proc
|
||||
(candidate-proc val)
|
||||
(raise-blame-error blame val
|
||||
'("none of the branches of the or/c matched," given: "~e")
|
||||
'("none of the branches of the or/c matched" given: "~e")
|
||||
val))]
|
||||
[((car checks) val)
|
||||
(if candidate-proc
|
||||
(raise-blame-error blame val
|
||||
'("two of the clauses in the or/c might both match: ~s and ~s," given: "~e")
|
||||
'("two of the clauses in the or/c might both match: ~s and ~s" given: "~e")
|
||||
(contract-name candidate-contract)
|
||||
(contract-name (car contracts))
|
||||
val)
|
||||
|
|
@ -367,7 +367,7 @@
|
|||
(raise-blame-error
|
||||
blame
|
||||
val
|
||||
'(expected: "~s," given: "~e, which isn't ~s")
|
||||
'(expected: "~s" given: "~e\n which isn't: ~s")
|
||||
(contract-name ctc)
|
||||
val
|
||||
(contract-name (car ctcs))))])))))
|
||||
|
|
@ -647,7 +647,7 @@
|
|||
(λ (val)
|
||||
(unless (predicate? val)
|
||||
(raise-blame-error blame val
|
||||
'(expected: "~s," given "~e")
|
||||
'(expected: "~s" given "~e")
|
||||
'type-name
|
||||
val))
|
||||
(check-all p-app val))))
|
||||
|
|
@ -694,7 +694,7 @@
|
|||
(λ (v)
|
||||
(unless (pair? v)
|
||||
(raise-blame-error blame v
|
||||
'(expected "<pair?>," given: "~e")
|
||||
'(expected "<pair?>" given: "~e")
|
||||
v))
|
||||
(combine v (car-p (car v)) (cdr-p (cdr v))))))
|
||||
(cond
|
||||
|
|
@ -748,14 +748,14 @@
|
|||
(lambda (blame)
|
||||
(lambda (x)
|
||||
(unless (list? x)
|
||||
(raise-blame-error blame x '(expected "a list," given: "~e") x))
|
||||
(raise-blame-error blame x '(expected "a list" given: "~e") x))
|
||||
(let* ([args (generic-list/c-args c)]
|
||||
[expected (length args)]
|
||||
[actual (length x)])
|
||||
(unless (= actual expected)
|
||||
(raise-blame-error
|
||||
blame x
|
||||
'(expected "a list of ~a elements, but" given "~a element~a in: ~e")
|
||||
'(expected: "a list of ~a elements" given: "~a element~a\n complete list: ~e")
|
||||
expected
|
||||
actual
|
||||
(if (= actual 1) "" "s")
|
||||
|
|
@ -775,12 +775,12 @@
|
|||
(arg/c (add-list-context blame i))))
|
||||
(λ (x)
|
||||
(unless (list? x)
|
||||
(raise-blame-error blame x '(expected "a list," given: "~e") x))
|
||||
(raise-blame-error blame x '(expected: "a list" given: "~e") x))
|
||||
(define actual (length x))
|
||||
(unless (= actual expected)
|
||||
(raise-blame-error
|
||||
blame x
|
||||
'(expected "a list of ~a elements, but" given "~a element~a in: ~e")
|
||||
'(expected: "a list of ~a elements" given: "~a element~a\n complete list: ~e")
|
||||
expected
|
||||
actual
|
||||
(if (= actual 1) "" "s")
|
||||
|
|
@ -839,7 +839,7 @@
|
|||
(raise-blame-error
|
||||
blame
|
||||
val
|
||||
'(expected "<promise>," given: "~e")
|
||||
'(expected: "<promise>" given: "~e")
|
||||
val))
|
||||
(c/i-struct
|
||||
val
|
||||
|
|
@ -941,7 +941,7 @@
|
|||
(raise-blame-error
|
||||
blame
|
||||
val
|
||||
'("~s accepts no values," given: "~e")
|
||||
'("~s accepts no values" given: "~e")
|
||||
(none/c-name ctc)
|
||||
val))))
|
||||
|
||||
|
|
@ -989,7 +989,7 @@
|
|||
(unless (contract-first-order-passes? ctc val)
|
||||
(raise-blame-error
|
||||
blame val
|
||||
'(expected: "~s," given: "~e")
|
||||
'(expected: "~s" given: "~e")
|
||||
(contract-name ctc)
|
||||
val))
|
||||
(proxy val proj1 proj2))))
|
||||
|
|
@ -1045,7 +1045,7 @@
|
|||
(unless (contract-first-order-passes? ctc val)
|
||||
(raise-blame-error
|
||||
blame val
|
||||
'(expected: "~s," given: "~e")
|
||||
'(expected: "~s" given: "~e")
|
||||
(contract-name ctc)
|
||||
val))
|
||||
(proxy val proj1 proj2))))
|
||||
|
|
|
|||
|
|
@ -183,7 +183,7 @@
|
|||
(raise-blame-error
|
||||
blame
|
||||
val
|
||||
'(expected "a number between ~a and ~a," given: "~e")
|
||||
'(expected: "a number between ~a and ~a" given: "~e")
|
||||
lo hi val))
|
||||
|
||||
(define-for-syntax (single-comparison-opter opt/info stx check-arg comparison arg)
|
||||
|
|
@ -220,7 +220,7 @@
|
|||
(raise-blame-error
|
||||
blame
|
||||
val
|
||||
'(expected "a number ~a ~a," given: "~e")
|
||||
'(expected: "a number ~a ~a" given: "~e")
|
||||
(object-name comparison) m val))
|
||||
|
||||
|
||||
|
|
@ -304,7 +304,7 @@
|
|||
(raise-blame-error
|
||||
blame
|
||||
val
|
||||
'(expected: "~s," given: "~e")
|
||||
'(expected: "~s" given: "~e")
|
||||
(contract-name ctc)
|
||||
val))))
|
||||
#:lifts
|
||||
|
|
@ -590,6 +590,6 @@
|
|||
(define (bad-number-of-arguments blame val args dom-len)
|
||||
(define num-values (length args))
|
||||
(raise-blame-error (blame-swap blame) val
|
||||
'(expected "~a argument~a," given "~a argument~a")
|
||||
'(expected: "~a argument~a" given: "~a argument~a")
|
||||
dom-len (if (= dom-len 1) "" "s")
|
||||
num-values (if (= num-values 1) "" "s")))
|
||||
|
|
|
|||
|
|
@ -46,7 +46,7 @@
|
|||
|
||||
(lambda (p)
|
||||
(unless (procedure? p)
|
||||
(raise-blame-error blame p '(expected "a procedure;" given: "~e") p))
|
||||
(raise-blame-error blame p '(expected "a procedure" given: "~e") p))
|
||||
(make-keyword-procedure
|
||||
(lambda (keys vals . args) (keyword-apply (wrap p) keys vals args))
|
||||
(case-lambda
|
||||
|
|
@ -80,6 +80,6 @@
|
|||
(lambda (x)
|
||||
(if ((barrier-contract-pred c) x)
|
||||
((barrier-contract-get c) x)
|
||||
(raise-blame-error blame x '(expected "a(n) ~a;" given: "~e")
|
||||
(raise-blame-error blame x '(expected: "~a" given: "~e")
|
||||
(barrier-contract-name c)
|
||||
x))))))))
|
||||
|
|
|
|||
|
|
@ -262,7 +262,7 @@
|
|||
(if (first-order x)
|
||||
x
|
||||
(raise-blame-error b x
|
||||
'(expected: "~s," given: "~e")
|
||||
'(expected: "~s" given: "~e")
|
||||
name
|
||||
x))))))
|
||||
|
||||
|
|
|
|||
|
|
@ -189,8 +189,9 @@
|
|||
v]
|
||||
[else
|
||||
(unless (pred? v)
|
||||
(raise-blame-error blame v '(expected: "~a")
|
||||
(base-struct/dc-struct-name ctc)))
|
||||
(raise-blame-error blame v '(expected: "~a" given: "~e")
|
||||
(base-struct/dc-struct-name ctc)
|
||||
v))
|
||||
(let loop ([subcontracts (base-struct/dc-subcontracts ctc)]
|
||||
[projs projs]
|
||||
[mut-projs mut-projs]
|
||||
|
|
@ -955,7 +956,7 @@
|
|||
|
||||
(define (struct/dc-error blame obj what)
|
||||
(raise-blame-error blame obj
|
||||
'(expected "a struct of type ~a")
|
||||
'(expected: "a struct of type ~a")
|
||||
what))
|
||||
|
||||
(define-syntax (-struct/c stx)
|
||||
|
|
|
|||
|
|
@ -14,7 +14,7 @@
|
|||
(lambda (x)
|
||||
(unless (struct-type-property? x)
|
||||
(raise-blame-error blame x
|
||||
'(expected "struct-type-property," given: "~e")
|
||||
'(expected "struct-type-property" given: "~e")
|
||||
x))
|
||||
(let-values ([(nprop _pred _acc)
|
||||
(make-struct-type-property
|
||||
|
|
|
|||
|
|
@ -53,16 +53,16 @@
|
|||
(cond
|
||||
[(eq? immutable #t)
|
||||
(unless (immutable? val)
|
||||
(fail val '(expected "an immutable vector," given: "~e") val))]
|
||||
(fail val '(expected "an immutable vector" given: "~e") val))]
|
||||
[(eq? immutable #f)
|
||||
(when (immutable? val)
|
||||
(fail val '(expected "an mutable vector," given: "~e" val)))]
|
||||
(fail val '(expected "an mutable vector" given: "~e" val)))]
|
||||
[else (void)])
|
||||
(when first-order?
|
||||
(for ([e (in-vector val)]
|
||||
[n (in-naturals)])
|
||||
(unless (contract-first-order-passes? elem-ctc e)
|
||||
(fail val '(expected: "~s for element ~s," given "~e") (contract-name elem-ctc) n e))))
|
||||
(fail val '(expected: "~s for element ~s" given: "~e") (contract-name elem-ctc) n e))))
|
||||
#t)))
|
||||
|
||||
(define (vectorof-first-order ctc)
|
||||
|
|
@ -182,22 +182,22 @@
|
|||
(define elem-ctcs (base-vector/c-elems ctc))
|
||||
(define immutable (base-vector/c-immutable ctc))
|
||||
(unless (vector? val)
|
||||
(raise-blame-error blame val '(expected "a vector," given: "~e") val))
|
||||
(raise-blame-error blame val '(expected: "a vector" given: "~e") val))
|
||||
(cond
|
||||
[(eq? immutable #t)
|
||||
(unless (immutable? val)
|
||||
(raise-blame-error blame val
|
||||
'(expected "an immutable vector," given: "~e")
|
||||
'(expected: "an immutable vector" given: "~e")
|
||||
val))]
|
||||
[(eq? immutable #f)
|
||||
(when (immutable? val)
|
||||
(raise-blame-error blame val
|
||||
'(expected "a mutable vector," given: "~e")
|
||||
'(expected: "a mutable vector" given: "~e")
|
||||
val))]
|
||||
[else (void)])
|
||||
(define elem-count (length elem-ctcs))
|
||||
(unless (= (vector-length val) elem-count)
|
||||
(raise-blame-error blame val '(expected "a vector of ~a element~a," given: "~e")
|
||||
(raise-blame-error blame val '(expected: "a vector of ~a element~a" given: "~e")
|
||||
elem-count
|
||||
(if (= elem-count 1) "" "s")
|
||||
val)))
|
||||
|
|
|
|||
|
|
@ -232,7 +232,7 @@
|
|||
(unless (contract-first-order-passes? ctc val)
|
||||
(raise-blame-error
|
||||
blame val
|
||||
'(expected: "~s," given: "~e")
|
||||
'(expected: "~s" given: "~e")
|
||||
(contract-name ctc)
|
||||
val))
|
||||
(define accessor (base-generic-instance/c-accessor ctc))
|
||||
|
|
|
|||
|
|
@ -381,11 +381,11 @@
|
|||
[name (get-name ctc)])
|
||||
(λ (val fail [first-order? #f])
|
||||
(unless (pred val)
|
||||
(fail "expected a <~a>, got ~a" name val))
|
||||
(fail '(expected: "~a" given: "~e") name val))
|
||||
(when first-order?
|
||||
(for ([e (in-set val)])
|
||||
(unless (contract-first-order-passes? elem-ctc e)
|
||||
(fail "expected: ~s, got ~v" (contract-name elem-ctc) e))))
|
||||
(fail '(expected: "~a" given: "~e") (contract-name elem-ctc) e))))
|
||||
#t)))
|
||||
|
||||
(define (set/c-first-order ctc)
|
||||
|
|
|
|||
|
|
@ -1335,7 +1335,7 @@ use in the contract system:
|
|||
(raise-blame-error
|
||||
blame
|
||||
val
|
||||
'(expected "<integer>," given: "~e")
|
||||
'(expected: "<integer>" given: "~e")
|
||||
val))))
|
||||
]
|
||||
The new argument specifies who is to be blamed for
|
||||
|
|
@ -1366,7 +1366,7 @@ Compare that to the projection for our function contract:
|
|||
(raise-blame-error
|
||||
blame
|
||||
val
|
||||
'(expected "a procedure of one argument," given: "~e")
|
||||
'(expected "a procedure of one argument" given: "~e")
|
||||
val)))))
|
||||
]
|
||||
|
||||
|
|
@ -1424,7 +1424,7 @@ when a contract violation is detected.
|
|||
(raise-blame-error
|
||||
blame
|
||||
val
|
||||
'(expected "a procedure of one argument," given: "~e")
|
||||
'(expected "a procedure of one argument" given: "~e")
|
||||
val))))))
|
||||
]
|
||||
|
||||
|
|
@ -1443,9 +1443,11 @@ the contract library primitives below.
|
|||
x
|
||||
(raise-blame-error
|
||||
b x
|
||||
'(expected "<~a>," given: "~e")
|
||||
'(expected: "~a" given: "~e")
|
||||
name x))))]
|
||||
[#:stronger stronger (-> contract? contract? boolean?)])
|
||||
[#:stronger stronger
|
||||
(or/c #f (-> contract? contract? boolean?))
|
||||
#f])
|
||||
contract?]
|
||||
@defproc[(make-chaperone-contract
|
||||
[#:name name any/c 'anonymous-chaperone-contract]
|
||||
|
|
@ -1457,9 +1459,11 @@ the contract library primitives below.
|
|||
x
|
||||
(raise-blame-error
|
||||
b x
|
||||
'(expected "<~a>," given: "~e")
|
||||
'(expected: "~a" given: "~e")
|
||||
name x))))]
|
||||
[#:stronger stronger (-> contract? contract? boolean?)])
|
||||
[#:stronger stronger
|
||||
(or/c #f (-> contract? contract? boolean?))
|
||||
#f])
|
||||
chaperone-contract?]
|
||||
@defproc[(make-flat-contract
|
||||
[#:name name any/c 'anonymous-flat-contract]
|
||||
|
|
@ -1471,9 +1475,11 @@ the contract library primitives below.
|
|||
x
|
||||
(raise-blame-error
|
||||
b x
|
||||
'(expected "<~a>," given: "~e")
|
||||
'(expected: "~a" given: "~e")
|
||||
name x))))]
|
||||
[#:stronger stronger (-> contract? contract? boolean?)])
|
||||
[#:stronger stronger
|
||||
(or/c #f (-> contract? contract? boolean?))
|
||||
#f])
|
||||
flat-contract?]
|
||||
)]{
|
||||
|
||||
|
|
@ -1536,7 +1542,7 @@ was passed as the second argument to @racket[contract-stronger?].
|
|||
(λ (x) (range (f (domain x))))
|
||||
(raise-blame-error
|
||||
b f
|
||||
'(expected "a function of one argument," 'given: "~e")
|
||||
'(expected "a function of one argument" 'given: "~e")
|
||||
f)))))))
|
||||
(contract int->int/c "not fun" 'positive 'negative)
|
||||
(define halve
|
||||
|
|
@ -1724,6 +1730,11 @@ replacing @racket['given] with @racket["produced"] and
|
|||
@racket['expected] with @racket["promised"], depending on whether or not
|
||||
the @racket[b] argument has been swapped or not (see @racket[blame-swap]).
|
||||
|
||||
If @racket[fmt] contains the symbols @racket['given:] or @racket['expected:],
|
||||
they are replaced like @racket['given:] and @racket['expected:] are, but
|
||||
the replacements are prefixed with the string @racket["\n "] to conform
|
||||
to the error message guidelines in @secref["err-msg-conventions"].
|
||||
|
||||
}
|
||||
|
||||
@defstruct[(exn:fail:contract:blame exn:fail:contract) ([object blame?])]{
|
||||
|
|
@ -1826,7 +1837,7 @@ is expected to be the contract on the value).
|
|||
(if ((get-first-order c) x)
|
||||
x
|
||||
(raise-blame-error
|
||||
b x "expected <~a>, given: ~e" (get-name c) x)))))]
|
||||
b x '(expected: "~a" given: "~e") (get-name c) x)))))]
|
||||
[#:stronger
|
||||
stronger
|
||||
(or/c (-> contract? contract? boolean?) #f)
|
||||
|
|
@ -1854,7 +1865,7 @@ is expected to be the contract on the value).
|
|||
(if ((get-first-order c) x)
|
||||
x
|
||||
(raise-blame-error
|
||||
b x "expected <~a>, given: ~e" (get-name c) x)))))]
|
||||
b x '(expected: "~a" given: "~e") (get-name c) x)))))]
|
||||
[#:stronger
|
||||
stronger
|
||||
(or/c (-> contract? contract? boolean?) #f)
|
||||
|
|
@ -1882,7 +1893,7 @@ is expected to be the contract on the value).
|
|||
(if ((get-first-order c) x)
|
||||
x
|
||||
(raise-blame-error
|
||||
b x "expected <~a>, given: ~e" (get-name c) x)))))]
|
||||
b x '(expected: "~a" given: "~e") (get-name c) x)))))]
|
||||
[#:stronger
|
||||
stronger
|
||||
(or/c (-> contract? contract? boolean?) #f)
|
||||
|
|
|
|||
|
|
@ -22,7 +22,7 @@ particular required arity (e.g., @racket[call-with-input-file],
|
|||
@racket[exn:fail:contract] if the arity is incorrect.
|
||||
|
||||
@;----------------------------------------------------------------------
|
||||
@section{Error Message Conventions}
|
||||
@section[#:tag "err-msg-conventions"]{Error Message Conventions}
|
||||
|
||||
Racket's @deftech{error message convention} is to produce error
|
||||
messages with the following shape:
|
||||
|
|
|
|||
|
|
@ -3808,7 +3808,7 @@
|
|||
|
||||
(test/spec-passed/result
|
||||
'and/c-isnt
|
||||
'(and (regexp-match #rx"isn't even?"
|
||||
'(and (regexp-match #rx"isn't: even?"
|
||||
(with-handlers ((exn:fail? exn-message))
|
||||
(contract (and/c integer? even? positive?)
|
||||
-3
|
||||
|
|
@ -13156,8 +13156,10 @@ so that propagation occurs.
|
|||
(let* ([blame-pos (contract-eval '(make-blame #'here #f (λ () 'integer?) 'positive 'negative #t))]
|
||||
[blame-neg (contract-eval `(blame-swap ,blame-pos))])
|
||||
(ctest "something ~a" blame-fmt->-string ,blame-neg "something ~a")
|
||||
(ctest "promised: ~s; produced: ~e" blame-fmt->-string ,blame-pos '(expected: "~s;" given: "~e"))
|
||||
(ctest "expected: ~s; given: ~e" blame-fmt->-string ,blame-neg '(expected: "~s;" given: "~e")))
|
||||
(ctest "promised: ~s\n produced: ~e" blame-fmt->-string ,blame-pos '(expected: "~s" given: "~e"))
|
||||
(ctest "expected: ~s\n given: ~e" blame-fmt->-string ,blame-neg '(expected: "~s" given: "~e"))
|
||||
(ctest "promised ~s produced ~e" blame-fmt->-string ,blame-pos '(expected "~s" given "~e"))
|
||||
(ctest "expected ~s given ~e" blame-fmt->-string ,blame-neg '(expected "~s" given "~e")))
|
||||
|
||||
;
|
||||
;
|
||||
|
|
|
|||
|
|
@ -150,7 +150,7 @@
|
|||
(unless (sequence? seq)
|
||||
(raise-blame-error
|
||||
blame seq
|
||||
"expected a sequence, got: ~e"
|
||||
'(expected: "a sequence" given: "~e")
|
||||
seq))
|
||||
(make-do-sequence
|
||||
(lambda ()
|
||||
|
|
@ -163,7 +163,7 @@
|
|||
(unless (= n-elems n-cs)
|
||||
(raise-blame-error
|
||||
blame seq
|
||||
"expected a sequence of ~a values, got ~a values: ~s"
|
||||
'(expected: "a sequence of ~a values" given: "~a values\n values: ~e")
|
||||
n-cs n-elems elems))
|
||||
(apply
|
||||
values
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user