From e8130a2fd1400e96d8125dbec813aa8dfc57656d Mon Sep 17 00:00:00 2001 From: Casey Klein Date: Tue, 5 Apr 2011 13:48:26 -0500 Subject: [PATCH] Fixes bug in `cross' pattern handling --- collects/redex/private/rewrite-side-conditions.rkt | 3 ++- collects/redex/tests/tl-test.rkt | 7 ++++++- 2 files changed, 8 insertions(+), 2 deletions(-) diff --git a/collects/redex/private/rewrite-side-conditions.rkt b/collects/redex/private/rewrite-side-conditions.rkt index 41a4e1835c..6adf0b6f0f 100644 --- a/collects/redex/private/rewrite-side-conditions.rkt +++ b/collects/redex/private/rewrite-side-conditions.rkt @@ -127,7 +127,7 @@ (let loop ([stx orig-stx] [names null] [depth 0]) - (syntax-case stx (name in-hole side-condition) + (syntax-case stx (name in-hole side-condition cross) [(name sym pat) (identifier? (syntax sym)) (loop (syntax pat) @@ -139,6 +139,7 @@ depth)] [(side-condition pat . rest) (loop (syntax pat) names depth)] + [(cross _) names] [(pat ...) (let i-loop ([pats (syntax->list (syntax (pat ...)))] [names names]) diff --git a/collects/redex/tests/tl-test.rkt b/collects/redex/tests/tl-test.rkt index 25275c5d41..98a0d93ac8 100644 --- a/collects/redex/tests/tl-test.rkt +++ b/collects/redex/tests/tl-test.rkt @@ -280,6 +280,12 @@ #:key (compose symbol->string bind-name))) '()) '(1 4 3 2 5 "s" t s))) + + (let () + (define-language L + (e (e e) number)) + ;; not a syntax error since first e is not a binder + (test (pair? (redex-match L ((cross e) e ...) (term ((hole 2) 1)))) #t)) ;; test caching (let () @@ -1489,7 +1495,6 @@ (e ((name x any) (name x any_2) ...))) #rx"different depths" 2) - (test-syn-err (reduction-relation grammar