Simplify special-env-typecheck-tests and give them better names.
This commit is contained in:
parent
ffe0aa4a5d
commit
0e8cf664f4
|
@ -34,6 +34,7 @@
|
|||
[(_ 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)
|
||||
(let-values
|
||||
([(res1 expanded)
|
||||
(phase1-phase0-eval
|
||||
|
@ -42,8 +43,8 @@
|
|||
#`(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))))]))
|
||||
(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