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

Make tests have better names and remove duplicates.

Browse Source 
original commit: 775dd1509de40971935a9a70ca3ad8b59037fc8e
This commit is contained in:
Eric Dobson 2013-12-01 23:00:56 -08:00
parent efcca72de7
commit 3163c4e204
7 changed files with 23 additions and 32 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/keyword-expansion-test.rkt
View File

@ -56,10 +56,6 @@
[t-opt (() ()) (-> result)]
[t-opt ((one) ())
(-> one result)]
[t-opt (() (one))
(cl->*
(-> one true result)
(-> false false result))]
[t-opt ((one two three four) ())
(-> one two three four result)]
[t-opt (() (one))

3
pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/parse-type-tests.rkt
View File

@ -77,7 +77,6 @@
[(pred Number) (make-pred-ty N)]
[(-> (values Number Boolean Number)) (t:-> (-values (list N B N)))]
[(Number -> Number) (t:-> N N)]
[(Number -> Number) (t:-> N N)]
[(All (A) Number -> Number) (-poly (a) (t:-> N N))]
[(All (A) (Number -> Number)) (-poly (a) (t:-> N N))]
[(All (A) A -> A) (-poly (a) (t:-> a a))]
@ -112,8 +111,6 @@
[(Listof Number) (make-Listof N)]
[a (-v a) (dict-set initial-tvar-env 'a (-v a))]
[(All (a ...) (a ... -> Number))
(-polydots (a) ((list) [a a] . ->... . N))]
[(Any -> Boolean : Number) (make-pred-ty -Number)]
[(Any -> Boolean : #:+ (Number @ 0) #:- (! Number @ 0))

10
pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/remove-intersect-tests.rkt
View File

@ -10,8 +10,8 @@
(define-syntax (over-tests stx)
(syntax-case stx ()
[(_ [t1 t2 res] ...)
#'(test-suite "Tests for intersect"
(test-check (format "Overlap test: ~a ~a" 't1 't2) (lambda (a b) (eq? (not (not a)) b)) (overlap t1 t2) res) ...)]))
#'(test-suite "Tests for overlap"
(test-check (format "~a ~a" 't1 't2) (lambda (a b) (eq? (not (not a)) b)) (overlap t1 t2) res) ...)]))
(define overlap-tests
(over-tests
@ -20,8 +20,8 @@
(define-syntax (restr-tests stx)
(syntax-case stx ()
[(_ [t1 t2 res] ...)
#'(test-suite "Tests for intersect"
(test-check (format "Restrict test: ~a ~a" 't1 't2) type-compare? (restrict t1 t2) res) ...)]))
#'(test-suite "Tests for restrict"
(test-check (format "~a ~a" 't1 't2) type-compare? (restrict t1 t2) res) ...)]))
(define restrict-tests
@ -50,7 +50,7 @@
[(_ [t1 t2 res] ...)
(syntax/loc stx
(test-suite "Tests for remove"
(test-check (format "Remove test: ~a ~a" 't1 't2) type-compare? (remove t1 t2) res) ...))]))
(test-check (format "~a ~a" 't1 't2) type-compare? (remove t1 t2) res) ...))]))
(define remove-tests
(remo-tests

2
pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/special-env-typecheck-tests.rkt
View File

@ -31,7 +31,7 @@
(define-syntax (tc-e stx)
(syntax-parse stx
[(_ expr ty) (syntax/loc stx (tc-e expr #:ret (ret ty)))]
[(tc-e expr ty) (syntax/loc stx (tc-e expr #:ret (ret ty)))]
[(id a #:ret b)
(syntax/loc stx
(test-case (format "~a ~a" (quote-line-number id) 'a)

4
pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/subst-tests.rkt
View File

@ -8,10 +8,10 @@
(gen-test-main)
(define-syntax-rule (s img var tgt result)
(test-eq? "test" (substitute img 'var tgt) result))
(test-eq? (format "~a" '(img tgt)) (substitute img 'var tgt) result))
(define-syntax-rule (s... imgs var tgt result)
(test-eq? "test" (substitute-dots (list . imgs) #f 'var tgt) result))
(test-eq? (format "~a" '(img tgt)) (substitute-dots (list . imgs) #f 'var tgt) result))
(define tests
(test-suite "Tests for substitution"

13
pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/type-equal-tests.rkt
View File

@ -14,16 +14,13 @@
(define-syntax (te-tests stx)
(define (single-test stx)
(syntax-case stx (FAIL)
[(FAIL t s) #'((test-check (format "FAIL ~a" '(t s)) (lambda (a b) (not (type-equal? a b))) t s)
(test-check (format "FAIL ~a" '(s t)) (lambda (a b) (not (type-equal? a b))) s t))]
[(t s) (syntax/loc stx
((test-check (format "~a" '(t s)) type-equal? t s)
(test-check (format "~a" '(s t)) type-equal? s t)))]))
[(FAIL t s) (syntax/loc stx (test-check (format "FAIL ~a" '(t s))
(lambda (a b) (not (type-equal? a b))) t s))]
[(t s) (syntax/loc stx (test-check (format "~a" '(t s)) type-equal? t s))]))
(syntax-case stx ()
[(_ cl ...)
(with-syntax ([((cl1 cl2) ...) (map single-test (syntax->list #'(cl ...)))])
#'(test-suite "Tests for type equality"
cl1 ... cl2 ...))]))
#`(test-suite "Tests for type equality"
#,@(map single-test (syntax->list #'(cl ...))))]))
(define (fld* t) (make-fld t (datum->syntax #'here 'values) #f))

19
pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/typecheck-tests.rkt
View File

@ -56,6 +56,7 @@
(require
"evaluator.rkt"
"test-utils.rkt"
syntax/location
(for-syntax
racket/base
syntax/parse
@ -80,14 +81,14 @@
(pattern (~seq) #:attr v #'#f))
(define (check-no-error stx body)
(define (test-no-error stx name body)
(quasisyntax/loc stx
(check-not-exn
(test-not-exn (format "~a ~a" (quote-line-number #,name) '#,name)
(lambda () #,body))))
(define (check-syntax-error stx body)
(define (test-syntax-error stx name body)
(quasisyntax/loc stx
(check-exn
(test-exn (format "~a ~a" (quote-line-number #,name) '#,name)
exn:fail:syntax?
(lambda () #,body)))))
@ -96,10 +97,10 @@
(define-syntax (tc-e stx)
(syntax-parse stx
[(_ code:expr #:proc p)
(check-no-error stx
(test-no-error stx #'code
#'(phase1-eval (test/proc (quote-syntax code) p)))]
[(_ code:expr return:return x:expected)
(check-no-error stx
(test-no-error stx #'code
#'(phase1-eval (test (quote-syntax code) return.v x.v)))]))
(define-syntax (tc-e/t stx)
@ -110,7 +111,7 @@
(define-syntax (tc-l stx)
(syntax-parse stx
[(_ lit ty exp:expected)
(check-no-error stx
(test-no-error stx (syntax/loc #'lit (LITERAL lit))
#'(phase1-eval (test-literal #'lit ty exp.v)))]))
@ -118,13 +119,13 @@
(define-syntax (tc-err stx)
(syntax-parse stx
[(_ code:expr ex:expected)
(check-syntax-error stx
(test-syntax-error stx (syntax/loc #'code (FAIL code))
#'(phase1-eval (tc (tr-expand (quote-syntax code)) ex.v)))]))
(define-syntax (tc-l/err stx)
(syntax-parse stx
[(_ lit:expr ex:expected)
(check-syntax-error stx
(test-syntax-error stx #'(syntax/loc #'lit (LITERAL/FAIL lit))
#'(phase1-eval (tc-literal #'lit ex.v)))]))