suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

syntax/parse: fix bug in specialized code for ellipsis patterns

Browse Source 
The result of 'stx->list' is not always either a list or #f.

Merge to 5.3.
(cherry picked from commit e10951024f)
This commit is contained in:
Ryan Culpepper 2012-07-28 17:34:11 -04:00
parent c0b1c96850
commit 98a4002c64
3 changed files with 13 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
collects/syntax/parse/experimental/private/substitute.rkt
View File

@ -222,7 +222,7 @@ A HeadGuide (HG) is one of:
(lambda (env lenv) (lambda (env lenv)
(let* ([v (f1 env lenv)] (let* ([v (f1 env lenv)]
[v* (stx->list v)]) [v* (stx->list v)])
(unless v* (unless (list? v*)
(raise-syntax-error 'template (raise-syntax-error 'template
"splicing template did not produce a syntax list" "splicing template did not produce a syntax list"
stx)) stx))

2
collects/syntax/parse/private/residual.rkt
View File

@ -205,7 +205,7 @@
(define (predicate-ellipsis-parser x cx pr es pred? desc rl) (define (predicate-ellipsis-parser x cx pr es pred? desc rl)
(let ([elems (stx->list x)]) (let ([elems (stx->list x)])
(if (and elems (andmap pred? elems)) (if (and elems (list? elems) (andmap pred? elems))
(values 'ok elems) (values 'ok elems)
(let loop ([x x] [cx cx] [i 0]) (let loop ([x x] [cx cx] [i 0])
(cond [(syntax? x) (cond [(syntax? x)

11
collects/tests/stxparse/test.rkt
View File

@ -459,3 +459,14 @@
(not #rx"expected foo") ;; y:nat was incorrectly considered part of opaque region (not #rx"expected foo") ;; y:nat was incorrectly considered part of opaque region
#rx"expected exact-nonnegative-integer") #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))