From 64515f386a2d9f8ef3993cf8889b018fc3f8bad8 Mon Sep 17 00:00:00 2001
From: Asumu Takikawa <asumu@ccs.neu.edu>
Date: Wed, 5 Mar 2014 01:43:18 -0500
Subject: [PATCH] TR: better error for invalid super-make-object

original commit: 994648c556e026df55d95bddf017b9a5ce723688
---
 .../typed-racket/typecheck/check-class-unit.rkt          | 9 +++++++--
 .../tests/typed-racket/unit-tests/class-tests.rkt        | 3 +++
 2 files changed, 10 insertions(+), 2 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 23ce3b82..eb0eed06 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
@@ -1132,8 +1132,13 @@
   (cond [;; too many init arguments, and no init-rest
            (and (not super-init-rest) (> pos-length (length super-inits)))
            (values super-init-rest
-                   (tc-error/expr "too many positional init arguments provided"
-                                  #:return null))]
+                   (tc-error/expr/fields
+                    "invalid `super-make-object' or `super-instantiate'"
+                    #:more "too many positional init arguments provided"
+                    "expected" (length super-inits)
+                    "given" pos-length
+                    #:stx #`(#,@provided-pos-args)
+                    #:return null))]
           [;; no remaining by-name inits, so change the init-rest type
            ;; and return a null remaining named inits list
            (> pos-length (length super-inits))
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 b5ba0cec..568e5d71 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
@@ -1245,6 +1245,9 @@
                           (init-rest [rst : (List Symbol)])))
              (make-object c% "wrong"))
            #:msg #rx"expected: Symbol.*given: String"]
+   ;; fail, too many positional arguments to superclass
+   [tc-err (class object% (super-make-object "foo"))
+           #:msg #rx"too many positional init arguments"]
    ;; check that case-lambda methods work
    [tc-e (let ()
            (class object%