diff --git a/typed-racket-lib/typed-racket/private/type-contract.rkt b/typed-racket-lib/typed-racket/private/type-contract.rkt index a8f91801..ac229ac8 100644 --- a/typed-racket-lib/typed-racket/private/type-contract.rkt +++ b/typed-racket-lib/typed-racket/private/type-contract.rkt @@ -462,7 +462,7 @@ override-names (map t->sc/meth override-types)) (map (λ (n sc) (member-spec 'pubment n sc)) pubment-names (map t->sc/meth pubment-types)) - (map (λ (n sc) (member-spec 'augment n sc)) + (map (λ (n sc) (member-spec 'inner n sc)) augment-names (map t->sc/meth augment-types)) (map (λ (n sc) (member-spec 'init n sc)) init-names (map t->sc/neg init-types)) diff --git a/typed-racket-lib/typed-racket/static-contracts/combinators/object.rkt b/typed-racket-lib/typed-racket/static-contracts/combinators/object.rkt index b531f930..60dab6bd 100644 --- a/typed-racket-lib/typed-racket/static-contracts/combinators/object.rkt +++ b/typed-racket-lib/typed-racket/static-contracts/combinators/object.rkt @@ -114,7 +114,7 @@ (if sc #`(#,id #,(f sc)) id)) (match modifier ['method id/ctc] - ['augment #`(augment #,id/ctc)] + ['inner #`(inner #,id/ctc)] ['init #`(init #,id/ctc)] ['field #`(field #,id/ctc)]))])) @@ -158,6 +158,7 @@ (super [override-name override-temp] ...) (inherit [override-name override-temp] ...) [pubment-name pubment-temp] ... + (augment [pubment-name pubment-temp] ...) (inherit [pubment-name pubment-temp] ...)))])) (define (instance/sc->contract v f) (match v diff --git a/typed-racket-test/fail/class-contract-1.rkt b/typed-racket-test/fail/class-contract-1.rkt new file mode 100644 index 00000000..d2d50302 --- /dev/null +++ b/typed-racket-test/fail/class-contract-1.rkt @@ -0,0 +1,19 @@ +#; +(exn-pred #rx"promised: String.*produced: 'not-a-string") +#lang racket + +;; Ensure contracts for inner work correctly + +(module t typed/racket + (provide c%) + (define c% + (class object% + (super-new) + (: m (-> Void) #:augment (-> String)) + (define/pubment (m) (inner "hi" m) (void))))) + +(require (submod "." t)) +(send (new (class c% + (super-new) + (define/augment (m) 'not-a-string))) + m) diff --git a/typed-racket-test/succeed/class-contract.rkt b/typed-racket-test/succeed/class-contract.rkt index 628089cc..f39d28ee 100644 --- a/typed-racket-test/succeed/class-contract.rkt +++ b/typed-racket-test/succeed/class-contract.rkt @@ -26,5 +26,19 @@ [c% (Class [m (All (X) (-> X (Listof X)))])]) (car (send (new c%) m 3))) +;; ensure that inner/augment work right +(module t3 typed/racket + (define c% + (class object% + (super-new) + (: m (-> Void) #:augment (-> Integer Void)) + (define/pubment (m) (void)))) + (provide c%)) + +(module u3 racket + (require (submod ".." t3)) + (new c%)) + (require 'u1) (require 't2) +(require 'u3)