Fix type dictionary entries for overriden methods

Add typed Racket Esquire as a test case

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

@@ -1353,7 +1353,11 @@
       (define (update-dict type)
         (define entry (list type))
         (dict-set type-dict external entry))
-      (assign-type name expected annotation-table update-dict default-type)))
+      ;; only use the default type if the super-type doesn't already
+      ;; have an entry, e.g., for overrides
+      (define default (or (car (dict-ref type-dict external (list #f)))
+                          default-type))
+      (assign-type name expected annotation-table update-dict default)))
 
   (define-values (expected-inits expected-fields
                   expected-publics expected-augments

typed-racket-test/succeed/racket-esquire.rkt

@@ -0,0 +1,177 @@
+#lang typed/racket
+
+;; Racket Esquire: a mini DrRacket
+
+(require typed/racket/gui)
+
+;; The REPL editor class
+(define esq-text%
+  (class text%
+    ;; lexical access to inherited methods
+    (inherit insert last-position get-text erase)
+    ;; private fields
+    (define prompt-pos 0)
+    (define locked? #t)
+    ;; augment can-insert? to block pre-prompt inserts
+    (define/augment (can-insert? start len)
+      (and (>= start prompt-pos)
+           (not locked?)))
+    ;; augment can-delete? to block pre-prompt deletes
+    (define/augment (can-delete? start end)
+      (and (>= start prompt-pos)
+           (not locked?)))
+    ;; override on-char to detect Enter/Return
+    (define/override (on-char c)
+      (super on-char c)
+      (when (and (eq? (send c get-key-code)
+                      #\return)
+                 (not locked?))
+        (set! locked? #t)
+        (evaluate
+         (get-text prompt-pos
+                   (last-position)))))
+    ;; method to insert a new prompt
+    (: new-prompt (-> Void))
+    (define/public (new-prompt)
+      (queue-output
+       (lambda ()
+         (set! locked? #f)
+         (insert "> ")
+         (set! prompt-pos (last-position)))))
+     ;; method to display output
+    (: output (-> String Void))
+    (define/public (output str)
+      (queue-output
+       (lambda ()
+         (let ((was-locked? locked?))
+           (set! locked? #f)
+           (insert str)
+           (set! locked? was-locked?)))))
+    ;; method to reset the REPL
+    (: reset (-> Void))
+    (define/public (reset)
+      (set! locked? #f)
+      (set! prompt-pos 0)
+      (erase)
+      (new-prompt))
+
+    ;; initialize superclass-defined state
+    (super-new)
+    ;; create the initial prompt
+    (new-prompt)))
+
+;; Queueing REPL output as an event
+
+(define esq-eventspace (current-eventspace))
+
+(: queue-output (-> (-> Any) Void))
+(define (queue-output proc)
+  (parameterize ((current-eventspace
+                  esq-eventspace))
+    (queue-callback proc #f)))
+
+;; GUI creation
+
+(define frame
+  (make-object frame% "RacketEsq" #f 425 175))
+(define reset-button
+  (make-object button% "Reset" frame
+               (lambda (b e)
+                 (reset-program))))
+(define repl-editor (make-object esq-text%))
+
+(let ([s (send (send repl-editor get-style-list) find-named-style "Standard")])
+  (when s
+    (let ([d (make-object style-delta% 'change-size 24)])
+      (send s set-delta d))))
+
+(define repl-display-canvas
+  (make-object editor-canvas% frame))
+(send repl-display-canvas set-editor repl-editor)
+(send frame show #t)
+
+;; User space initialization
+
+(define user-custodian (make-custodian))
+
+(define user-output-port
+  (make-output-port
+   'stdout
+   ;; always ready
+   always-evt
+   ;; string printer
+   (lambda ([s : Bytes] [start : Integer] [end : Integer] nonblock? w/break?)
+     (send repl-editor output (bytes->string/utf-8 (subbytes s start end)))
+     (- end start))
+   ;; closer
+   (lambda () 'nothing-to-close)))
+
+(define user-eventspace
+  (parameterize ((current-custodian user-custodian))
+    (make-eventspace)))
+
+(define user-namespace
+  (make-gui-namespace))
+
+(define esq-inspector (current-inspector))
+(define user-inspector (make-inspector))
+
+;; Evaluation and resetting
+
+(: evaluate (-> String Void))
+(define (evaluate expr-str)
+  (parameterize ((current-eventspace user-eventspace))
+    (queue-callback
+     (lambda ()
+       (current-command-line-arguments #())
+       (current-output-port user-output-port)
+       (current-namespace user-namespace)
+       (current-inspector user-inspector)
+       (exit-handler (lambda (v) (reset-program)))
+       (with-handlers ((exn?
+                        (lambda ([e : exn])
+                          (display
+                           (exn-message e))
+                          (show-where
+                           (exn-continuation-marks e)))))
+         (call-with-values
+          (lambda ()
+            (eval (instrument
+                   (cast (read (open-input-string
+                                expr-str))
+                         Sexp))))
+          (lambda args
+            (parameterize ((current-inspector user-inspector))
+              (write (car args))))))
+       (newline)
+       (send repl-editor new-prompt)))))
+
+(: reset-program (-> Void))
+(define (reset-program)
+  (custodian-shutdown-all user-custodian)
+  (set! user-custodian (make-custodian))
+  (parameterize ((current-custodian user-custodian))
+    (set! user-eventspace (make-eventspace)))
+  (set! user-namespace (make-gui-namespace))
+  (send repl-editor reset))
+
+;; Definition source instrumentation
+
+(define where-key (gensym))
+
+(: instrument (-> Sexp Sexp))
+(define (instrument expr)
+  (if (and (pair? expr)
+           (eq? 'define (car expr))
+           (pair? (cdr expr))
+           (pair? (cadr expr)))
+      `(define ,(cadr expr)
+         (with-continuation-mark ',where-key ',(caadr expr)
+           ,@(cddr expr)))
+      expr))
+
+(: show-where (-> Continuation-Mark-Set Void))
+(define (show-where cm)
+  (let ([l (continuation-mark-set->list cm where-key)])
+    (unless (null? l)
+      (printf " in ~a" (car l)))))