From 15186ff41c1ee68c48ccb0b7db7b76b26b0f3d23 Mon Sep 17 00:00:00 2001
From: Ryan Culpepper <ryanc@racket-lang.org>
Date: Fri, 10 Aug 2018 17:54:20 +0200
Subject: [PATCH] syntax/parse: fix struct match patterns with wrong number of
 subpatterns

---
 racket/collects/syntax/parse/private/minimatch.rkt    | 2 ++
 racket/collects/syntax/parse/private/opt.rkt          | 4 ++--
 racket/collects/syntax/parse/private/rep-patterns.rkt | 2 +-
 3 files changed, 5 insertions(+), 3 deletions(-)

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