diff --git a/racket/collects/syntax/parse/private/minimatch.rkt b/racket/collects/syntax/parse/private/minimatch.rkt index 2a1f01f82f..120d7df041 100644 --- a/racket/collects/syntax/parse/private/minimatch.rkt +++ b/racket/collects/syntax/parse/private/minimatch.rkt @@ -75,6 +75,8 @@ [accessors (reverse (list-ref si 3))]) (unless (andmap identifier? accessors) (raise-syntax-error #f "struct has incomplete information" #'S)) + (unless (= (length accessors) (length (syntax->list #'(p ...)))) + (raise-syntax-error #f "struct pattern has incorrect number of subpatterns" #'S)) (with-syntax ([predicate predicate] [(accessor ...) accessors]) #'(if (predicate x) diff --git a/racket/collects/syntax/parse/private/opt.rkt b/racket/collects/syntax/parse/private/opt.rkt index 0dc2460107..73f08e5041 100644 --- a/racket/collects/syntax/parse/private/opt.rkt +++ b/racket/collects/syntax/parse/private/opt.rkt @@ -189,7 +189,7 @@ (equal? tail (pat:datum '())))] [(pat:and patterns) (andmap pattern-factorable? patterns)] - [(pat:or patterns) #f] + [(pat:or _ patterns _) #f] [(pat:not pattern) #f] ;; FIXME: ? [(pat:pair head tail) (and (pattern-factorable? head) @@ -217,7 +217,7 @@ (pattern-factorable? inner)] [(hpat:commit inner) #t] ;; ---- - [(ehpat head repc) + [(ehpat _ head repc _) (and (equal? repc #f) (pattern-factorable? head))] ;; ---- diff --git a/racket/collects/syntax/parse/private/rep-patterns.rkt b/racket/collects/syntax/parse/private/rep-patterns.rkt index 3f4ebd279a..04915c3718 100644 --- a/racket/collects/syntax/parse/private/rep-patterns.rkt +++ b/racket/collects/syntax/parse/private/rep-patterns.rkt @@ -352,7 +352,7 @@ A RepConstraint is one of [(pat:ord sp _ _) (pattern-has-cut? sp)] [(pat:post sp) (pattern-has-cut? sp)] [(pat:integrated name _ _ _) #f] - [(pat:fixup _ _ _ _ _ _) #t] + [(pat:fixup _ _ _ _ _ _ _) #t] [(pat:and/fixup _ ps) (ormap pattern-has-cut? ps)] ;; -- A patterns