From 92d5e4a8aecbb9b121652f1e38c9bee76db64e0f Mon Sep 17 00:00:00 2001 From: Asumu Takikawa Date: Thu, 19 Sep 2013 14:08:12 -0400 Subject: [PATCH] Disallow non-aliases in #:implements --- .../typed-racket/types/classes.rkt | 2 +- .../unit-tests/parse-type-tests.rkt | 36 +++++++------------ 2 files changed, 14 insertions(+), 24 deletions(-) diff --git a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/types/classes.rkt b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/types/classes.rkt index 72e2a1208a..d84abfe037 100644 --- a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/types/classes.rkt +++ b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/types/classes.rkt @@ -197,7 +197,7 @@ #:attributes (row-var extends-types inits fields methods augments) (pattern (~seq (~or (~optional (~seq #:row-var row-var:id)) - (~seq #:implements extends-type:expr) + (~seq #:implements extends-type:id) (~var clause (type-clause parse-type))) ...) #:attr inits (apply append (attribute clause.init-entries)) diff --git a/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/parse-type-tests.rkt b/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/parse-type-tests.rkt index 14956718f9..aee2a33539 100644 --- a/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/parse-type-tests.rkt +++ b/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/parse-type-tests.rkt @@ -239,14 +239,8 @@ (make-PolyRow (list 'r) (list null null null null) (make-Class (make-F 'r) null null null null))] - [(All (r #:row) (Class #:implements (Class #:row-var r))) - (make-PolyRow (list 'r) - (list null null null null) - (make-Class (make-F 'r) null null null null))] - [(All (r #:row) (Class #:implements (Class) #:row-var r)) - (make-PolyRow (list 'r) - (list null null null null) - (make-Class (make-F 'r) null null null null))] + [FAIL (All (r #:row) (Class #:implements (Class #:row-var r)))] + [FAIL (All (r #:row) (Class #:implements (Class) #:row-var r))] [FAIL (Class #:row-var 5)] [FAIL (Class #:row-var (list 3))] [FAIL (Class #:implements (Class #:row-var r) #:row-var x)] @@ -255,21 +249,17 @@ (All (x #:row) (Class #:implements (Class #:row-var r) #:row-var x)))] [FAIL (All (r #:row) (Class #:implements (Class #:row-var r) #:row-var r))] - ;; test #:implements - [(Class #:implements (Class [m (Number -> Number)]) (field [x Number])) - (make-Class #f null `((x ,-Number)) `((m ,(t:-> N N))) null)] - [(Class #:implements (Class [m (Number -> Number)]) - #:implements (Class [n (Number -> Number)]) - (field [x Number])) - (make-Class #f null `((x ,-Number)) - `((n ,(t:-> N N)) (m ,(t:-> N N))) null)] - [(Class #:implements (Class [m (Number -> Number)]) - #:implements (Class [m (Number -> Number)]) - (field [x Number])) - (make-Class #f null `((x ,-Number)) `((m ,(t:-> N N))) null)] - [(Class #:implements (Class (init [x Integer]) [m (Number -> Number)]) - (field [x Number])) - (make-Class #f null `((x ,-Number)) `((m ,(t:-> N N))) null)] + ;; Test #:implements, some of these used to work but now they have to + ;; refer to type aliases. Testing actual type aliases is hard here though. + [FAIL (Class #:implements (Class [m (Number -> Number)]) (field [x Number]))] + [FAIL (Class #:implements (Class [m (Number -> Number)]) + #:implements (Class [n (Number -> Number)]) + (field [x Number]))] + [FAIL (Class #:implements (Class [m (Number -> Number)]) + #:implements (Class [m (Number -> Number)]) + (field [x Number]))] + [FAIL (Class #:implements (Class (init [x Integer]) [m (Number -> Number)]) + (field [x Number]))] [FAIL (Class #:implements Number)] [FAIL (Class #:implements Number [m (Number -> Number)])] [FAIL (Class #:implements (Class [m (Number -> Number)]) [m String])]