From a6daafd70a58a988f3c7c6795eb56ce84d541882 Mon Sep 17 00:00:00 2001 From: Asumu Takikawa Date: Fri, 8 Nov 2013 13:58:43 -0500 Subject: [PATCH] Use `class` instead of `class:` for typed classes --- .../typed-racket/base-env/base-env.rkt | 2 +- .../typed-racket/base-env/class-prims.rkt | 15 +- .../typed-racket/base-env/prims.rkt | 2 +- .../typecheck/check-class-unit.rkt | 8 +- .../typed-racket/unit-tests/class-tests.rkt | 282 +++++++++--------- 5 files changed, 154 insertions(+), 155 deletions(-) diff --git a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/base-env/base-env.rkt b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/base-env/base-env.rkt index 2e28429fc4..7b662d1d43 100644 --- a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/base-env/base-env.rkt +++ b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/base-env/base-env.rkt @@ -4,7 +4,7 @@ (require (for-template - (except-in racket -> ->* one-of/c) + (except-in racket -> ->* one-of/c class) racket/unsafe/ops ;(only-in rnrs/lists-6 fold-left) '#%paramz diff --git a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/base-env/class-prims.rkt b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/base-env/class-prims.rkt index 164799b6a8..42945432f3 100644 --- a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/base-env/class-prims.rkt +++ b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/base-env/class-prims.rkt @@ -2,7 +2,7 @@ ;; This module provides TR primitives for classes and objects -(require racket/class +(require (rename-in racket/class [class untyped-class]) (for-syntax racket/base racket/class @@ -22,14 +22,14 @@ "../types/utils.rkt")) (provide ;; Typed class macro that coordinates with TR - class: + class ;; for use in ~literal clauses - class:-internal + class-internal optional-init private-field) ;; give it a binding, but it shouldn't be used directly -(define-syntax (class:-internal stx) +(define-syntax (class-internal stx) (raise-syntax-error "should only be used internally")) (define-syntax (optional-init stx) @@ -225,11 +225,10 @@ (hash #'public (list #'(f f) #'(g g) #'(h h)) #'init (list #'(x x) #'(y y) #'(z z))))))) -(define-syntax (class: stx) +(define-syntax (class stx) (syntax-parse stx [(_ super e ...) (define class-context (generate-class-expand-context)) - ;; do a local expansion for class: (define (class-expand stx) (local-expand stx class-context stop-forms)) ;; FIXME: potentially needs to expand super clause? @@ -254,7 +253,7 @@ #,(internal ;; FIXME: maybe put this in a macro and/or a syntax class ;; so that it's easier to deal with - #`(class:-internal + #`(class-internal (init #,@(dict-ref name-dict #'init '())) (init-field #,@(dict-ref name-dict #'init-field '())) (optional-init #,@optional-inits) @@ -266,7 +265,7 @@ (inherit #,@(dict-ref name-dict #'inherit '())) (augment #,@(dict-ref name-dict #'augment '())) (pubment #,@(dict-ref name-dict #'pubment '())))) - (class #,annotated-super + (untyped-class #,annotated-super #,@(map clause-stx clauses) #,@(map non-clause-stx annotated-methods) #,(syntax-property diff --git a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/base-env/prims.rkt b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/base-env/prims.rkt index 50a4e358a4..e5e5cb1a95 100644 --- a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/base-env/prims.rkt +++ b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/base-env/prims.rkt @@ -29,7 +29,7 @@ This file defines two sorts of primitives. All of them are provided into any mod (all-from-out "base-contracted.rkt") (all-from-out "top-interaction.rkt") (all-from-out "case-lambda.rkt") - class: + class : (rename-out [define-typed-struct define-struct:] [define-typed-struct define-struct] 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 957053d278..f81169198f 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 @@ -34,12 +34,12 @@ (pattern (internal:id external:id))) (define-syntax-class internal-class-data - #:literals (#%plain-app quote-syntax class:-internal begin + #:literals (#%plain-app quote-syntax class-internal begin values c:init c:init-field optional-init c:field c:public c:override c:private c:inherit private-field c:augment c:pubment) (pattern (begin (quote-syntax - (class:-internal + (class-internal (c:init init-names:name-pair ...) (c:init-field init-field-names:name-pair ...) (optional-init optional-names:id ...) @@ -153,10 +153,10 @@ ;; Assumptions: ;; by the time this is called, we can be sure that ;; init, field, and method presence/absence is guaranteed -;; by the local-expansion done by class: +;; by the local-expansion done by `class` ;; ;; we know by this point that #'form is an actual typed -;; class produced by class: due to the syntax property +;; class produced by `class` due to the syntax property (define (check-class form [expected #f]) (match (and expected (resolve expected)) [(tc-result1: (and self-class-type (Class: _ _ _ _ _))) 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 43b76a23e5..03514bbefc 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 @@ -59,7 +59,7 @@ (: c% (Class (init [x Integer]) [m (Integer -> Integer)])) (define c% - (class: object% + (class object% (super-new) (init x) (define/public (m x) 0))) @@ -69,7 +69,7 @@ (check-err #:exn #rx"expected a superclass but" (: d% (Class (init [x Integer]) [m (Integer -> Integer)])) - (define d% (class: 5 + (define d% (class 5 (super-new) (init x) (define/public (m x) 0)))) @@ -78,7 +78,7 @@ (check-ok (: e% (Class (init [x Integer]) [m (Integer -> Integer)])) - (define e% (class: object% + (define e% (class object% (super-new) (init x) (define/public (m x) x)))) @@ -87,7 +87,7 @@ (check-ok (: f% (Class (init [x Integer]) [m (Integer -> Integer)])) - (define f% (class: object% + (define f% (class object% (super-new) (init x) (define/public (m x) (send this m 3))))) @@ -96,7 +96,7 @@ (check-err #:exn #rx"method z not understood" (: g% (Class (init [x Integer #:optional]) [m (Integer -> Integer)])) - (define g% (class: object% + (define g% (class object% (super-new) (init [x 0]) (define/public (m x) (send this z))))) @@ -105,7 +105,7 @@ (check-ok (: h% (Class [n (-> Integer)] [m (Integer -> Integer)])) - (define h% (class: object% + (define h% (class object% (super-new) (define/public (n) 0) (define/public (m x) (send this n))))) @@ -114,7 +114,7 @@ (check-ok (: i% (Class [n (-> Integer)] [m (Integer -> Integer)])) - (define i% (class: object% + (define i% (class object% (super-new) (define/public (n) 0) (define/public (m x) (n))))) @@ -123,21 +123,21 @@ (check-ok (: j% (Class (field [n Integer]) [m (-> Integer)])) - (define j% (class: object% + (define j% (class object% (super-new) (field [n 0]) (define/public (m) (get-field n this))))) ;; fails, field's default value has wrong type (check-err #:exn #rx"Expected Integer, but got String" - (class: object% (super-new) + (class object% (super-new) (: x Integer) (field [x "foo"]))) ;; Fail, field access to missing field (check-err #:exn #rx"expected an object with field n" (: k% (Class [m (-> Integer)])) - (define k% (class: object% + (define k% (class object% (super-new) (define/public (m) (get-field n this))))) @@ -145,24 +145,24 @@ (check-err #:exn #rx"defines conflicting public field n" (: j% (Class (field [n Integer]) [m (-> Integer)])) - (define j% (class: object% + (define j% (class object% (super-new) (field [n 0]) (define/public (m) (get-field n this)))) (: l% (Class (field [n Integer]) [m (-> Integer)])) - (define l% (class: j% + (define l% (class j% (field [n 17]) (super-new)))) ;; Fail, conflict with parent method (check-err #:exn #rx"defines conflicting public method m" (: j% (Class [m (-> Integer)])) - (define j% (class: object% + (define j% (class object% (super-new) (define/public (m) 15))) (: m% (Class [m (-> Integer)])) - (define m% (class: j% + (define m% (class j% (super-new) (define/public (m) 17)))) @@ -170,44 +170,44 @@ (check-ok (: j% (Class (field [n Integer]) [m (-> Integer)])) - (define j% (class: object% + (define j% (class object% (super-new) (field [n 0]) (define/public (m) (get-field n this)))) (: n% (Class (field [n Integer]) [m (-> Integer)])) - (define n% (class: j% (super-new)))) + (define n% (class j% (super-new)))) ;; should fail, too many methods (check-err #:exn #rx"unexpected public method m" (: o% (Class)) - (define o% (class: object% + (define o% (class object% (super-new) (define/public (m) 0)))) ;; same as previous (check-err #:exn #rx"unexpected public method n" (: c% (Class [m (Integer -> Integer)])) - (define c% (class: object% (super-new) + (define c% (class object% (super-new) (define/public (m x) (add1 x)) (define/public (n) 0)))) ;; fails, too many inits (check-err #:exn #rx"unexpected initialization argument x" (: c% (Class)) - (define c% (class: object% (super-new) + (define c% (class object% (super-new) (init x)))) ;; fails, init should be optional but is mandatory (check-err #:exn #rx"missing optional init argument str" (: c% (Class (init [str String #:optional]))) - (define c% (class: object% (super-new) + (define c% (class object% (super-new) (init str)))) ;; fails, too many fields (check-err #:exn #rx"unexpected public field x" (: c% (Class (field [str String]))) - (define c% (class: object% (super-new) + (define c% (class object% (super-new) (field [str "foo"] [x 0])))) ;; FIXME: for the following two tests, we could improve @@ -217,11 +217,11 @@ ;; ;; fails, init with no type annotation (check-err #:exn #rx"x has no type annotation" - (define c% (class: object% (super-new) (init x)))) + (define c% (class object% (super-new) (init x)))) ;; fails, field with no type annotation (check-err #:exn #rx"unexpected public field x" - (define c% (class: object% (super-new) (field [x 0])))) + (define c% (class object% (super-new) (field [x 0])))) ;; Mixin on classes without row polymorphism (check-ok @@ -230,13 +230,13 @@ (Class [m (-> Integer)] [n (-> String)]))) (define (mixin cls) - (class: cls + (class cls (super-new) (define/public (n) "hi"))) (: arg-class% (Class [m (-> Integer)])) (define arg-class% - (class: object% + (class object% (super-new) (define/public (m) 0))) @@ -249,12 +249,12 @@ (Class [m (-> Integer)] [n (-> String)]))) (define (mixin cls) - (class: cls + (class cls (super-new))) (: arg-class% (Class [m (-> Integer)])) (define arg-class% - (class: object% + (class object% (super-new) (define/public (m) 0))) @@ -267,13 +267,13 @@ (Class [m (-> Integer)] [n (-> String)]))) (define (mixin cls) - (class: cls + (class cls (super-new) (define/public (n) "hi"))) (: arg-class% (Class [k (-> Integer)])) (define arg-class% - (class: object% + (class object% (super-new) (define/public (k) 0))) @@ -283,7 +283,7 @@ (check-ok (: c% (Class [m (Number -> String)])) (define c% - (class: object% + (class object% (super-new) (public m) (define-values (m) @@ -293,7 +293,7 @@ ;; check that classes work in let clauses (check-ok (let: ([c% : (Class [m (Number -> String)]) - (class: object% + (class object% (super-new) (public m) (define-values (m) @@ -303,60 +303,60 @@ ;; check a good super-new call (check-ok (: c% (Class (init [x Integer]))) - (define c% (class: object% (super-new) (init x))) + (define c% (class object% (super-new) (init x))) (: d% (Class)) - (define d% (class: c% (super-new [x (+ 3 5)])))) + (define d% (class c% (super-new [x (+ 3 5)])))) ;; fails, missing super-new (check-err #:exn #rx"typed classes must call super-new" (: c% (Class (init [x Integer]))) - (define c% (class: object% (init x)))) + (define c% (class object% (init x)))) ;; fails, non-top-level super-new ;; FIXME: this case also spits out additional untyped identifier ;; errors which should be squelched maybe (check-err #:exn #rx"typed classes must call super-new" (: c% (Class (init [x Integer]))) - (define c% (class: object% (let () (super-new)) (init x)))) + (define c% (class object% (let () (super-new)) (init x)))) ;; fails, bad super-new argument (check-err #:exn #rx"Expected Integer, but got String" (: c% (Class (init [x Integer]))) - (define c% (class: object% (super-new) (init x))) + (define c% (class object% (super-new) (init x))) (: d% (Class)) - (define d% (class: c% (super-new [x "bad"])))) + (define d% (class c% (super-new [x "bad"])))) ;; test override (check-ok (: c% (Class [m (Integer -> Integer)])) - (define c% (class: object% (super-new) + (define c% (class object% (super-new) (define/public (m y) (add1 y)))) (: d% (Class [m (Integer -> Integer)])) - (define d% (class: c% (super-new) + (define d% (class c% (super-new) (define/override (m y) (* 2 y))))) ;; test local call to overriden method (check-ok (: c% (Class [m (Integer -> Integer)])) - (define c% (class: object% (super-new) + (define c% (class object% (super-new) (define/public (m y) (add1 y)))) (: d% (Class [n (Integer -> Integer)] [m (Integer -> Integer)])) - (define d% (class: c% (super-new) + (define d% (class c% (super-new) (define/public (n x) (m x)) (define/override (m y) (* 2 y))))) ;; fails, superclass missing public for override (check-err #:exn #rx"missing override method m" (: d% (Class [m (Integer -> Integer)])) - (define d% (class: object% (super-new) + (define d% (class object% (super-new) (define/override (m y) (* 2 y))))) ;; local field access and set! (check-ok (: c% (Class (field [x Integer]) [m (Integer -> Integer)])) - (define c% (class: object% (super-new) + (define c% (class object% (super-new) (field [x 0]) (define/public (m y) (begin0 x (set! x (+ x 1))))))) @@ -364,48 +364,48 @@ ;; test top-level expressions in the class (check-ok (: c% (Class [m (Integer -> Integer)])) - (define c% (class: object% (super-new) + (define c% (class object% (super-new) (define/public (m y) 0) (+ 3 5)))) ;; test top-level method call (check-ok (: c% (Class [m (Integer -> Integer)])) - (define c% (class: object% (super-new) + (define c% (class object% (super-new) (define/public (m y) 0) (m 3)))) ;; test top-level field access (check-ok (: c% (Class (field [f String]))) - (define c% (class: object% (super-new) + (define c% (class object% (super-new) (field [f "foo"]) (string-append f "z")))) ;; fails, bad top-level expression (check-err #:exn #rx"Expected Number, but got String" (: c% (Class [m (Integer -> Integer)])) - (define c% (class: object% (super-new) + (define c% (class object% (super-new) (define/public (m y) 0) (+ "foo" 5)))) ;; fails, ill-typed method call (check-err #:exn #rx"Expected Integer, but got String" (: c% (Class [m (Integer -> Integer)])) - (define c% (class: object% (super-new) + (define c% (class object% (super-new) (define/public (m y) 0) (m "foo")))) ;; fails, ill-typed field access (check-err #:exn #rx"Expected String, but got Positive-Byte" (: c% (Class (field [f String]))) - (define c% (class: object% (super-new) + (define c% (class object% (super-new) (field [f "foo"]) (set! f 5)))) ;; test private field (check-ok - (class: object% + (class object% (super-new) (: x Integer) (define x 5) @@ -413,7 +413,7 @@ (+ x 1)) (: d% (Class (field [y String]))) (define d% - (class: object% + (class object% (super-new) (: x Integer) (define x 5) @@ -422,7 +422,7 @@ ;; fails, bad private field set! (check-err #:exn #rx"Expected Integer, but got String" - (class: object% + (class object% (super-new) (: x Integer) (define x 5) @@ -430,20 +430,20 @@ ;; fails, bad private field default (check-err #:exn #rx"Expected Integer, but got String" - (class: object% + (class object% (super-new) (: x Integer) (define x "foo"))) ;; fails, private field needs type annotation (check-err #:exn #rx"Expected Nothing" - (class: object% + (class object% (super-new) (define x "foo"))) ;; test private method (check-ok - (class: object% (super-new) + (class object% (super-new) (: x (-> Integer)) (define/private (x) 3) (: m (-> Integer)) @@ -451,7 +451,7 @@ ;; fails, public and private types conflict (check-err #:exn #rx"Expected String, but got Integer" - (class: object% (super-new) + (class object% (super-new) (: x (-> Integer)) (define/private (x) 3) (: m (-> String)) @@ -459,21 +459,21 @@ ;; fails, not enough annotation on private (check-err #:exn #rx"Cannot apply expression of type Any" - (class: object% (super-new) + (class object% (super-new) (define/private (x) 3) (: m (-> Integer)) (define/public (m) (x)))) ;; fails, ill-typed private method implementation (check-err #:exn #rx"Expected Integer, but got String" - (class: object% (super-new) + (class object% (super-new) (: x (-> Integer)) (define/private (x) "bad result"))) ;; test optional init arg (check-ok (: c% (Class (init [x Integer #:optional]))) - (define c% (class: object% (super-new) + (define c% (class object% (super-new) (: x Integer) (init [x 0])))) @@ -482,21 +482,21 @@ (check-ok (: c% (Class (init [x Integer #:optional]))) (: d% (Class (init [x Integer #:optional]))) - (define c% (class: object% (super-new) + (define c% (class object% (super-new) (: x Integer) (init [x 0]))) - (define d% (class: c% (super-new)))) + (define d% (class c% (super-new)))) ;; fails, expected mandatory but got optional (check-err #:exn #rx"unexpected optional init argument x" (: c% (Class (init [x Integer]))) - (define c% (class: object% (super-new) + (define c% (class object% (super-new) (: x Integer) (init [x 0])))) ;; fails, mandatory init not provided (check-err #:exn #rx"value not provided for named init arg x" - (define d% (class: object% (super-new) + (define d% (class object% (super-new) (: x Integer) (init x))) (new d%)) @@ -505,30 +505,30 @@ ;; towards the type of current class (check-ok (: c% (Class)) - (define c% (class: (class: object% (super-new) - (: x Integer) - (init x)) + (define c% (class (class object% (super-new) + (: x Integer) + (init x)) (super-new [x 3])))) ;; fails, super-class init already provided (check-err - (define c% (class: (class: object% (super-new) - (: x Integer) - (init x)) + (define c% (class (class object% (super-new) + (: x Integer) + (init x)) (super-new [x 3]))) (new c% [x 5])) ;; fails, super-new can only be called once per class (check-err - (class: object% + (class object% (super-new) (super-new))) ;; test passing an init arg to super-new (check-ok - (define c% (class: (class: object% (super-new) - (: x Integer) - (init x)) + (define c% (class (class object% (super-new) + (: x Integer) + (init x)) (: x Integer) (init x) (super-new [x x]))) @@ -536,40 +536,40 @@ ;; fails, bad argument type to super-new (check-err - (define c% (class: (class: object% (super-new) - (: x Integer) - (init x)) + (define c% (class (class object% (super-new) + (: x Integer) + (init x)) (: x String) (init x) (super-new [x x])))) ;; test inherit method (check-ok - (class: (class: object% (super-new) - (: m (Integer -> Integer)) - (define/public (m x) (add1 x))) + (class (class object% (super-new) + (: m (Integer -> Integer)) + (define/public (m x) (add1 x))) (super-new) (inherit m) (m 5))) ;; test internal name with inherit (check-ok - (class: (class: object% (super-new) - (: m (Integer -> Integer)) - (define/public (m x) (add1 x))) + (class (class object% (super-new) + (: m (Integer -> Integer)) + (define/public (m x) (add1 x))) (super-new) (inherit [n m]) (n 5))) ;; fails, missing super method for inherit (check-err - (class: (class: object% (super-new)) (super-new) (inherit z))) + (class (class object% (super-new)) (super-new) (inherit z))) ;; fails, bad argument type to inherited method (check-err - (class: (class: object% (super-new) - (: m (Integer -> Integer)) - (define/public (m x) (add1 x))) + (class (class object% (super-new) + (: m (Integer -> Integer)) + (define/public (m x) (add1 x))) (super-new) (inherit m) (m "foo"))) @@ -579,7 +579,7 @@ (check-ok (: c% (Class [n (Integer #:foo Integer -> Integer)])) (define c% - (class: object% + (class object% (super-new) (define/public (n x #:foo foo) (+ foo x))))) @@ -587,7 +587,7 @@ ;; test instance subtyping (check-ok (define c% - (class: object% + (class object% (super-new) (: x (U False Number)) (field [x 0]))) @@ -596,7 +596,7 @@ ;; test use of `this` in field default (check-ok - (class: object% + (class object% (super-new) (: x Integer) (field [x 0]) @@ -606,12 +606,12 @@ ;; test super calls (check-ok (define c% - (class: object% + (class object% (super-new) (: m (Integer -> Integer)) (define/public (m x) 0))) (define d% - (class: c% + (class c% (super-new) (define/override (m x) (add1 (super m 5))))) (send (new d%) m 1)) @@ -619,12 +619,12 @@ ;; test super calls at top-level (check-ok (define c% - (class: object% + (class object% (super-new) (: m (Integer -> Integer)) (define/public (m x) 0))) (define d% - (class: c% + (class c% (super-new) (super m 5) (define/override (m x) 5)))) @@ -632,26 +632,26 @@ ;; fails, bad super call argument (check-err (define c% - (class: object% + (class object% (super-new) (: m (Integer -> Integer)) (define/public (m x) 0))) (define d% - (class: c% + (class c% (super-new) (super m "foo") (define/override (m x) 5)))) ;; test different internal/external names (check-ok - (define c% (class: object% (super-new) + (define c% (class object% (super-new) (public [m n]) (define m (lambda () 0)))) (send (new c%) n)) ;; test local calls with internal/external (check-ok - (define c% (class: object% (super-new) + (define c% (class object% (super-new) (: m (-> Integer)) (public [m n]) (define m (lambda () 0)) @@ -661,14 +661,14 @@ ;; internal/external the same is ok (check-ok - (define c% (class: object% (super-new) + (define c% (class object% (super-new) (public [m m]) (define m (lambda () 0)))) (send (new c%) m)) ;; fails, internal name not accessible (check-err - (define c% (class: object% (super-new) + (define c% (class object% (super-new) (public [m n]) (define m (lambda () 0)))) (send (new c%) m)) @@ -676,73 +676,73 @@ ;; test internal/external with expected (check-ok (: c% (Class [n (-> Integer)])) - (define c% (class: object% (super-new) + (define c% (class object% (super-new) (public [m n]) (define m (lambda () 0)))) (send (new c%) n)) ;; test internal/external field (check-ok - (define c% (class: object% (super-new) + (define c% (class object% (super-new) (: f Integer) (field ([f g] 0)))) (get-field g (new c%))) ;; fail, internal name not accessible (check-err - (define c% (class: object% (super-new) + (define c% (class object% (super-new) (: f Integer) (field ([f g] 0)))) (get-field f (new c%))) ;; test internal/external init (check-ok - (define c% (class: object% (super-new) + (define c% (class object% (super-new) (: i Integer) (init ([i j])))) (new c% [j 5])) ;; fails, internal name not accessible (check-err - (define c% (class: object% (super-new) + (define c% (class object% (super-new) (: i Integer) (init ([i j])))) (new c% [i 5])) ;; test init default values (check-ok - (class: object% (super-new) + (class object% (super-new) (: z Integer) (init [z 0]))) ;; fails, bad default init value (check-err - (class: object% (super-new) + (class object% (super-new) (: z Integer) (init [z "foo"]))) ;; test init field default value (check-ok - (define c% (class: object% (super-new) + (define c% (class object% (super-new) (: x Integer) (init-field ([x y] 0))))) ;; fails, wrong init-field default (check-err - (define c% (class: object% (super-new) + (define c% (class object% (super-new) (: x Integer) (init-field ([x y] "foo"))))) ;; test type-checking method with internal/external (check-err (: c% (Class [n (Integer -> Integer)])) - (define c% (class: object% (super-new) + (define c% (class object% (super-new) (public [m n]) (define m (lambda () 0))))) ;; test type-checking without expected class type (check-ok - (define c% (class: object% (super-new) + (define c% (class object% (super-new) (: m (Integer -> Integer)) (define/public (m x) 0))) @@ -751,22 +751,22 @@ ;; fails, because the local call type is unknown ;; and is assumed to be Any (check-err - (class: object% (super-new) + (class object% (super-new) (define/public (m) (n)) (define/public (n x) 0))) ;; test type-checking for classes without any ;; internal type annotations on methods (check-ok - (define c% (class: object% (super-new) + (define c% (class object% (super-new) (define/public (m) 0))) (send (new c%) m)) ;; test inheritance without expected (check-ok - (define c% (class: (class: object% (super-new) - (: m (-> Integer)) - (define/public (m) 0)) + (define c% (class (class object% (super-new) + (: m (-> Integer)) + (define/public (m) 0)) (super-new) (: n (-> Integer)) (define/public (n) 1))) @@ -775,7 +775,7 @@ ;; test fields without expected class type (check-ok - (define c% (class: object% (super-new) + (define c% (class object% (super-new) (: x Integer) (field [x 0]))) (get-field x (new c%))) @@ -787,7 +787,7 @@ -> (Class #:row-var A (field [x Integer]))))) (define (f cls) - (class: cls (super-new) + (class cls (super-new) (field [x 5]))) (inst f #:row (field [y Integer]))) @@ -799,7 +799,7 @@ -> (Class #:row-var A (field [x Integer]))))) (define (f cls) - (class: cls (super-new) + (class cls (super-new) (field [x 5]))) (inst f #:row (field [x Integer]))) @@ -810,12 +810,12 @@ -> (Class #:row-var A (field [x Integer]))))) (define (f cls) - (class: cls (super-new) + (class cls (super-new) (field [x 5]))) (define instantiated (inst f #:row (field [y Integer]))) (instantiated - (class: object% (super-new)))) + (class object% (super-new)))) ;; mixin application succeeds (check-ok @@ -824,12 +824,12 @@ -> (Class #:row-var A (field [x Integer]))))) (define (f cls) - (class: cls (super-new) + (class cls (super-new) (field [x 5]))) (define instantiated (inst f #:row (field [y Integer]))) (instantiated - (class: object% (super-new) + (class object% (super-new) (: y Integer) (field [y 0])))) @@ -840,7 +840,7 @@ -> (Class #:row-var A (field [x Integer]))))) (define (f cls) - (class: cls (super-new) + (class cls (super-new) (field [x 5]))) (inst f #:row (field [y Integer]))) @@ -851,14 +851,14 @@ -> (Class #:row-var A (field [x Integer]))))) (define (f cls) - (class: cls (super-new) + (class cls (super-new) (field [x 5]))) (inst f #:row (field [x Integer]))) ;; Check simple use of pubment (check-ok (define c% - (class: object% + (class object% (super-new) (: m (Integer -> Integer)) (define/pubment (m x) 0))) @@ -867,7 +867,7 @@ ;; Local calls to pubment method (check-ok (define c% - (class: object% + (class object% (super-new) (: m (Integer -> Integer)) (define/pubment (m x) 0) @@ -878,12 +878,12 @@ ;; Inheritance with augment (check-ok (define c% - (class: object% + (class object% (super-new) (: m (Integer -> Integer)) (define/pubment (m x) 0))) (define d% - (class: c% + (class c% (super-new) (define/augment (m x) (+ 1 x)))) @@ -892,13 +892,13 @@ ;; Pubment with inner (check-ok (define c% - (class: object% + (class object% (super-new) (: m (Integer -> Integer)) (define/pubment (m x) (inner 0 m x)))) (define d% - (class: c% + (class c% (super-new) (define/augment (m x) (+ 1 x)))) @@ -907,7 +907,7 @@ ;; Fail, bad inner default (check-err (define c% - (class: object% + (class object% (super-new) (: m (Integer -> Integer)) (define/pubment (m x) @@ -916,7 +916,7 @@ ;; Fail, wrong number of arguments to inner (check-err (define c% - (class: object% + (class object% (super-new) (: m (Integer -> Integer)) (define/pubment (m x) @@ -925,32 +925,32 @@ ;; Fail, bad augment type (check-err (define c% - (class: object% + (class object% (super-new) (: m (Integer -> Integer)) (define/pubment (m x) (inner 0 m x)))) (define d% - (class: c% + (class c% (super-new) (define/augment (m x) "bad type")))) ;; Fail, cannot augment non-augmentable method (check-err (define c% - (class: object% + (class object% (super-new) (: m (Integer -> Integer)) (define/public (m x) 0))) (define d% - (class: c% + (class c% (super-new) (define/augment (m x) 1)))) ;; Pubment with separate internal/external names (check-ok (define c% - (class: object% + (class object% (super-new) (: m (Integer -> Integer)) (pubment [n m]) @@ -961,7 +961,7 @@ (check-ok (: c% (Class (augment [m (Natural -> Natural)]))) (define c% - (class: object% + (class object% (super-new) (define/pubment (m x) 0))) (send (new c%) m 3)) @@ -970,7 +970,7 @@ (check-err #:exn #rx"Expected Number" (: c% Number) (define c% - (class: object% + (class object% (super-new) (: x Integer) (init-field x)))) @@ -979,7 +979,7 @@ (check-ok (: c% (All (A) (Class (init-field [x A])))) (define c% - (class: object% + (class object% (super-new) (init-field x))) (new (inst c% Integer) [x 0])) @@ -988,7 +988,7 @@ (check-err #:exn #rx"Expected A, but got Positive-Byte" (: c% (All (A) (Class (init-field [x A])))) (define c% - (class: object% + (class object% (super-new) (init-field x) (set! x 5))))))