keep testing line numbers when compiled

This commit is contained in:
Ryan Culpepper 2013-07-31 17:34:37 -04:00
parent f5b91941eb
commit 4ef5f513bc

View File

@ -48,11 +48,11 @@ Auxiliaries
|# |#
;; tok = test pattern ok ;; tok = test pattern ok
(define-syntax tok (define-syntax (tok stx)
(syntax-rules () (syntax-case stx ()
[(tok s p expr #:pre [pre-p ...] #:post [post-p ...]) [(tok s p expr #:pre [pre-p ...] #:post [post-p ...])
(test-case (format "line ~s: ~s match ~s" #`(test-case (format "line ~s: ~s match ~s"
(syntax-line (quote-syntax s)) '#,(syntax-line #'s)
's 'p) 's 'p)
(syntax-parse (quote-syntax s) (syntax-parse (quote-syntax s)
[pre-p (error 'wrong-pattern "~s" 'pre-p)] ... [pre-p (error 'wrong-pattern "~s" 'pre-p)] ...
@ -60,9 +60,9 @@ Auxiliaries
[post-p (error 'wrong-pattern "~s" 'post-p)] ...) [post-p (error 'wrong-pattern "~s" 'post-p)] ...)
(void))] (void))]
[(tok s p expr) [(tok s p expr)
(tok s p expr #:pre () #:post ())] #'(tok s p expr #:pre () #:post ())]
[(tok s p) [(tok s p)
(tok s p 'ok)])) #'(tok s p 'ok)]))
(define-syntax-rule (bound b ...) (define-syntax-rule (bound b ...)
(begin (bound1 b) ...)) (begin (bound1 b) ...))
@ -90,11 +90,11 @@ Auxiliaries
(define-syntax-rule (terx s p rx ...) (define-syntax-rule (terx s p rx ...)
(terx* s [p] rx ...)) (terx* s [p] rx ...))
(define-syntax terx* (define-syntax (terx* stx)
(syntax-rules () (syntax-case stx ()
[(terx s [p ...] rx ...) [(terx s [p ...] rx ...)
(test-case (format "line ~s: ~a match ~s for error" #`(test-case (format "line ~s: ~a match ~s for error"
(syntax-line (quote-syntax s)) '#,(syntax-line #'s)
's '(p ...)) 's '(p ...))
(check-exn (lambda (exn) (check-exn (lambda (exn)
(erx rx (exn-message exn)) ... #t) (erx rx (exn-message exn)) ... #t)