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

Add expected error messages to class tests

Browse Source
This commit is contained in:
Asumu Takikawa 2013-07-11 14:20:20 -04:00
parent 86093f88be
commit e3efb90a59
1 changed files with 71 additions and 50 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

121
pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/class-tests.rkt
View File

@ -8,14 +8,17 @@
;; FIXME: these tests are slow ;; FIXME: these tests are slow
(require "test-utils.rkt" (require "test-utils.rkt"
rackunit) rackunit
(for-syntax syntax/parse))
(provide tests) (provide tests)
(gen-test-main) (gen-test-main)
(define test-error-port (make-parameter (open-output-nowhere)))
(define-syntax-rule (run/tr-module e ...) (define-syntax-rule (run/tr-module e ...)
(parameterize ([current-output-port (open-output-nowhere)] (parameterize ([current-output-port (open-output-nowhere)]
[current-error-port (open-output-nowhere)]) [current-error-port (test-error-port)])
(define ns (make-base-namespace)) (define ns (make-base-namespace))
(eval (quote (module typed typed/racket (eval (quote (module typed typed/racket
e ...)) e ...))
@ -25,8 +28,27 @@
(define-syntax-rule (check-ok e ...) (define-syntax-rule (check-ok e ...)
(begin (check-not-exn (thunk (run/tr-module e ...))))) (begin (check-not-exn (thunk (run/tr-module e ...)))))
(define-syntax-rule (check-err e ...) (define-syntax (check-err stx)
(check-exn exn:fail:syntax? (thunk (run/tr-module e ...)))) (syntax-parse stx
[(_ #:exn rx-or-pred e ...)
#'(parameterize ([test-error-port (open-output-string)])
(check-exn
(λ (exn)
(cond [(regexp? rx-or-pred)
(and (exn:fail:syntax? exn)
(or (regexp-match? rx-or-pred (exn-message exn))
(regexp-match?
rx-or-pred
(get-output-string (test-error-port)))))]
[(procedure? rx-or-pred)
(and (exn:fail:syntax? exn)
(rx-or-pred exn))]
[else (error "expected predicate or regexp")]))
(thunk (run/tr-module e ...))))]
[(_ e ...)
#'(check-exn
exn:fail:syntax?
(thunk (run/tr-module e ...)))]))
(define tests (define tests
(test-suite (test-suite
@ -44,7 +66,7 @@
(send (new c% [x 1]) m 5)) (send (new c% [x 1]) m 5))
;; Fails, bad superclass expression ;; Fails, bad superclass expression
(check-err (check-err #:exn #rx"expected a superclass but"
(: d% (Class (init [x Integer]) (: d% (Class (init [x Integer])
[m (Integer -> Integer)])) [m (Integer -> Integer)]))
(define d% (class: 5 (define d% (class: 5
@ -71,12 +93,12 @@
(define/public (m x) (send this m 3))))) (define/public (m x) (send this m 3)))))
;; Fails, send to missing method ;; Fails, send to missing method
(check-err (check-err #:exn #rx"method z not understood"
(: g% (Class (init [x Integer #:optional]) (: g% (Class (init [x Integer #:optional])
[m (Integer -> Integer)])) [m (Integer -> Integer)]))
(define g% (class: object% (define g% (class: object%
(super-new) (super-new)
(init x) (init [x 0])
(define/public (m x) (send this z))))) (define/public (m x) (send this z)))))
;; Send to other methods ;; Send to other methods
@ -107,40 +129,38 @@
(define/public (m) (get-field n this))))) (define/public (m) (get-field n this)))))
;; fails, field's default value has wrong type ;; fails, field's default value has wrong type
(check-err (check-err #:exn #rx"Expected Integer, but got String"
(class: object% (super-new) (class: object% (super-new)
(: x Integer) (: x Integer)
(field [x "foo"]))) (field [x "foo"])))
;; Fail, field access to missing field ;; Fail, field access to missing field
(check-err (check-err #:exn #rx"expected an object with field n"
(: k% (Class (field [n Integer]) (: k% (Class [m (-> Integer)]))
[m (-> Integer)]))
(define k% (class: object% (define k% (class: object%
(super-new) (super-new)
(define/public (m) (get-field n this))))) (define/public (m) (get-field n this)))))
;; Fail, conflict with parent field ;; Fail, conflict with parent field
(check-err (check-err #:exn #rx"defines conflicting public field n"
(: j% (Class (field [n Integer]) (: j% (Class (field [n Integer])
[m (-> Integer)])) [m (-> Integer)]))
(define j% (class: object% (define j% (class: object%
(super-new) (super-new)
(field [n 0]) (field [n 0])
(define/public (m) (get-field n this)))) (define/public (m) (get-field n this))))
(: l% (Class (field [n Integer]))) (: l% (Class (field [n Integer])
[m (-> Integer)]))
(define l% (class: j% (define l% (class: j%
(field [n 17]) (field [n 17])
(super-new)))) (super-new))))
;; Fail, conflict with parent method ;; Fail, conflict with parent method
(check-err (check-err #:exn #rx"defines conflicting public method m"
(: j% (Class (field [n Integer]) (: j% (Class [m (-> Integer)]))
[m (-> Integer)]))
(define j% (class: object% (define j% (class: object%
(super-new) (super-new)
(field [n 0]) (define/public (m) 15)))
(define/public (m) (get-field n this))))
(: m% (Class [m (-> Integer)])) (: m% (Class [m (-> Integer)]))
(define m% (class: j% (define m% (class: j%
(super-new) (super-new)
@ -159,27 +179,33 @@
(define n% (class: j% (super-new)))) (define n% (class: j% (super-new))))
;; should fail, too many methods ;; should fail, too many methods
(check-err (check-err #:exn #rx"unexpected public method m"
(: o% (Class)) (: o% (Class))
(define o% (class: object% (define o% (class: object%
(super-new) (super-new)
(define/public (m) 0)))) (define/public (m) 0))))
;; same as previous ;; same as previous
(check-err (check-err #:exn #rx"unexpected public method n"
(: c% (Class [m (Integer -> Integer)])) (: 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 (m x) (add1 x))
(define/public (n) 0)))) (define/public (n) 0))))
;; fails, too many inits ;; fails, too many inits
(check-err (check-err #:exn #rx"unexpected initialization argument x"
(: c% (Class))
(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]))) (: c% (Class (init [str String #:optional])))
(define c% (class: object% (super-new) (define c% (class: object% (super-new)
(init str x)))) (init str))))
;; fails, too many fields ;; fails, too many fields
(check-err (check-err #:exn #rx"unexpected public field x"
(: c% (Class (field [str String]))) (: c% (Class (field [str String])))
(define c% (class: object% (super-new) (define c% (class: object% (super-new)
(field [str "foo"] [x 0])))) (field [str "foo"] [x 0]))))
@ -190,11 +216,11 @@
;; we should still provide a better error message. ;; we should still provide a better error message.
;; ;;
;; fails, init with no type annotation ;; fails, init with no type annotation
(check-err (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 ;; fails, field with no type annotation
(check-err (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 ;; Mixin on classes without row polymorphism
@ -217,7 +243,7 @@
(mixin arg-class%)) (mixin arg-class%))
;; Fail, bad mixin ;; Fail, bad mixin
(check-err (check-err #:exn #rx"missing public method n"
(: mixin ((Class [m (-> Integer)]) (: mixin ((Class [m (-> Integer)])
-> ->
(Class [m (-> Integer)] (Class [m (-> Integer)]
@ -235,7 +261,7 @@
(mixin arg-class%)) (mixin arg-class%))
;; Fail, bad mixin argument ;; Fail, bad mixin argument
(check-err (check-err #:exn #rx"Expected \\(Class \\(m \\(-> Integer\\)\\)\\)"
(: mixin ((Class [m (-> Integer)]) (: mixin ((Class [m (-> Integer)])
-> ->
(Class [m (-> Integer)] (Class [m (-> Integer)]
@ -282,17 +308,19 @@
(define d% (class: c% (super-new [x (+ 3 5)])))) (define d% (class: c% (super-new [x (+ 3 5)]))))
;; fails, missing super-new ;; fails, missing super-new
(check-err (check-err #:exn #rx"typed classes must call super-new"
(: c% (Class (init [x Integer]))) (: c% (Class (init [x Integer])))
(define c% (class: object% (init x)))) (define c% (class: object% (init x))))
;; fails, non-top-level super-new ;; fails, non-top-level super-new
(check-err ;; 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]))) (: 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 ;; fails, bad super-new argument
(check-err (check-err #:exn #rx"Expected Integer, but got String"
(: c% (Class (init [x Integer]))) (: c% (Class (init [x Integer])))
(define c% (class: object% (super-new) (init x))) (define c% (class: object% (super-new) (init x)))
(: d% (Class)) (: d% (Class))
@ -319,7 +347,7 @@
(define/override (m y) (* 2 y))))) (define/override (m y) (* 2 y)))))
;; fails, superclass missing public for override ;; fails, superclass missing public for override
(check-err (check-err #:exn #rx"missing override method m"
(: d% (Class [m (Integer -> Integer)])) (: d% (Class [m (Integer -> Integer)]))
(define d% (class: object% (super-new) (define d% (class: object% (super-new)
(define/override (m y) (* 2 y))))) (define/override (m y) (* 2 y)))))
@ -333,13 +361,6 @@
(define/public (m y) (define/public (m y)
(begin0 x (set! x (+ x 1))))))) (begin0 x (set! x (+ x 1)))))))
;; fails, missing local field
(check-err
(: c% (Class [m (Integer -> Integer)]))
(define c% (class: object% (super-new)
(define/public (m y)
(begin0 x (set! x (+ x 1)))))))
;; test top-level expressions in the class ;; test top-level expressions in the class
(check-ok (check-ok
(: c% (Class [m (Integer -> Integer)])) (: c% (Class [m (Integer -> Integer)]))
@ -362,22 +383,22 @@
(string-append f "z")))) (string-append f "z"))))
;; fails, bad top-level expression ;; fails, bad top-level expression
(check-err (check-err #:exn #rx"Expected Number, but got String"
(: c% (Class [m (Integer -> Integer)])) (: c% (Class [m (Integer -> Integer)]))
(define c% (class: object% (super-new) (define c% (class: object% (super-new)
(define/public (m y) 0) (define/public (m y) 0)
(+ "foo" 5)))) (+ "foo" 5))))
;; fails, ill-typed method call ;; fails, ill-typed method call
(check-err (check-err #:exn #rx"Expected Integer, but got String"
(: c% (Class [m (Integer -> Integer)])) (: c% (Class [m (Integer -> Integer)]))
(define c% (class: object% (super-new) (define c% (class: object% (super-new)
(define/public (m y) 0) (define/public (m y) 0)
(m "foo")))) (m "foo"))))
;; fails, ill-typed field access ;; fails, ill-typed field access
(check-err (check-err #:exn #rx"Expected String, but got Positive-Byte"
(: c% (Class [f String])) (: c% (Class (field [f String])))
(define c% (class: object% (super-new) (define c% (class: object% (super-new)
(field [f "foo"]) (field [f "foo"])
(set! f 5)))) (set! f 5))))
@ -400,7 +421,7 @@
(field [y "foo"])))) (field [y "foo"]))))
;; fails, bad private field set! ;; fails, bad private field set!
(check-err (check-err #:exn #rx"Expected Integer, but got String"
(class: object% (class: object%
(super-new) (super-new)
(: x Integer) (: x Integer)
@ -408,14 +429,14 @@
(set! x "foo"))) (set! x "foo")))
;; fails, bad private field default ;; fails, bad private field default
(check-err (check-err #:exn #rx"Expected Integer, but got String"
(class: object% (class: object%
(super-new) (super-new)
(: x Integer) (: x Integer)
(define x "foo"))) (define x "foo")))
;; fails, private field needs type annotation ;; fails, private field needs type annotation
(check-err (check-err #:exn #rx"Expected Nothing"
(class: object% (class: object%
(super-new) (super-new)
(define x "foo"))) (define x "foo")))
@ -429,7 +450,7 @@
(define/public (m) (x)))) (define/public (m) (x))))
;; fails, public and private types conflict ;; fails, public and private types conflict
(check-err (check-err #:exn #rx"Expected String, but got Integer"
(class: object% (super-new) (class: object% (super-new)
(: x (-> Integer)) (: x (-> Integer))
(define/private (x) 3) (define/private (x) 3)
@ -437,14 +458,14 @@
(define/public (m) (x)))) (define/public (m) (x))))
;; fails, not enough annotation on private ;; fails, not enough annotation on private
(check-err (check-err #:exn #rx"Cannot apply expression of type Any"
(class: object% (super-new) (class: object% (super-new)
(define/private (x) 3) (define/private (x) 3)
(: m (-> Integer)) (: m (-> Integer))
(define/public (m) (x)))) (define/public (m) (x))))
;; fails, ill-typed private method implementation ;; fails, ill-typed private method implementation
(check-err (check-err #:exn #rx"Expected Integer, but got String"
(class: object% (super-new) (class: object% (super-new)
(: x (-> Integer)) (: x (-> Integer))
(define/private (x) "bad result"))) (define/private (x) "bad result")))
@ -467,14 +488,14 @@
(define d% (class: c% (super-new)))) (define d% (class: c% (super-new))))
;; fails, expected mandatory but got optional ;; fails, expected mandatory but got optional
(check-err (check-err #:exn #rx"unexpected optional init argument x"
(: c% (Class (init [x Integer]))) (: c% (Class (init [x Integer])))
(define c% (class: object% (super-new) (define c% (class: object% (super-new)
(: x Integer) (: x Integer)
(init [x 0])))) (init [x 0]))))
;; fails, mandatory init not provided ;; fails, mandatory init not provided
(check-err (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) (: x Integer)
(init x))) (init x)))