diff --git a/collects/tests/typed-scheme/succeed/pr11912.rkt b/collects/tests/typed-scheme/succeed/pr11912.rkt new file mode 100644 index 0000000000..bb00fc50b5 --- /dev/null +++ b/collects/tests/typed-scheme/succeed/pr11912.rkt @@ -0,0 +1,13 @@ +#lang typed/racket + +(require typed/rackunit) + +(check-exn (lambda (exn) #t) + (lambda () (/ 1 0))) + +(check-equal? 2 2) +(check-not-exn (lambda () (begin0 3 4))) + +(check-true #t) +(check-false #f) +(check-not-false 4) diff --git a/collects/typed/rackunit/main.rkt b/collects/typed/rackunit/main.rkt index 52fa981f05..851ebb4bd0 100644 --- a/collects/typed/rackunit/main.rkt +++ b/collects/typed/rackunit/main.rkt @@ -5,18 +5,14 @@ (define-type check-ish-ty (case-lambda - (Any Any -> (U #t Void)) - (Any Any String -> (U #t Void)))) + (Any Any -> Void) + (Any Any String -> Void))) (define-type (Predicate A) (A -> Boolean)) (define-type (Thunk A) (-> A)) ; 3.2 (require/typed/provide rackunit - [check (All (A B C) - (case-lambda - ((A B -> C) A B -> C) - ((A B -> C) A B String -> C)))] [check-eq? check-ish-ty] [check-not-eq? check-ish-ty] [check-eqv? check-ish-ty] @@ -24,40 +20,47 @@ [check-equal? check-ish-ty] [check-not-equal? check-ish-ty] [check-pred - (All (A B) + (All (A) (case-lambda - ((A -> B) A -> #t) - ((A -> B) A String -> #t)))] + ((A -> Any) A -> Void) + ((A -> Any) A String -> Void)))] [check-= (case-lambda - (Number Number Number -> #t) - (Number Number Number String -> #t))] + (Real Real Real -> Void) + (Real Real Real String -> Void))] [check-true (case-lambda - (Boolean -> #t) - (Boolean String -> #t))] + (Any -> Void) + (Any String -> Void))] [check-false (case-lambda - (Boolean -> #t) - (Boolean String -> #t))] + (Any -> Void) + (Any String -> Void))] [check-not-false (case-lambda - (Any -> #t) - (Any String -> #t))] + (Any -> Void) + (Any String -> Void))] [check-exn (case-lambda - ((Predicate Any) (Thunk Any) -> #t) - ((Predicate Any) (Thunk Any) String -> #t))] + ((U (Predicate Any) Regexp) (Thunk Any) -> Void) + ((U (Predicate Any) Regexp) (Thunk Any) String -> Void))] [check-not-exn (case-lambda - ((Thunk Any) -> #t) - ((Thunk Any) String -> #t))] + ((Thunk Any) -> Void) + ((Thunk Any) String -> Void))] + [check-regexp-match + (Regexp String -> Void)] + + + [check (All (A B) + (case-lambda + ((A B -> Any) A B -> Void) + ((A B -> Any) A B String -> Void)))] + [fail (case-lambda - (-> #t) - (String -> #t))] - [check-regexp-match - (Regexp String -> #t)]) + (-> Void) + (String -> Void))]) ; 3.2.1 (require-typed-struct check-info @@ -82,14 +85,6 @@ (require (only-in rackunit define-simple-check define-binary-check define-check fail-check)) (provide define-simple-check define-binary-check define-check fail-check) -; 3.2.3 -(require/typed/provide - rackunit - [current-check-handler - (Parameter (Any -> Any))] - [current-check-around - (Parameter ((Thunk Any) -> Any))]) - ; 3.3 (require (prefix-in t: (except-in rackunit struct:check-info struct:exn:test struct:exn:test:check struct:test-result struct:test-failure struct:test-error struct:test-success))) @@ -108,6 +103,8 @@ (require/opaque-type TestCase test-case? rackunit) (provide TestCase test-case?) + + (require (only-in rackunit test-suite)) (provide test-suite) (require/opaque-type TestSuite test-suite? rackunit) @@ -168,3 +165,14 @@ ; XXX Requires knowing more about test cases and structs #;[foldts-test-suite XXX]) + + +; 5.1 +(require/typed/provide + rackunit + [current-check-handler + (Parameter (Any -> Any))] + [current-check-around + (Parameter ((Thunk Any) -> Any))]) + +