From 98a4002c64e8f103f0919d71ce7353591bf05f03 Mon Sep 17 00:00:00 2001 From: Ryan Culpepper Date: Sat, 28 Jul 2012 17:34:11 -0400 Subject: [PATCH] syntax/parse: fix bug in specialized code for ellipsis patterns The result of 'stx->list' is not always either a list or #f. Merge to 5.3. (cherry picked from commit e10951024f0944dfa60b3ed10b0fcc058115275b) --- .../syntax/parse/experimental/private/substitute.rkt | 2 +- collects/syntax/parse/private/residual.rkt | 2 +- collects/tests/stxparse/test.rkt | 11 +++++++++++ 3 files changed, 13 insertions(+), 2 deletions(-) diff --git a/collects/syntax/parse/experimental/private/substitute.rkt b/collects/syntax/parse/experimental/private/substitute.rkt index 013fe908c4..b05447c6b3 100644 --- a/collects/syntax/parse/experimental/private/substitute.rkt +++ b/collects/syntax/parse/experimental/private/substitute.rkt @@ -222,7 +222,7 @@ A HeadGuide (HG) is one of: (lambda (env lenv) (let* ([v (f1 env lenv)] [v* (stx->list v)]) - (unless v* + (unless (list? v*) (raise-syntax-error 'template "splicing template did not produce a syntax list" stx)) diff --git a/collects/syntax/parse/private/residual.rkt b/collects/syntax/parse/private/residual.rkt index f0ffd4456e..b9ef9bc0a3 100644 --- a/collects/syntax/parse/private/residual.rkt +++ b/collects/syntax/parse/private/residual.rkt @@ -205,7 +205,7 @@ (define (predicate-ellipsis-parser x cx pr es pred? desc rl) (let ([elems (stx->list x)]) - (if (and elems (andmap pred? elems)) + (if (and elems (list? elems) (andmap pred? elems)) (values 'ok elems) (let loop ([x x] [cx cx] [i 0]) (cond [(syntax? x) diff --git a/collects/tests/stxparse/test.rkt b/collects/tests/stxparse/test.rkt index 717c77026e..2aeecb5fa2 100644 --- a/collects/tests/stxparse/test.rkt +++ b/collects/tests/stxparse/test.rkt @@ -459,3 +459,14 @@ (not #rx"expected foo") ;; y:nat was incorrectly considered part of opaque region #rx"expected exact-nonnegative-integer") ) + +;; from Neil Van Dyke (7/28/2012) +(test-case "specialized predicate-ellipsis-parser" + ;; test that it works on improper lists + ;; ... when input is syntax + (check-eq? (syntax-parse #'(a b c . d) [(x:id ...) #t] [_ #f]) #f) + ;; ... and when input is stx pair (but not syntax) + (check-eq? (syntax-parse #'(a b c . d) [(_ x:id ...) #t] [_ #f]) #f) + ;; test that it works on proper lists w/ embedded stxpairs + (check-eq? (syntax-parse #'(a b . (c d)) [(x:id ...) #t] [_ #f]) #t) + (check-eq? (syntax-parse #'(a b . (c d)) [(_ x:id ...) #t] [_ #f]) #t))