From 8a0b6549a5f9ca0baffc09707369df0ef72bd5d8 Mon Sep 17 00:00:00 2001 From: Robby Findler Date: Sun, 5 Aug 2012 20:06:49 -0500 Subject: [PATCH] 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 --- collects/racket/contract/private/arrow.rkt | 10 ++--- .../racket/contract/private/basic-opters.rkt | 2 +- collects/racket/contract/private/blame.rkt | 38 +++++++++++-------- collects/racket/contract/private/box.rkt | 6 +-- collects/racket/contract/private/ds.rkt | 6 +-- collects/racket/contract/private/hash.rkt | 8 ++-- collects/racket/contract/private/misc.rkt | 26 ++++++------- collects/racket/contract/private/opters.rkt | 8 ++-- .../racket/contract/private/parametric.rkt | 4 +- collects/racket/contract/private/prop.rkt | 2 +- .../racket/contract/private/struct-dc.rkt | 7 ++-- .../racket/contract/private/struct-prop.rkt | 2 +- collects/racket/contract/private/vector.rkt | 14 +++---- collects/racket/private/generic.rkt | 2 +- collects/racket/set.rkt | 4 +- .../scribblings/reference/contracts.scrbl | 37 +++++++++++------- collects/scribblings/reference/exns.scrbl | 2 +- collects/tests/racket/contract-test.rktl | 8 ++-- collects/unstable/contract.rkt | 4 +- 19 files changed, 105 insertions(+), 85 deletions(-) diff --git a/collects/racket/contract/private/arrow.rkt b/collects/racket/contract/private/arrow.rkt index 60402da0b3..55ed632f0e 100644 --- a/collects/racket/contract/private/arrow.rkt +++ b/collects/racket/contract/private/arrow.rkt @@ -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"] diff --git a/collects/racket/contract/private/basic-opters.rkt b/collects/racket/contract/private/basic-opters.rkt index 4406e5eb4e..90c242914d 100644 --- a/collects/racket/contract/private/basic-opters.rkt +++ b/collects/racket/contract/private/basic-opters.rkt @@ -93,7 +93,7 @@ (raise-blame-error blame val - '(expected: "~s," given: "~e") + '(expected: "~s" given: "~e") (contract-name ctc) val))) #:lifts diff --git a/collects/racket/contract/private/blame.rkt b/collects/racket/contract/private/blame.rkt index 770749d112..e1b036fe32 100644 --- a/collects/racket/contract/private/blame.rkt +++ b/collects/racket/contract/private/blame.rkt @@ -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 diff --git a/collects/racket/contract/private/box.rkt b/collects/racket/contract/private/box.rkt index 4ea01f7c16..c2512cac9b 100644 --- a/collects/racket/contract/private/box.rkt +++ b/collects/racket/contract/private/box.rkt @@ -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) diff --git a/collects/racket/contract/private/ds.rkt b/collects/racket/contract/private/ds.rkt index 1cee054dcd..dba2490847 100644 --- a/collects/racket/contract/private/ds.rkt +++ b/collects/racket/contract/private/ds.rkt @@ -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) diff --git a/collects/racket/contract/private/hash.rkt b/collects/racket/contract/private/hash.rkt index 95d188a393..b88c4da0ac 100644 --- a/collects/racket/contract/private/hash.rkt +++ b/collects/racket/contract/private/hash.rkt @@ -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) diff --git a/collects/racket/contract/private/misc.rkt b/collects/racket/contract/private/misc.rkt index ce0ba7f162..294fe59a35 100644 --- a/collects/racket/contract/private/misc.rkt +++ b/collects/racket/contract/private/misc.rkt @@ -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 "," given: "~e") + '(expected "" 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 "," given: "~e") + '(expected: "" 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)))) diff --git a/collects/racket/contract/private/opters.rkt b/collects/racket/contract/private/opters.rkt index 5ea37a8e59..cd9027d64c 100644 --- a/collects/racket/contract/private/opters.rkt +++ b/collects/racket/contract/private/opters.rkt @@ -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"))) diff --git a/collects/racket/contract/private/parametric.rkt b/collects/racket/contract/private/parametric.rkt index 3f7af29e6a..f71085be3c 100644 --- a/collects/racket/contract/private/parametric.rkt +++ b/collects/racket/contract/private/parametric.rkt @@ -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)))))))) diff --git a/collects/racket/contract/private/prop.rkt b/collects/racket/contract/private/prop.rkt index 287203d4a0..191134d068 100644 --- a/collects/racket/contract/private/prop.rkt +++ b/collects/racket/contract/private/prop.rkt @@ -262,7 +262,7 @@ (if (first-order x) x (raise-blame-error b x - '(expected: "~s," given: "~e") + '(expected: "~s" given: "~e") name x)))))) diff --git a/collects/racket/contract/private/struct-dc.rkt b/collects/racket/contract/private/struct-dc.rkt index 7c5446d7f6..0d3eb22f1a 100644 --- a/collects/racket/contract/private/struct-dc.rkt +++ b/collects/racket/contract/private/struct-dc.rkt @@ -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) diff --git a/collects/racket/contract/private/struct-prop.rkt b/collects/racket/contract/private/struct-prop.rkt index 952517b5ac..4247163d0d 100644 --- a/collects/racket/contract/private/struct-prop.rkt +++ b/collects/racket/contract/private/struct-prop.rkt @@ -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 diff --git a/collects/racket/contract/private/vector.rkt b/collects/racket/contract/private/vector.rkt index 341dae268e..6155074821 100644 --- a/collects/racket/contract/private/vector.rkt +++ b/collects/racket/contract/private/vector.rkt @@ -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))) diff --git a/collects/racket/private/generic.rkt b/collects/racket/private/generic.rkt index f6bbe42762..8cfbffaadd 100644 --- a/collects/racket/private/generic.rkt +++ b/collects/racket/private/generic.rkt @@ -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)) diff --git a/collects/racket/set.rkt b/collects/racket/set.rkt index 9f6477d966..48b95e07e4 100644 --- a/collects/racket/set.rkt +++ b/collects/racket/set.rkt @@ -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) diff --git a/collects/scribblings/reference/contracts.scrbl b/collects/scribblings/reference/contracts.scrbl index c3717690e3..78ab309e2a 100644 --- a/collects/scribblings/reference/contracts.scrbl +++ b/collects/scribblings/reference/contracts.scrbl @@ -1335,7 +1335,7 @@ use in the contract system: (raise-blame-error blame val - '(expected "," given: "~e") + '(expected: "" 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) diff --git a/collects/scribblings/reference/exns.scrbl b/collects/scribblings/reference/exns.scrbl index 92af78a24b..021f4692ca 100644 --- a/collects/scribblings/reference/exns.scrbl +++ b/collects/scribblings/reference/exns.scrbl @@ -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: diff --git a/collects/tests/racket/contract-test.rktl b/collects/tests/racket/contract-test.rktl index a998f5f9fb..fdcd7f0390 100644 --- a/collects/tests/racket/contract-test.rktl +++ b/collects/tests/racket/contract-test.rktl @@ -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"))) ; ; diff --git a/collects/unstable/contract.rkt b/collects/unstable/contract.rkt index 1824c779b6..81f6a7f1c0 100644 --- a/collects/unstable/contract.rkt +++ b/collects/unstable/contract.rkt @@ -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