suzanne.soy/typed-racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Add unit tests for classes

Browse Source 
original commit: 77847de94436dcaf8389236d14251110fa7c138a
This commit is contained in:
Asumu Takikawa 2013-05-18 13:10:46 -04:00
parent bc07b8b140
commit f058d684b6
1 changed files with 239 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

239
pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/class-tests.rkt Normal file
View File

@ -0,0 +1,239 @@
#lang racket
;; Unit tests for typed classes
;;
;; FIXME: make this work with the unit testing framework for
;; typecheck eventually (it's finnicky).
;;
;; FIXME: these tests are slow
(require "test-utils.rkt"
rackunit)
(provide tests)
(gen-test-main)
(define-syntax-rule (run/tr-module e ...)
(parameterize ([current-output-port (open-output-nowhere)]
[current-error-port (open-output-nowhere)])
(define ns (make-base-namespace))
(eval (quote (module typed typed/racket
e ...))
ns)
(eval (quote (require 'typed)) ns)))
(define-syntax-rule (check-ok e ...)
(begin (check-not-exn (thunk (run/tr-module e ...)))))
(define-syntax-rule (check-err e ...)
(check-exn exn:fail:syntax? (thunk (run/tr-module e ...))))
(define tests
(test-suite
"Class type-checking tests"
;; Basic class with init and public method
(check-ok
(: c% (Class (init [x Integer])
[m (Integer -> Integer)]))
(define c%
(class: object%
(super-new)
(init x)
(define/public (m x) 0)))
(send (new c% [x 1]) m 5))
;; Fails, bad superclass expression
(check-err
(: d% (Class (init [x Integer])
[m (Integer -> Integer)]))
(define d% (class: 5
(super-new)
(init x)
(define/public (m x) 0))))
;; Method using argument type
(check-ok
(: e% (Class (init [x Integer])
[m (Integer -> Integer)]))
(define e% (class: object%
(super-new)
(init x)
(define/public (m x) x))))
;; Send inside a method
(check-ok
(: f% (Class (init [x Integer])
[m (Integer -> Integer)]))
(define f% (class: object%
(super-new)
(init x)
(define/public (m x) (send this m 3)))))
;; Fails, send to missing method
(check-err
(: g% (Class (init [x Integer])
[m (Integer -> Integer)]))
(define g% (class: object%
(super-new)
(init x)
(define/public (m x) (send this z)))))
;; Send to other methods
(check-ok
(: h% (Class [n (-> Integer)]
[m (Integer -> Integer)]))
(define h% (class: object%
(super-new)
(define/public (n) 0)
(define/public (m x) (send this n)))))
;; Local sends
(check-ok
(: i% (Class [n (-> Integer)]
[m (Integer -> Integer)]))
(define i% (class: object%
(super-new)
(define/public (n) 0)
(define/public (m x) (n)))))
;; Field access via get-field
(check-ok
(: j% (Class (field [n Integer])
[m (-> Integer)]))
(define j% (class: object%
(super-new)
(field [n 0])
(define/public (m) (get-field n this)))))
;; Fail, field access to missing field
(check-err
(: k% (Class (field [n Integer])
[m (-> Integer)]))
(define k% (class: object%
(super-new)
(define/public (m) (get-field n this)))))
;; Fail, conflict with parent field
(check-err
(: j% (Class (field [n Integer])
[m (-> Integer)]))
(define j% (class: object%
(super-new)
(field [n 0])
(define/public (m) (get-field n this))))
(: l% (Class (field [n Integer])))
(define l% (class: j%
(field [n 17])
(super-new))))
;; Fail, conflict with parent method
(check-err
(: j% (Class (field [n Integer])
[m (-> Integer)]))
(define j% (class: object%
(super-new)
(field [n 0])
(define/public (m) (get-field n this))))
(: m% (Class [m (-> Integer)]))
(define m% (class: j%
(super-new)
(define/public (m) 17))))
;; Inheritance
(check-ok
(: j% (Class (field [n Integer])
[m (-> Integer)]))
(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))))
;; should fail, too many methods (FIXME)
#|
(: o% (Class))
(define o% (class: object%
(super-new)
(define/public (m) 0)))
|#
;; Mixin on classes without row polymorphism
(check-ok
(: mixin ((Class [m (-> Integer)])
->
(Class [m (-> Integer)]
[n (-> String)])))
(define (mixin cls)
(class: cls
(super-new)
(define/public (n) "hi")))
(: arg-class% (Class [m (-> Integer)]))
(define arg-class%
(class: object%
(super-new)
(define/public (m) 0)))
(mixin arg-class%))
;; Fail, bad mixin
(check-err
(: mixin ((Class [m (-> Integer)])
->
(Class [m (-> Integer)]
[n (-> String)])))
(define (mixin cls)
(class: cls
(super-new)))
(: arg-class% (Class [m (-> Integer)]))
(define arg-class%
(class: object%
(super-new)
(define/public (m) 0)))
(mixin arg-class%))
;; Fail, bad mixin argument
(check-err
(: mixin ((Class [m (-> Integer)])
->
(Class [m (-> Integer)]
[n (-> String)])))
(define (mixin cls)
(class: cls
(super-new)
(define/public (n) "hi")))
(: arg-class% (Class [k (-> Integer)]))
(define arg-class%
(class: object%
(super-new)
(define/public (k) 0)))
(mixin arg-class%))
;; classes that don't use define/public directly
(check-ok
(: c% (Class [m (Number -> String)]))
(define c%
(class: object%
(super-new)
(public m)
(define-values (m)
(lambda (x) (number->string x)))))
(send (new c%) m 4))
;; check that classes work in let clauses
(check-ok
(let: ([c% : (Class [m (Number -> String)])
(class: object%
(super-new)
(public m)
(define-values (m)
(lambda (x) (number->string x))))])
(send (new c%) m 4)))))