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 f81169198f..4ce3eee45d 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 @@ -911,21 +911,29 @@ [_ '()])) ;; register-internals : Listof -> Dict -;; Find : annotations and register them +;; Find : annotations and register them, error if duplicates are found ;; TODO: support `define-type`? (define (register-internals stxs) - (for/fold ([table '()]) - ([stx stxs]) + (for/fold ([table #hash()]) ([stx stxs]) (syntax-parse stx #:literals (let-values begin quote-syntax :-internal #%plain-app values void) [(let-values ((() (begin - (quote-syntax (:-internal name:id type:expr)) + (quote-syntax (:-internal name-stx:id type-stx:expr)) (#%plain-app values)))) (#%plain-app void)) - (cons (cons (syntax-e #'name) (parse-type #'type)) - table)] + (define name (syntax-e #'name-stx)) + (define type (parse-type #'type-stx)) + (cond [(and (hash-has-key? table name) + (not (equal? (hash-ref table name) + type))) + (tc-error/expr + #:stx #'name + "Duplicate type annotation of ~a for ~a, previous was ~a" + type name (hash-ref table name)) + table] + [else (hash-set table name type)])] [_ table]))) ;; infer-self-type : Dict Set Dict 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 e2304f9d18..a31370e63e 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 @@ -1028,5 +1028,12 @@ (class object% (super-new) (field [(x y) : Integer 0]))) - (+ 1 (get-field y (new c%)))))) + (+ 1 (get-field y (new c%)))) + + ;; fails, duplicate type annotation + (check-err #:exn #rx"Duplicate type annotation of Real" + (class object% + (super-new) + (: x Real) + (field [x : Integer 0])))))