From fb5c1310d8a28d058f16eae969965169ae7204a7 Mon Sep 17 00:00:00 2001 From: Ryan Culpepper Date: Mon, 16 May 2016 00:46:57 -0400 Subject: [PATCH] syntax/parse: add dynamic check for null ellipsis-head match Otherwise, nullable ellipsis-head patterns could cause infinite loop. --- racket/collects/syntax/parse/private/parse.rkt | 5 +++-- racket/collects/syntax/parse/private/residual.rkt | 5 +++++ 2 files changed, 8 insertions(+), 2 deletions(-) diff --git a/racket/collects/syntax/parse/private/parse.rkt b/racket/collects/syntax/parse/private/parse.rkt index 8c16f2f978..35c38dc7a5 100644 --- a/racket/collects/syntax/parse/private/parse.rkt +++ b/racket/collects/syntax/parse/private/parse.rkt @@ -984,8 +984,9 @@ Conventions: (for/list ([id (in-list ids)]) (bound-id-table-ref table id)))]) (with-syntax ([(id ...) ids] [(alt-id ...) alt-ids]) - #`(let ([alt-id (rep:combine repc (attribute id) alt-id)] ...) - k)))) + #`(let ([alt-id (rep:combine repc (attribute id) alt-id)] ... + [diff (ps-difference pr pr*)]) + (if (zero? diff) (error/null-eh-match) k))))) (syntax-case #'repc () [#f #`(parse:H x cx x* cx* pr* head pr es k*)] [_ #`(parse:H x cx x* cx* pr* head pr es diff --git a/racket/collects/syntax/parse/private/residual.rkt b/racket/collects/syntax/parse/private/residual.rkt index 2935f4d474..baea0658a0 100644 --- a/racket/collects/syntax/parse/private/residual.rkt +++ b/racket/collects/syntax/parse/private/residual.rkt @@ -60,6 +60,7 @@ datum->syntax/with-clause check/force-syntax-list^depth check-literal* + error/null-eh-match begin-for-syntax/once name->too-few/once @@ -216,6 +217,10 @@ (and used-phase (- used-phase mod-phase))) ctx id))) +;; error/null-eh-match : -> (escapes) +(define (error/null-eh-match) + (error 'syntax-parse "an ellipsis-head pattern matched an empty sequence")) + ;; (begin-for-syntax/once expr/phase1 ...) ;; evaluates in pass 2 of module/intdefs expansion (define-syntax (begin-for-syntax/once stx)