From 80fcee2577fad7f2ad95067563d2acb5a3b4e7fc Mon Sep 17 00:00:00 2001 From: Sam Tobin-Hochstadt Date: Thu, 4 Mar 2010 13:45:25 +0000 Subject: [PATCH] Fix PR 10806. svn: r18464 --- collects/scheme/match/parse-helper.ss | 6 +++++- collects/tests/match/examples.ss | 12 +++++++++++- 2 files changed, 16 insertions(+), 2 deletions(-) diff --git a/collects/scheme/match/parse-helper.ss b/collects/scheme/match/parse-helper.ss index 83c30b05d0..515b605ecb 100644 --- a/collects/scheme/match/parse-helper.ss +++ b/collects/scheme/match/parse-helper.ss @@ -87,13 +87,17 @@ (cond [(equal? super #t) '()] ;; no super type exists [(equal? super #f) '()] ;; super type is unknown [else (cons super (get-lineage super))]))) + (unless pred + (raise-syntax-error 'match (format "structure ~a does not have an associated predicate" + (syntax->datum struct-name)) + stx struct-name)) (let* (;; the accessors come in reverse order [acc (reverse acc)] ;; remove the first element, if it's #f [acc (cond [(null? acc) acc] [(not (car acc)) (cdr acc)] [else acc])]) - (make-Struct id + (make-Struct pred (syntax-property pred 'disappeared-use (list struct-name)) diff --git a/collects/tests/match/examples.ss b/collects/tests/match/examples.ss index 6c8a284526..acb752751b 100644 --- a/collects/tests/match/examples.ss +++ b/collects/tests/match/examples.ss @@ -2,7 +2,7 @@ (require scheme/match scheme/mpair - scheme/control + scheme/control scheme/foreign (for-syntax scheme/base) (prefix-in m: mzlib/match) (only-in srfi/13 string-contains) @@ -623,5 +623,15 @@ [`#s((bar foo 3) ,x ,y ,z ,w) (list x y z)]) )) + (comp "Gotcha!" + (let () + (define-cstruct _pose + ([x _double*] + [y _double*] + [a _double*])) + + (match (make-pose 1 2 3) + [(struct pose (x y a)) "Gotcha!"] + [else "Epic fail!"]))) ))