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

Simplify special-env-typecheck-tests and give them better names.

Browse Source
This commit is contained in:
Eric Dobson 2013-12-01 18:27:01 -08:00
parent ffe0aa4a5d
commit 0e8cf664f4
2 changed files with 11 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -34,16 +34,17 @@
[(_ expr ty) (syntax/loc stx (tc-e expr #:ret (ret ty)))] [(_ expr ty) (syntax/loc stx (tc-e expr #:ret (ret ty)))]
[(id a #:ret b) [(id a #:ret b)
(syntax/loc stx (syntax/loc stx
(let-values (test-case (format "~a ~a" (quote-line-number id) 'a)
([(res1 expanded) (let-values
(phase1-phase0-eval ([(res1 expanded)
(let ([ex (local-expand #'a 'expression null)]) (phase1-phase0-eval
(find-mutated-vars ex mvar-env) (let ([ex (local-expand #'a 'expression null)])
#`(values '#,(tc-expr ex) '#,(syntax->datum ex))))] (find-mutated-vars ex mvar-env)
[(res2) (phase1-phase0-eval #`'#,b)]) #`(values '#,(tc-expr ex) '#,(syntax->datum ex))))]
(with-check-info (['expanded expanded]) [(res2) (phase1-phase0-eval #`'#,b)])
(check-tc-result-equal? (format "~a ~a" (quote-line-number id) 'a) (with-check-info (['expanded expanded])
res1 res2))))])) (unless (tc-result-equal/test? res1 res2)
(fail-check "Expression didn't have expected type."))))))]))
(define tests (define tests
(test-suite (test-suite

5
pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/test-utils.rkt
View File

@ -20,11 +20,6 @@
(syntax-case stx () (syntax-case stx ()
[(_ nm a b) [(_ nm a b)
(syntax/loc stx (test-check nm type-equal? a b))])) (syntax/loc stx (test-check nm type-equal? a b))]))
(define-binary-check (check-tc-result-equal?* tc-result-equal/test? a b))
(define-syntax (check-tc-result-equal? stx)
(syntax-case stx ()
[(_ nm a b)
(syntax/loc stx (test-case nm (check-tc-result-equal?* a b)))]))
(define-syntax gen-test-main (define-syntax gen-test-main
(syntax-parser (syntax-parser