From 7aea90242a4c0324f670510c5ae32de21cb0e8ca Mon Sep 17 00:00:00 2001 From: Asumu Takikawa Date: Fri, 3 Jun 2016 13:40:24 -0400 Subject: [PATCH] Adjust contract tests to allow first-order checks --- .../unit-tests/contract-tests.rkt | 21 ++++++++++--------- 1 file changed, 11 insertions(+), 10 deletions(-) diff --git a/typed-racket-test/unit-tests/contract-tests.rkt b/typed-racket-test/unit-tests/contract-tests.rkt index 21a7cbe0..9c28f238 100644 --- a/typed-racket-test/unit-tests/contract-tests.rkt +++ b/typed-racket-test/unit-tests/contract-tests.rkt @@ -115,16 +115,17 @@ (define namespace (ctc-namespace)) (define val (eval (quote val-expr) namespace)) (define fun-val (eval (quote fun-expr) namespace)) - (define ctced-val - (eval #`(let () - #,@(map (λ (stx) (syntax-shift-phase-level stx 1)) - extra-stxs) - (contract #,(syntax-shift-phase-level ctc-stx 1) - #,val - #,(quote (quote #,pos)) - #,(quote (quote #,neg)))) - namespace)) - (check (λ () (fun-val ctced-val))))))])) + (check (λ () + (define ctced-val + (eval #`(let () + #,@(map (λ (stx) (syntax-shift-phase-level stx 1)) + extra-stxs) + (contract #,(syntax-shift-phase-level ctc-stx 1) + #,val + #,(quote (quote #,pos)) + #,(quote (quote #,neg)))) + namespace)) + (fun-val ctced-val))))))])) (define tests (test-suite "Contract Tests"