Remove typed rackunit code and depend on other package (#596)
* Remove typed rackunit code and depend on other package
This commit is contained in:
Jack Firth
Sam Tobin-Hochstadt
parent
0b191039b5
commit
453825d1fe
|
|
@ -18,7 +18,7 @@ install:
|
|||
- echo file://`pwd`/pkgs-catalog/ > catalog-config.txt
|
||||
- raco pkg config catalogs >> catalog-config.txt
|
||||
- raco pkg config --set catalogs `cat catalog-config.txt`
|
||||
- raco pkg update -i --no-setup source-syntax/ typed-racket-lib/ typed-racket-more/ typed-racket-compatibility/ typed-racket-doc/ typed-racket/ typed-racket-test/
|
||||
- raco pkg update -i --auto --no-setup source-syntax/ typed-racket-lib/ typed-racket-more/ typed-racket-compatibility/ typed-racket-doc/ typed-racket/ typed-racket-test/
|
||||
- raco setup typed typed-racket typed-racket-test typed-scheme
|
||||
|
||||
script:
|
||||
|
|
|
|||
|
|
@ -10,6 +10,7 @@
|
|||
"draw-lib"
|
||||
"rackunit-lib"
|
||||
"rackunit-gui"
|
||||
"rackunit-typed"
|
||||
"snip-lib"
|
||||
"typed-racket-lib"
|
||||
"gui-lib"
|
||||
|
|
@ -18,6 +19,8 @@
|
|||
"racket-index"
|
||||
"sandbox-lib"))
|
||||
|
||||
(define implies '("rackunit-typed"))
|
||||
|
||||
(define pkg-desc "Types for various libraries")
|
||||
|
||||
(define pkg-authors '(samth stamourv))
|
||||
|
|
|
|||
|
|
@ -1,3 +0,0 @@
|
|||
#lang racket/base
|
||||
(require typed/rackunit/main)
|
||||
(provide (all-from-out typed/rackunit/main))
|
||||
|
|
@ -1,11 +0,0 @@
|
|||
#lang typed/racket/base
|
||||
|
||||
(require/typed/provide
|
||||
rackunit/docs-complete
|
||||
[check-docs (Symbol
|
||||
[#:skip (U Regexp
|
||||
Symbol
|
||||
(Listof (U Regexp Symbol))
|
||||
(Symbol -> Any)
|
||||
#f)]
|
||||
-> Any)])
|
||||
|
|
@ -1,10 +0,0 @@
|
|||
#lang typed/racket
|
||||
(require typed/rackunit
|
||||
typed/private/utils)
|
||||
|
||||
(require/typed/provide
|
||||
rackunit/gui
|
||||
[test/gui
|
||||
(Test * -> Any)]
|
||||
[make-gui-runner
|
||||
(-> (Test * -> Any))])
|
||||
|
|
@ -1,3 +0,0 @@
|
|||
#lang info
|
||||
|
||||
(define test-responsibles '((all jay)))
|
||||
|
|
@ -1,314 +0,0 @@
|
|||
#lang typed/racket
|
||||
(require typed/racket/class
|
||||
typed/private/utils
|
||||
typed/private/rewriter
|
||||
"type-env-ext.rkt"
|
||||
(for-syntax syntax/parse))
|
||||
|
||||
(define-type check-ish-ty
|
||||
(case-lambda
|
||||
(Any Any -> Any)
|
||||
(Any Any String -> Any)))
|
||||
(define-type (Predicate A) (A -> Boolean))
|
||||
(define-type (Thunk A) (-> A))
|
||||
|
||||
; 3.2
|
||||
(require/typed/provide
|
||||
rackunit
|
||||
[check-eq? check-ish-ty]
|
||||
[check-not-eq? check-ish-ty]
|
||||
[check-eqv? check-ish-ty]
|
||||
[check-not-eqv? check-ish-ty]
|
||||
[check-equal? check-ish-ty]
|
||||
[check-not-equal? check-ish-ty]
|
||||
[check-pred
|
||||
(All (A)
|
||||
(case-lambda
|
||||
((A -> Any) A -> Any)
|
||||
((A -> Any) A String -> Any)))]
|
||||
[check-=
|
||||
(case-lambda
|
||||
(Real Real Real -> Any)
|
||||
(Real Real Real String -> Any))]
|
||||
[check-true
|
||||
(case-lambda
|
||||
(Any -> Any)
|
||||
(Any String -> Any))]
|
||||
[check-false
|
||||
(case-lambda
|
||||
(Any -> Any)
|
||||
(Any String -> Any))]
|
||||
[check-not-false
|
||||
(case-lambda
|
||||
(Any -> Any)
|
||||
(Any String -> Any))]
|
||||
[check-exn
|
||||
(case-lambda
|
||||
((U (Predicate Any) Regexp) (Thunk Any) -> Any)
|
||||
((U (Predicate Any) Regexp) (Thunk Any) String -> Any))]
|
||||
[check-not-exn
|
||||
(case-lambda
|
||||
((Thunk Any) -> Any)
|
||||
((Thunk Any) String -> Any))]
|
||||
[check-regexp-match
|
||||
(Regexp String -> Any)]
|
||||
|
||||
|
||||
[check (All (A B)
|
||||
(case-lambda
|
||||
((A B -> Any) A B -> Any)
|
||||
((A B -> Any) A B String -> Any)))]
|
||||
|
||||
[fail
|
||||
(case-lambda
|
||||
(-> Void)
|
||||
(String -> Void))])
|
||||
|
||||
(require/typed rackunit/log
|
||||
[test-log! (Any -> Any)])
|
||||
|
||||
; 3.2.1
|
||||
(require-typed-struct check-info
|
||||
([name : Symbol] [value : Any])
|
||||
rackunit)
|
||||
(define-type CheckInfo check-info)
|
||||
(provide (struct-out check-info) CheckInfo)
|
||||
(require/typed/provide
|
||||
rackunit
|
||||
[make-check-name (String -> CheckInfo)]
|
||||
[make-check-params ((Listof Any) -> CheckInfo)]
|
||||
[make-check-location ((List Any (Option Number) (Option Number) (Option Number) (Option Number)) -> CheckInfo)]
|
||||
[make-check-expression (Any -> CheckInfo)]
|
||||
[make-check-message (String -> CheckInfo)]
|
||||
[make-check-actual (Any -> CheckInfo)]
|
||||
[make-check-expected (Any -> CheckInfo)]
|
||||
[with-check-info* (All (A) ((Listof CheckInfo) (Thunk A) -> A))])
|
||||
(require (only-in rackunit with-check-info))
|
||||
(provide with-check-info)
|
||||
|
||||
; 3.2.2
|
||||
(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.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)))
|
||||
(define-syntax (test-begin stx)
|
||||
(syntax-case stx ()
|
||||
[(_ expr ...)
|
||||
(syntax/loc stx
|
||||
((current-test-case-around)
|
||||
(lambda ()
|
||||
(with-handlers ([(λ (e)
|
||||
(and (exn:fail? e)
|
||||
(not (exn:test? e))))
|
||||
(λ ([e : exn:fail])
|
||||
(test-log! #f)
|
||||
(raise e))])
|
||||
(parameterize ([current-check-handler raise])
|
||||
(void)
|
||||
expr ...)))))]
|
||||
[_
|
||||
(raise-syntax-error
|
||||
#f
|
||||
"Correct form is (test-begin expr ...)"
|
||||
stx)]))
|
||||
|
||||
(define-syntax (test-case stx)
|
||||
(syntax-case stx ()
|
||||
[(_ name expr ...)
|
||||
(quasisyntax/loc stx
|
||||
(parameterize
|
||||
([current-test-name
|
||||
(ensure-string name (quote-syntax #,(datum->syntax #f 'loc #'name)))])
|
||||
(test-begin expr ...)))]))
|
||||
|
||||
(: ensure-string : Any Any -> String)
|
||||
(define (ensure-string name src-stx)
|
||||
(unless (string? name)
|
||||
(raise-argument-error 'test-case "string?" name))
|
||||
name)
|
||||
|
||||
(provide test-begin test-case)
|
||||
|
||||
(require/opaque-type TestCase test-case? rackunit)
|
||||
(provide TestCase test-case?)
|
||||
|
||||
(define-type Seed Any)
|
||||
|
||||
(define-type test-suite-handler-down
|
||||
(rackunit-test-suite (Option String) (Thunk Any) (Thunk Any) Seed -> Seed))
|
||||
(define-type test-suite-handler-up
|
||||
(rackunit-test-suite (Option String) (Thunk Any) (Thunk Any) Seed Seed -> Seed))
|
||||
(define-type test-suite-handler-here
|
||||
(rackunit-test-case (Option String) (Thunk Any) Seed -> Seed))
|
||||
|
||||
(require/typed
|
||||
rackunit
|
||||
[#:struct rackunit-test-case ([name : (Option String)] [action : (Thunk Any)])
|
||||
#:constructor-name make-rackunit-test-case]
|
||||
[#:struct rackunit-test-suite
|
||||
([name : String]
|
||||
[tests : (test-suite-handler-down
|
||||
test-suite-handler-up
|
||||
test-suite-handler-here
|
||||
Seed -> Seed)]
|
||||
[before : (Thunk Any)]
|
||||
[after : (Thunk Any)])
|
||||
#:constructor-name make-rackunit-test-suite])
|
||||
(require/typed
|
||||
rackunit/private/test-suite
|
||||
[apply-test-suite (rackunit-test-suite
|
||||
test-suite-handler-down
|
||||
test-suite-handler-up
|
||||
test-suite-handler-here
|
||||
Seed -> Seed)])
|
||||
|
||||
(define current-seed : (Parameter Seed)
|
||||
(make-parameter #f))
|
||||
|
||||
; taken directly from rackunit/private/test-suite
|
||||
(: test-suite-test-case-around (test-suite-handler-here -> ((Thunk Any) -> Void)))
|
||||
(define (test-suite-test-case-around fhere)
|
||||
(lambda (thunk)
|
||||
(let* ([name (current-test-name)]
|
||||
[test (make-rackunit-test-case name thunk)]
|
||||
[seed (current-seed)])
|
||||
(current-seed (fhere test name thunk seed)))))
|
||||
|
||||
; taken directly from rackunit/private/test-suite
|
||||
(: test-suite-check-around (test-suite-handler-here -> ((Thunk Any) -> Void)))
|
||||
(define (test-suite-check-around fhere)
|
||||
(lambda (thunk)
|
||||
(let* ([name #f]
|
||||
[test (make-rackunit-test-case name thunk)]
|
||||
[seed (current-seed)])
|
||||
(current-seed (fhere test name thunk seed)))))
|
||||
|
||||
; adapted from rackunit/private/test-suite
|
||||
(define-syntax (test-suite stx)
|
||||
(syntax-parse stx
|
||||
[(_ name:expr
|
||||
(~or (~seq #:before before:expr) (~seq))
|
||||
(~or (~seq #:after after:expr) (~seq))
|
||||
test:expr ...)
|
||||
(with-syntax ([before (if (attribute before) #'before #'void)]
|
||||
[after (if (attribute after) #'after #'void)])
|
||||
#'(let ([tests
|
||||
: (test-suite-handler-down
|
||||
test-suite-handler-up
|
||||
test-suite-handler-here
|
||||
Seed -> Seed)
|
||||
(lambda (fdown fup fhere seed)
|
||||
(define (run/inner [x : Any]) : Any
|
||||
(cond [(rackunit-test-suite? x)
|
||||
(current-seed
|
||||
(apply-test-suite x fdown fup fhere (current-seed)))]
|
||||
[(list? x)
|
||||
(for-each run/inner x)]
|
||||
[else
|
||||
(void)]))
|
||||
(parameterize
|
||||
([current-seed seed]
|
||||
[current-test-case-around (test-suite-test-case-around fhere)]
|
||||
[current-check-around (test-suite-check-around fhere)])
|
||||
(let ([t : Any test])
|
||||
(run/inner t))
|
||||
...
|
||||
(current-seed)))])
|
||||
(make-rackunit-test-suite
|
||||
(ann name : String)
|
||||
tests
|
||||
(ann before : (Thunk Any))
|
||||
(ann after : (Thunk Any)))))]))
|
||||
(provide test-suite)
|
||||
|
||||
(define-type TestSuite rackunit-test-suite)
|
||||
(provide TestSuite (rename-out [rackunit-test-suite? test-suite?]))
|
||||
|
||||
(define-type Test (U TestCase TestSuite))
|
||||
(provide Test)
|
||||
|
||||
(require/typed/provide
|
||||
rackunit
|
||||
[make-test-suite
|
||||
(String (Listof (U TestCase TestSuite)) [#:before (Thunk Any)] [#:after (Thunk Any)] -> TestSuite)])
|
||||
|
||||
(require (only-in rackunit define-test-suite define/provide-test-suite))
|
||||
(provide define-test-suite define/provide-test-suite)
|
||||
|
||||
(require/typed/provide
|
||||
rackunit
|
||||
[current-test-name (Parameter (Option String))]
|
||||
[current-test-case-around (Parameter ((Thunk Any) -> Any))])
|
||||
|
||||
; 3.3.1.1
|
||||
(define-syntax-rule (def-test [tst (ch args ...)] ...)
|
||||
(begin (provide tst ...)
|
||||
(define-syntax-rule (tst name args ...)
|
||||
(test-case name (ch args ...))) ...))
|
||||
|
||||
(def-test
|
||||
[test-check (check op v1 v2)]
|
||||
(test-pred (check-pred pred v))
|
||||
(test-equal? (check-equal? v1 v2))
|
||||
(test-eq? (check-eq? v1 v2))
|
||||
(test-eqv? (check-eqv? v1 v2))
|
||||
(test-= (check-= v1 v2 epsilon))
|
||||
(test-true (check-true v))
|
||||
(test-false (check-false v))
|
||||
(test-not-false (check-not-false v))
|
||||
(test-exn (check-exn pred thunk))
|
||||
(test-not-exn (check-not-exn thunk)))
|
||||
|
||||
|
||||
; 3.4
|
||||
(require (only-in rackunit before after around delay-test))
|
||||
(provide before after around delay-test)
|
||||
|
||||
; 3.5
|
||||
; XXX require/expose seems WRONG for typed/racket
|
||||
|
||||
; 3.7
|
||||
(require-typed-struct (exn:test exn) () rackunit)
|
||||
(require-typed-struct (exn:test:check exn:test) ([stack : (Listof CheckInfo)]) rackunit)
|
||||
(require-typed-struct test-result ([test-case-name : (Option String)]) rackunit)
|
||||
(require-typed-struct (test-failure test-result) ([result : Any]) rackunit)
|
||||
(require-typed-struct (test-error test-result) ([result : Any]) rackunit)
|
||||
(require-typed-struct (test-success test-result) ([result : Any]) rackunit)
|
||||
(provide (struct-out exn:test) (struct-out exn:test:check)
|
||||
(struct-out test-result)
|
||||
(struct-out test-failure) (struct-out test-error) (struct-out test-success))
|
||||
|
||||
(define-type (Tree A)
|
||||
(Rec The-Tree
|
||||
(Listof (U A The-Tree))))
|
||||
|
||||
(require/typed/provide
|
||||
rackunit
|
||||
[run-test-case
|
||||
((Option String) (Thunk Any) -> test-result)]
|
||||
[run-test
|
||||
(Test -> (Tree test-result))]
|
||||
; XXX Requires keywords and weird stuff
|
||||
#;[fold-test-results
|
||||
XXX]
|
||||
; XXX Requires knowing more about test cases and structs
|
||||
#;[foldts-test-suite
|
||||
XXX])
|
||||
|
||||
|
||||
; 5.1
|
||||
(require/typed/provide
|
||||
rackunit
|
||||
[current-check-handler
|
||||
(Parameter (-> (U (Rec flat
|
||||
(U Boolean Complex Char
|
||||
Null Symbol String
|
||||
Keyword (Pairof flat flat)))
|
||||
exn)
|
||||
Any))]
|
||||
[current-check-around
|
||||
(Parameter ((Thunk Any) -> Any))])
|
||||
|
||||
|
||||
|
|
@ -1,14 +0,0 @@
|
|||
#lang typed/racket
|
||||
(require typed/rackunit
|
||||
typed/private/utils)
|
||||
|
||||
(define-type Verbosity
|
||||
(U 'quiet 'normal 'verbose))
|
||||
|
||||
(require/typed/provide
|
||||
rackunit/text-ui
|
||||
[run-tests
|
||||
(case-lambda
|
||||
(Test -> Natural)
|
||||
(Test Verbosity -> Natural))])
|
||||
(provide Verbosity)
|
||||
|
|
@ -1,17 +0,0 @@
|
|||
#lang racket/base
|
||||
|
||||
(require typed-racket/utils/utils
|
||||
(prefix-in ru: rackunit)
|
||||
(for-syntax
|
||||
racket/base syntax/parse
|
||||
(utils tc-utils)
|
||||
(env init-envs)
|
||||
(rep prop-rep object-rep type-rep)
|
||||
(types abbrev)))
|
||||
|
||||
(define-for-syntax unit-env
|
||||
(make-env
|
||||
[ru:current-test-case-around
|
||||
(-poly (a) (-> (-> a) a))]))
|
||||
|
||||
(begin-for-syntax (initialize-type-env unit-env))
|
||||
Loading…
Reference in New Issue
Block a user