Simplify special-env-typecheck-tests and give them better names.
original commit: 0e8cf664f4b91a210ca695ba604fd9a043b5c8e4
This commit is contained in:
parent
97fbd7827e
commit
efcca72de7
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
Loading…
Reference in New Issue
Block a user