From 133a961596ca871d78c597d7e4d27a8291c9087d Mon Sep 17 00:00:00 2001
From: Asumu Takikawa <asumu@ccs.neu.edu>
Date: Thu, 27 Feb 2014 18:14:49 -0500
Subject: [PATCH] Fix a TR bug for row polymorphic application

The domains in a row polymorphic function weren't checked
properly when row inference was used.

original commit: 32f09c35705206a281fcd1f02b968c7ad02ece69
---
 .../typed-racket/typecheck/tc-funapp.rkt               | 10 +++-------
 .../tests/typed-racket/unit-tests/class-tests.rkt      |  8 ++++++++
 2 files changed, 11 insertions(+), 7 deletions(-)

diff --git a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-funapp.rkt b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-funapp.rkt
index ab15b4f7..00a9fc76 100644
--- a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-funapp.rkt
+++ b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-funapp.rkt
@@ -119,9 +119,7 @@
        (and t (PolyRow:
                vars
                constraints
-               (Function: (list (and arrs (arr: doms rngs rests (and drests #f)
-                                                (list (Keyword: _ _ kw?) ...)))
-                                ...)))))
+               (and f-ty (Function: (list (arr: doms _ _ #f _) ...))))))
       (list (tc-result1: argtys-t) ...))
      (define (fail)
        (poly-fail f-stx args-stx t argtys
@@ -149,10 +147,8 @@
             (define substitution
               (hash row-var
                     (t-subst (infer-row constraints (list-ref argtys-t idx)))))
-            (or (for/or ([arr (in-list arrs)])
-                  (tc/funapp1 f-stx args-stx (subst-all substitution arr)
-                              argtys expected #:check #f))
-                (fail))]
+            (tc/funapp f-stx args-stx (ret (subst-all substitution f-ty))
+                       argtys expected)]
            [else (fail)])]
     ;; procedural structs
     [((tc-result1: (and sty (Struct: _ _ _ (? Function? proc-ty) _ _))) _)
diff --git a/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/class-tests.rkt b/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/class-tests.rkt
index 87ad98f2..3336fe4f 100644
--- a/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/class-tests.rkt
+++ b/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/class-tests.rkt
@@ -835,6 +835,14 @@
                (inst f #:row (field [y Integer])))
              (instantiated
               (class object% (super-new))))]
+   ;; fails, the argument object lacks required fields (with inference)
+   [tc-err (let ()
+             (: mixin (All (r #:row)
+                         (-> (Class (field [x Any]) #:row-var r)
+                             (Class (field [x Any]) #:row-var r))))
+             (define (mixin cls) cls)
+             (mixin object%))
+           #:msg (regexp-quote "expected: (Class (field (x Any)))")]
    ;; mixin application succeeds
    [tc-e (let ()
            (: f (All (A #:row (field x))