Propagate expected types better for private fields

Closes PR 14911

typed-racket-lib/typed-racket/typecheck/check-class-unit.rkt

@@ -953,15 +953,28 @@
                   (#%plain-app local-setter:id obj2:id y:id)))))
        #:when (free-identifier=? #'x #'y)
        #:when (free-identifier=? #'obj1 #'obj2)
-       ;; Remove wcm for checking since TR can't handle these cases
-       (define simplified
-         (syntax/loc form
-           (let-values (((obj1) self))
-             (let-values (((x) init-val))
-               (#%plain-app local-setter obj2 y)))))
-       (tc-expr simplified)]
+       ;; Only check init-val, trust that the rest is well-formed.
+       ;; Extracting the field type from the setter and using
+       ;; tc-expr/check propagates expected types better than
+       ;; checking the whole expression. It's also hard to extract
+       ;; the field type from a table since we don't know which
+       ;; field this setter corresponds to (except via the local
+       ;; binding name in the `let-values` which doesn't seem
+       ;; very reliable).
+       (define type (setter->type #'local-setter))
+       (tc-expr/check #'init-val (ret type))]
       [_ (void)])))
 
+;; setter->type : Id -> Type
+;; Determine the field type based on its private setter name
+;; (assumption: the type environment maps this name already)
+(define (setter->type id)
+  (define f-type (lookup-type/lexical id))
+  (match f-type
+    [(Function: (list (arr: (list _ type) _ _ _ _)))
+     type]
+    [#f (int-err "setter->type ~a" (syntax-e id))]))
+
 ;; check-init-arg : Id Type Syntax -> Void
 ;; Check the initialization of an init arg variable against the
 ;; expected type provided by an annotation (or the default)

typed-racket-test/unit-tests/class-tests.rkt

@@ -529,7 +529,7 @@
                (: f (-> String))
                (define (f) 'bad))
              (error "foo"))
-           #:msg #rx"type mismatch.*expected: \\(-> String\\)"]
+           #:msg #rx"type mismatch.*expected: String"]
    ;; multiple names in define-values private fields
    [tc-e (class object%
            (super-new)
@@ -1693,4 +1693,11 @@
    [tc-e (class object%
            (super-new)
            (define/public foo (case-lambda [(str) (void)] [(sym size) (void)])))
-         (-class #:method [(foo (cl->* (t:-> Univ Univ -Void) (t:-> Univ -Void)))])]))
+         (-class #:method [(foo (cl->* (t:-> Univ Univ -Void) (t:-> Univ -Void)))])]
+   ;; PR 14911
+   [tc-e (class object%
+           (super-new)
+           (: bar (-> String String))
+           (define bar (lambda (x) x))
+           (bar "foo"))
+         (-class)]))