diff --git a/collects/redex/examples/contracts.ss b/collects/redex/examples/contracts.ss index a74c9fd0fa..12434f2198 100644 --- a/collects/redex/examples/contracts.ss +++ b/collects/redex/examples/contracts.ss @@ -8,9 +8,8 @@ and a few numeric predicates |# -(require redex redex/examples/subst) - -(reduction-steps-cutoff 10) +(require redex/reduction-semantics + redex/examples/subst) (define-language lang (e (e e ...) @@ -113,41 +112,41 @@ and a few numeric predicates [(¬ +) -] [(¬ -) +]) -(test--> reds (term ((λ (x y) x) 1 2)) 1) -(test--> reds (term ((λ (x y) y) 1 2)) 2) -(test--> reds (term (if (if #t #f #t) #f #t)) (term #t)) -(test--> reds (term (positive? 1)) #t) -(test--> reds (term (positive? -1)) #f) -(test--> reds (term (positive? (λ (x) x))) #f) -(test--> reds (term (odd? 1)) #t) -(test--> reds (term (odd? 2)) #f) -(test--> reds (term (odd? (λ (x) x))) #f) -(test--> reds (term (car (cdr (cdr (cons 1 (cons 2 (cons 3 #f))))))) 3) +(test-->> reds (term ((λ (x y) x) 1 2)) 1) +(test-->> reds (term ((λ (x y) y) 1 2)) 2) +(test-->> reds (term (if (if #t #f #t) #f #t)) (term #t)) +(test-->> reds (term (positive? 1)) #t) +(test-->> reds (term (positive? -1)) #f) +(test-->> reds (term (positive? (λ (x) x))) #f) +(test-->> reds (term (odd? 1)) #t) +(test-->> reds (term (odd? 2)) #f) +(test-->> reds (term (odd? (λ (x) x))) #f) +(test-->> reds (term (car (cdr (cdr (cons 1 (cons 2 (cons 3 #f))))))) 3) -(test--> reds (term ((λ (x) x) (blame -))) (term (blame -))) -(test--> reds (term (ac number? 1 +)) 1) -(test--> reds (term (ac number? (λ (x) x) +)) (term (blame +))) -(test--> reds (term ((ac (-> number? number?) (λ (x) x) +) 1)) 1) -(test--> reds +(test-->> reds (term ((λ (x) x) (blame -))) (term (blame -))) +(test-->> reds (term (ac number? 1 +)) 1) +(test-->> reds (term (ac number? (λ (x) x) +)) (term (blame +))) +(test-->> reds (term ((ac (-> number? number?) (λ (x) x) +) 1)) 1) +(test-->> reds (term ((ac (-> number? number?) (λ (x) x) +) #f)) (term (blame -))) -(test--> reds +(test-->> reds (term ((ac (-> number? number?) (λ (x) #f) +) 1)) (term (blame +))) -(test--> reds +(test-->> reds (term (ac (or/c odd? positive?) 1 +)) 1) -(test--> reds +(test-->> reds (term (ac (or/c odd? positive?) -1 +)) -1) -(test--> reds +(test-->> reds (term (ac (or/c odd? positive?) 2 +)) 2) -(test--> reds +(test-->> reds (term (ac (or/c odd? positive?) -2 +)) (term (blame +))) -(test--> reds +(test-->> reds (term (ac (cons odd? positive?) (cons 3 1) +)) (term (cons 3 1))) diff --git a/collects/redex/examples/subst.ss b/collects/redex/examples/subst.ss index 114a52338f..1bca5538dc 100644 --- a/collects/redex/examples/subst.ss +++ b/collects/redex/examples/subst.ss @@ -1,5 +1,5 @@ #lang scheme -(require redex) +(require redex/reduction-semantics) (provide subst subst-n) (define-language subst-lang diff --git a/collects/redex/private/reduction-semantics.ss b/collects/redex/private/reduction-semantics.ss index e31b86a443..2c75bb15a0 100644 --- a/collects/redex/private/reduction-semantics.ss +++ b/collects/redex/private/reduction-semantics.ss @@ -1872,14 +1872,14 @@ '#,(syntax-column stx) '#,(syntax-position stx))) -(define-syntax (test--> stx) +(define-syntax (test-->> stx) (syntax-case stx () [(_ red #:cycles-ok e1 e2 ...) - #`(test-->/procs red e1 (list e2 ...) #t #,(get-srcloc stx))] + #`(test-->>/procs red e1 (list e2 ...) #t #,(get-srcloc stx))] [(_ red e1 e2 ...) - #`(test-->/procs red e1 (list e2 ...) #f #,(get-srcloc stx))])) + #`(test-->>/procs red e1 (list e2 ...) #f #,(get-srcloc stx))])) -(define (test-->/procs red arg expected cycles-ok? srcinfo) +(define (test-->>/procs red arg expected cycles-ok? srcinfo) (let-values ([(got got-cycle?) (apply-reduction-relation*/cycle? red arg)]) (inc-tests) @@ -1991,7 +1991,7 @@ make-match test-equal - test--> + test-->> test-predicate test-results) diff --git a/collects/redex/private/tl-test.ss b/collects/redex/private/tl-test.ss index 99ec2b0503..d2fa533423 100644 --- a/collects/redex/private/tl-test.ss +++ b/collects/redex/private/tl-test.ss @@ -1422,9 +1422,9 @@ (let () (define red (reduction-relation empty-language (--> 1 2))) - (test (capture-output (test--> red 1 2) (test-results)) + (test (capture-output (test-->> red 1 2) (test-results)) "One test passed.\n") - (test (capture-output (test--> red 2 3) (test-results)) + (test (capture-output (test-->> red 2 3) (test-results)) #rx"FAILED tl-test.ss:[0-9.]+\nexpected: 3\n actual: 2\n1 test failed \\(out of 1 total\\).\n")) (let () @@ -1434,16 +1434,16 @@ (--> a c) (--> c d) (--> b d))) - (test (capture-output (test--> red-share (term a) (term d)) (test-results)) + (test (capture-output (test-->> red-share (term a) (term d)) (test-results)) "One test passed.\n")) (let () (define red-cycle (reduction-relation empty-language (--> a a))) - (test (capture-output (test--> red-cycle #:cycles-ok (term a)) (test-results)) + (test (capture-output (test-->> red-cycle #:cycles-ok (term a)) (test-results)) "One test passed.\n") - (test (capture-output (test--> red-cycle (term a)) (test-results)) + (test (capture-output (test-->> red-cycle (term a)) (test-results)) #rx"FAILED tl-test.ss:[0-9.]+\nfound a cycle in the reduction graph\n1 test failed \\(out of 1 total\\).\n")) (print-tests-passed 'tl-test.ss)) diff --git a/collects/redex/redex.scrbl b/collects/redex/redex.scrbl index 4fa6b4f173..e8282f578c 100644 --- a/collects/redex/redex.scrbl +++ b/collects/redex/redex.scrbl @@ -997,7 +997,7 @@ all non-GUI portions of Redex) and also exported by Tests to see if @scheme[e1] is equal to @scheme[e2]. } -@defform/subs[(test--> reduction-relation maybe-cycles e1 e2 ...) +@defform/subs[(test-->> reduction-relation maybe-cycles e1 e2 ...) ([cycles (code:line) #:cycles-ok])]{ Tests to see if the value of @scheme[e1] (which should be a term), diff --git a/collects/redex/reduction-semantics.ss b/collects/redex/reduction-semantics.ss index 641b7cc567..988e7deea2 100644 --- a/collects/redex/reduction-semantics.ss +++ b/collects/redex/reduction-semantics.ss @@ -37,7 +37,7 @@ make-bind bind? bind-name bind-exp test-equal - test--> + test-->> test-predicate test-results) diff --git a/doc/release-notes/redex/HISTORY.txt b/doc/release-notes/redex/HISTORY.txt index ad6b0b2972..c912b0c085 100644 --- a/doc/release-notes/redex/HISTORY.txt +++ b/doc/release-notes/redex/HISTORY.txt @@ -1,5 +1,7 @@ v4.1.5 + * renamed test--> to test-->> + * define-metafunction and reduction-relation now work better with Check Syntax, as