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

syntax/parse/experimental/template: fixed bugs, added error tests

Browse Source
This commit is contained in:
Ryan Culpepper 2012-09-17 18:08:33 -04:00
parent 348005047b
commit 35a0e50de4
3 changed files with 43 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
collects/syntax/parse/experimental/private/substitute.rkt
View File

@ -103,7 +103,7 @@ A HeadGuide (HG) is one of:
(let ([last-upto
(for/fold ([last 1]) ([upto (in-list uptos)])
(unless (<= upto lenv*-len)
(error 'template "internal error: upto is to big"))
(error 'template "internal error: upto is too big"))
(unless (>= upto last)
(error 'template "internal error: uptos decreased: ~e" uptos))
upto)])
@ -273,7 +273,7 @@ A HeadGuide (HG) is one of:
(for ([v (in-vector lenv)])
(unless (= len0 (length v))
(raise-syntax-error 'template
"incomplatible ellipsis match counts for template"
"incompatible ellipsis match counts for template"
stx)))))
;; ----

8
collects/syntax/parse/experimental/template.rkt
View File

@ -147,7 +147,8 @@ instead of integers and integer vectors.
|#
(begin-for-syntax
(struct pvar (sm dd) #:prefab))
(struct pvar (sm dd) #:prefab)
(define (pvar/dd=0? x) (and (pvar? x) (equal? (pvar-dd x) 0))))
;; ============================================================
@ -347,8 +348,11 @@ instead of integers and integer vectors.
(parse-h #'head (+ depth nesting) esc?)]
[(tdrivers tguide tprops-guide)
(parse-t tail depth esc?)])
(unless (positive? (set-count hdrivers))
(when (set-empty? hdrivers)
(wrong-syntax #'head "no pattern variables in term before ellipsis"))
(when (set-empty? (set-filter hdrivers pvar/dd=0?))
;; FIXME: improve error message?
(wrong-syntax #'DOTS "too many ellipses in template"))
(wrap-props t
(set-union hdrivers tdrivers)
;; pre-guide hdrivers is (listof (setof pvar))

36
collects/tests/stxparse/test-template.rkt
View File

@ -1,6 +1,7 @@
#lang racket/base
(require (for-syntax racket/base)
rackunit
(only-in "setup.rkt" convert-syntax-error tcerr)
racket/syntax
syntax/parse
syntax/parse/experimental/template)
@ -11,9 +12,14 @@
(syntax-case stx ()
[(tc expr expected)
#`(test-equal? (format "line ~s" #,(syntax-line stx))
(syntax->datum expr)
(syntax->datum (convert-syntax-error expr))
expected)]))
(define-syntax (terx stx)
(syntax-case stx ()
[(terx expr err-rx ...)
#`(tcerr (format "line ~s" #,(syntax-line stx)) expr err-rx ...)]))
;; ----------------------------------------
;; Common pattern variable definitions
@ -152,3 +158,31 @@
'((x abc-x) (y abc-y) (z abc-z)))
(tc (template ((xx (join aa xx)) ...))
'((x ax) (y by) (z cz)))
;; ============================================================
;; Error tests
(terx (template (1 ...))
#rx"no pattern variables in term before ellipsis")
(terx (template (uu ...))
#rx"too many ellipses in template")
(terx (template aa)
#rx"pattern variable used at wrong ellipsis depth")
(terx (template (?@))
#rx"illegal use")
(terx (template ((?@ . uu)))
#rx"splicing template did not produce a syntax list")
(define-template-metafunction (bad-mf stx) 123)
(terx (template (bad-mf))
#rx"result of metafunction was not syntax")
(terx (with-syntax ([(bb ...) #'(y z)]) (template ((aa bb) ...)))
#rx"incompatible ellipsis match counts")