improve error messages from contract system

closes PR 15057

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))
+         (λ (exn)
-                       (regexp-match? #rx"promised: boolean[?]" (exn-message exn))
+           (define ans
-                       (regexp-match? #rx"produced: 1" (exn-message exn))))])
+             (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)])

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

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

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)
+           (cond
-               (format "~a non-keyword argument~a" min-method-arity (if (= min-method-arity 1) "" "s"))
+             [(= min-method-arity max-method-arity)
-               (format "~a to ~a non-keyword arguments" 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

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

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)))