diff --git a/pkgs/racket-test/tests/racket/contract/class.rkt b/pkgs/racket-test/tests/racket/contract/class.rkt index abc7286ba3..26fd95fc4b 100644 --- a/pkgs/racket-test/tests/racket/contract/class.rkt +++ b/pkgs/racket-test/tests/racket/contract/class.rkt @@ -2529,9 +2529,14 @@ (regexp-match? #rx"expected: boolean[?]" (exn-message exn)) (regexp-match? #rx"given: 1" (exn-message exn))))] [promised-produced? - (λ (exn) (and (regexp-match? #rx"callback: broke its contract" (exn-message exn)) - (regexp-match? #rx"promised: boolean[?]" (exn-message exn)) - (regexp-match? #rx"produced: 1" (exn-message exn))))]) + (λ (exn) + (define ans + (and (regexp-match? #rx"callback: broke its own contract" (exn-message exn)) + (regexp-match? #rx"promised: boolean[?]" (exn-message exn)) + (regexp-match? #rx"produced: 1" (exn-message exn)))) + (unless ans + (printf "~a\n" (exn-message exn))) + ans)]) (contract-error-test 'blame-important1 '(send (new (contract (class/c [callback (->m boolean? void)]) diff --git a/pkgs/racket-test/tests/racket/contract/context.rkt b/pkgs/racket-test/tests/racket/contract/context.rkt index 3ffee7bc23..98b1adc031 100644 --- a/pkgs/racket-test/tests/racket/contract/context.rkt +++ b/pkgs/racket-test/tests/racket/contract/context.rkt @@ -94,13 +94,13 @@ 'neg)) 1)) - (context-test '("a disjunct of") + (context-test '("a part of the or/c of") '(contract (or/c 1 (-> number? number?)) 3 'pos 'neg)) - (context-test '("the range of" "a disjunct of") + (context-test '("the range of" "a part of the or/c of") '((contract (or/c 1 (-> number? number?) (-> number? boolean? number?)) (λ (x) #f) 'pos diff --git a/pkgs/racket-test/tests/racket/contract/contract-out.rkt b/pkgs/racket-test/tests/racket/contract/contract-out.rkt index be152fc06a..d995ad3f13 100644 --- a/pkgs/racket-test/tests/racket/contract/contract-out.rkt +++ b/pkgs/racket-test/tests/racket/contract/contract-out.rkt @@ -1007,7 +1007,7 @@ (eval '(require 'pce1-bug))) (λ (x) (and (exn:fail:contract:blame? x) - (regexp-match #rx"the-defined-variable1: broke its contract" (exn-message x))))) + (regexp-match #rx"the-defined-variable1: broke its own contract" (exn-message x))))) (contract-error-test 'contract-error-test9 diff --git a/racket/collects/racket/contract/private/arrow.rkt b/racket/collects/racket/contract/private/arrow.rkt index af3ded728a..c27630dfff 100644 --- a/racket/collects/racket/contract/private/arrow.rkt +++ b/racket/collects/racket/contract/private/arrow.rkt @@ -396,9 +396,13 @@ [else (define arity-string (if max-arity - (if (= min-method-arity max-method-arity) - (format "~a non-keyword argument~a" min-method-arity (if (= min-method-arity 1) "" "s")) - (format "~a to ~a non-keyword arguments" min-method-arity max-method-arity)) + (cond + [(= min-method-arity max-method-arity) + (format "~a non-keyword argument~a" min-method-arity (if (= min-method-arity 1) "" "s"))] + [(= (+ min-method-arity 1) max-method-arity) + (format "~a or ~a non-keyword arguments" min-method-arity max-method-arity)] + [else + (format "~a to ~a non-keyword arguments" min-method-arity max-method-arity)]) (format "at least ~a non-keyword argument~a" min-method-arity (if (= min-method-arity 1) "" "s")))) (define-values (vr va) (procedure-keywords val)) (define all-kwds (append req-kwd opt-kwd)) @@ -432,7 +436,7 @@ (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 @@ -445,7 +449,7 @@ (for ([k (in-list kwds)]) (unless (memq k all-kwds) (raise-blame-error (blame-swap blame) val - "received unexpected keyword argument ~a" + '(received: "unexpected keyword argument ~a") k))) (keyword-apply kwd-lambda kwds kwd-args args)))))) (define basic-checker-name @@ -457,7 +461,7 @@ (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 diff --git a/racket/collects/racket/contract/private/blame.rkt b/racket/collects/racket/contract/private/blame.rkt index 2a2a997fed..700576e1c4 100644 --- a/racket/collects/racket/contract/private/blame.rkt +++ b/racket/collects/racket/contract/private/blame.rkt @@ -226,6 +226,10 @@ [(eq? 'expected fst) (if (blame/important-original? blame) "promised" "expected")] + [(eq? 'received: fst) (add-indent + (if (blame/important-original? blame) + "supplied:" + "received:"))] [else fst])) (define new-so-far (if (or last-ended-in-whitespace? @@ -269,7 +273,7 @@ (define self-or-not (if (blame/important-original? blme) - "broke its contract" + "broke its own contract" "contract violation")) (define start-of-message diff --git a/racket/collects/racket/contract/private/orc.rkt b/racket/collects/racket/contract/private/orc.rkt index ff74567209..63f5ed95a6 100644 --- a/racket/collects/racket/contract/private/orc.rkt +++ b/racket/collects/racket/contract/private/orc.rkt @@ -79,7 +79,7 @@ (p-app val))))) (define (blame-add-or-context blame) - (blame-add-context blame "a disjunct of")) + (blame-add-context blame "a part of the or/c of")) (define (single-or/c-first-order ctc) (let ([pred (single-or/c-pred ctc)] @@ -231,7 +231,7 @@ [first-order-checks (map (λ (x) (contract-first-order x)) ho-contracts)] [predicates (map flat-contract-predicate (multi-or/c-flat-ctcs ctc))]) (λ (blame) - (define disj-blame (blame-add-context blame "a disjunct of")) + (define disj-blame (blame-add-context blame "a part of the or/c of")) (define partial-contracts (for/list ([c-proc (in-list c-procs)]) (c-proc disj-blame)))