From 088a59038ad5c62efcd68a2729ba7a4a1a7baded Mon Sep 17 00:00:00 2001
From: Asumu Takikawa <asumu@ccs.neu.edu>
Date: Fri, 21 Nov 2014 13:51:50 -0500
Subject: [PATCH] Fix `infer-self-type` for depth overriden methods

When an overriden method implements a subtype of the superclass
type, sometimes the typechecker gets confused what the type should
be in the resulting class type.

original commit: 85b70aef7f66f0e0c8716fca716d1e38478bf763
---
 .../typecheck/check-class-unit.rkt             | 10 ++++++++--
 .../typed-racket/unit-tests/class-tests.rkt    | 18 +++++++++++++++++-
 2 files changed, 25 insertions(+), 3 deletions(-)

diff --git a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/check-class-unit.rkt b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/check-class-unit.rkt
index 26e66fae..c137d03b 100644
--- a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/check-class-unit.rkt
+++ b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/check-class-unit.rkt
@@ -1350,17 +1350,23 @@
       [(Class: _ inits fields publics augments init-rest)
        (values inits fields publics augments init-rest)]
       [_ (values #f #f #f #f #f)]))
-  (define-values (inits fields publics pubments init-rest-name)
+  (define-values (inits fields publics pubments overrides init-rest-name)
     (values (hash-ref parse-info 'init-internals)
             (hash-ref parse-info 'field-internals)
             (hash-ref parse-info 'public-internals)
             (hash-ref parse-info 'pubment-internals)
+            (hash-ref parse-info 'override-internals)
             (hash-ref parse-info 'init-rest-name)))
   (define init-types (make-inits inits super-inits expected-inits))
   (define field-types (make-type-dict fields super-fields expected-fields Univ))
-  (define public-types (make-type-dict (append publics pubments)
+
+  ;; This should consider all new public methods, but should also look at
+  ;; overrides to ensure that if an overriden method has a more specific type
+  ;; (via depth subtyping) then it's accounted for.
+  (define public-types (make-type-dict (append publics pubments overrides)
                                        super-methods expected-publics
                                        top-func))
+
   (define augment-types (make-type-dict
                          pubments super-augments expected-augments top-func
                          #:annotations-from augment-annotation-table))
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 1e6fb286..c7b37639 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
@@ -1667,4 +1667,20 @@
                (super-new)
                (define/override (get-this) this)))
            (void))
-         -Void]))
+         -Void]
+   ;; Test that depth subtyping is accounted for with overriden methods
+   [tc-e (let ()
+           (define-type-alias B% (Class [n (-> Real)]))
+           (: b% B%)
+           (define b%
+             (class object%
+               (super-new)
+               (define/public (n) 123.456)))
+           (define-type-alias C% (Class #:implements B% [n (-> Integer)]))
+           (: c% C%)
+           (define c%
+             (class b%
+               (super-new)
+               (override* [n (lambda () 5)])))
+           (send (new c%) n))
+         -Integer]))