Disallow non-aliases in #:implements

This commit is contained in:
Asumu Takikawa 2013-09-19 14:08:12 -04:00
parent 98a2d248c0
commit 92d5e4a8ae
2 changed files with 14 additions and 24 deletions

View File

@ -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))

View File

@ -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])]