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

fix syntax checking for `case'

Browse Source 
Merge to v5.3.1
(cherry picked from commit f43172128b)
This commit is contained in:
Matthew Flatt 2012-10-24 13:12:22 -07:00 committed by Ryan Culpepper
parent f61c3ca3f8
commit 4f504e5f19
3 changed files with 54 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

51
collects/racket/private/case.rkt
View File

@ -32,18 +32,45 @@
(case/dispatch tmp [(k ...) e1 e2 ...] ... [else x1 x2 ...]))))]
;; Error cases
[(_ v (bad e1 e2 ...) . rest)
(raise-syntax-error
#f
"bad syntax (not a datum sequence)"
stx
(syntax bad))]
[(_ v clause . rest)
(raise-syntax-error
#f
"bad syntax (missing expression after datum sequence)"
stx
(syntax clause))]
[(_ v clause ...)
(let loop ([clauses (syntax->list #'(clause ...))])
(unless (null? clauses)
(let ([clause (car clauses)])
(syntax-case clause ()
[((_ ...) _ _ ...)
(loop (cdr clauses))]
[((_ ...) . _)
(syntax-case clause ()
[(_)
(raise-syntax-error
#f
"bad syntax (missing expression after datum sequence)"
stx
clause)]
[(_ . _)
(raise-syntax-error
#f
"bad syntax (illegal use of `.' in clause)"
stx
clause)]
[_
(raise-syntax-error
#f
"bad syntax (ill-formed clause)"
stx
clause)])]
[(bad . _)
(raise-syntax-error
#f
"bad syntax (not a datum sequence)"
stx
(syntax bad))]
[_
(raise-syntax-error
#f
"bad syntax (ill-formed clause)"
stx
(syntax bad))]))))]
[(_ . v)
(not (null? (syntax-e (syntax v))))
(raise-syntax-error

10
collects/tests/racket/syntax.rktl
View File

@ -315,6 +315,16 @@
[else #f])))
(error-test #'(cond [(values 1 2) 8]) arity?)
(error-test #'(case (values 1 2) [(a) 8]) arity?)
(syntax-test #'(case 1 []) #rx"ill-formed clause")
(syntax-test #'(case 1 [(y) 5] []) #rx"ill-formed clause")
(syntax-test #'(case 1 [x]) #rx"not a datum sequence")
(syntax-test #'(case 1 [(y) 5] [x]) #rx"not a datum sequence")
(syntax-test #'(case 1 [(y) 5] [x x]) #rx"not a datum sequence")
(syntax-test #'(case 1 [x x]) #rx"not a datum sequence")
(syntax-test #'(case 1 [(x)]) #rx"missing expression after datum sequence")
(syntax-test #'(case 1 [(y) 5] [(x)]) #rx"missing expression after datum sequence")
(syntax-test #'(case 1 [(x) . 8]) #rx"illegal use of `.'")
(syntax-test #'(case 1 [(x) 10] . 9) #rx"illegal use of `.'")
;; test larger `case' dispatches to trigger for binary-search
;; and hash-table-based dispatch:

7
collects/tests/racket/testing.rktl
View File

@ -222,11 +222,14 @@ transcript.
(define no-extra-if-tests? #f)
(define (syntax-test expr)
(define (syntax-test expr [rx #f])
(error-test expr exn:fail:syntax?)
(unless no-extra-if-tests?
(error-test (datum->syntax expr `(if #f ,expr (void)) expr)
exn:fail:syntax?)))
(lambda (x)
(and (exn:fail:syntax? x)
(or (not rx)
(regexp-match? rx (exn-message x))))))))
(define arity-test
(case-lambda