Better error messages for class/object contracts

pkgs/racket-pkgs/racket-test/tests/racket/contract/class.rkt

@@ -1748,4 +1748,24 @@
      (class object%
        (super-new)
        (define/public (callback f) (f 1))))
-   promised-produced?)))
+   promised-produced?))
+
+(let ([expected-obj
+       (λ (exn) (regexp-match? #rx"promised: an object" (exn-message exn)))]
+      [expected-class
+       (λ (exn) (regexp-match? #rx"promised: a class" (exn-message exn)))])
+  (contract-error-test
+   'not-an-object-1
+   '(contract (object/c) 3 'pos 'neg)
+   expected-obj)
+
+  (contract-error-test
+   'not-an-object-2
+   '(contract (instanceof/c (class/c)) 3 'pos 'neg)
+   expected-obj)
+
+  (contract-error-test
+   'not-a-class-1
+   '(contract (class/c) 3 'pos 'neg)
+   expected-class)))
+

racket/collects/racket/private/class-internal.rkt

@@ -2758,7 +2758,7 @@ An example
 
 (define (class/c-check-first-order ctc cls fail)
   (unless (class? cls)
-    (fail "not a class"))
+    (fail '(expected: "a class" given: "~v") cls))
   (let ([method-ht (class-method-ht cls)]
         [beta-methods (class-beta-methods cls)]
         [meth-flags (class-meth-flags cls)]) 
@@ -3516,7 +3516,7 @@ An example
 
 (define (check-object-contract obj methods fields fail)
   (unless (object? obj)
-    (fail "not a object"))
+    (fail '(expected: "an object" given: "~e") obj))
   (let ([cls (object-ref obj)])
     (let ([method-ht (class-method-ht cls)])
       (for ([m methods])
@@ -3580,7 +3580,7 @@ An example
       (let ([p (proj blame)])
         (λ (val)
           (unless (object? val)
-            (raise-blame-error blame val "expected an object, got ~v" val))
+            (raise-blame-error blame val '(expected: "an object" given: "~e") val))
           (let ([original-obj (if (has-original-object? val) (original-object val) val)]
                 [new-cls (p (object-ref val))])
             (impersonate-struct val object-ref (λ (o c) new-cls)