From 99f1cc44dfeea52738cfd05629f4809f875a2afa Mon Sep 17 00:00:00 2001 From: Jay McCarthy Date: Thu, 22 Mar 2012 22:17:27 -0600 Subject: [PATCH] redex-match violates its documented contract This patch fixes the problem that the hole matcher may return an empty list rather than a #f that gets sent to the caller of redex-match. I re-ran the Redex tests and found no violations. However, I am not confident that there isn't a more correct place to put this '() -> #f replacement. I will be immediately forwarding this push email to Robby to have him check it. --- collects/redex/private/matcher.rkt | 5 ++++- collects/redex/tests/tl-test.rkt | 4 ++++ 2 files changed, 8 insertions(+), 1 deletion(-) diff --git a/collects/redex/private/matcher.rkt b/collects/redex/private/matcher.rkt index c249535834..caa1b22172 100644 --- a/collects/redex/private/matcher.rkt +++ b/collects/redex/private/matcher.rkt @@ -1324,7 +1324,10 @@ See match-a-pattern.rkt for more details (let loop ([mtches mtches] [acc null]) (cond - [(null? mtches) acc] + [(null? mtches) + (if (null? acc) + #f + acc)] [else (let* ([mtch (car mtches)] [bindings (mtch-bindings mtch)] diff --git a/collects/redex/tests/tl-test.rkt b/collects/redex/tests/tl-test.rkt index 46185810e8..af35d28cbf 100644 --- a/collects/redex/tests/tl-test.rkt +++ b/collects/redex/tests/tl-test.rkt @@ -424,6 +424,10 @@ (test (and (redex-match L -b 100) #t) #t) (test (redex-match L -b 3) #f)) + (let () + (test (redex-match empty-language number 'a) #f) + (test (redex-match empty-language (in-hole hole number) 'a) #f)) + (parameterize ([current-namespace (make-base-namespace)]) (eval '(require redex/reduction-semantics redex/pict)) (eval '(define-language L