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

original commit: 0e8cf664f4b91a210ca695ba604fd9a043b5c8e4
This commit is contained in:
Eric Dobson 2013-12-01 18:27:01 -08:00
parent 97fbd7827e
commit efcca72de7
2 changed files with 11 additions and 15 deletions

View File

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

View File

@ -20,11 +20,6 @@
(syntax-case stx ()
[(_ nm 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
(syntax-parser