66 lines
2.4 KiB
Racket
66 lines
2.4 KiB
Racket
#lang scheme
|
|
|
|
(require "../private/keyword-macros.rkt"
|
|
"test-util.rkt")
|
|
|
|
(reset-count)
|
|
|
|
(let* ([formals `((#:b ,#'1) (#:c ,#'2))]
|
|
[parse
|
|
(λ (actuals)
|
|
(map syntax-e
|
|
(parse-kw-args formals (cdr (syntax-e actuals)) actuals 'dontcare)))])
|
|
(let-syntax ([msg-src
|
|
(syntax-rules ()
|
|
[(_ expr)
|
|
(with-handlers ([exn:fail:syntax?
|
|
(λ (exn)
|
|
(values (exn-message exn)
|
|
(exn:fail:syntax-exprs exn)))])
|
|
(begin expr (values 'no-msg 'no-src)))])])
|
|
(let ()
|
|
(test (parse #'(a #:c 3 #:b 4)) '(4 3))
|
|
(test (parse #'(a #:b 4 #:c 3)) '(4 3))
|
|
(test (parse #'(a #:c 3)) '(1 3))
|
|
(let*-values ([(kw) (syntax-taint #'#:b)]
|
|
[(msg src) (msg-src (parse #`(a #,kw)))])
|
|
(test msg #rx"a: missing argument expression after keyword")
|
|
(test src (list kw)))
|
|
(let*-values ([(arg) (syntax-taint #'1)]
|
|
[(msg src) (msg-src (parse #`(a #:b 1 #,arg)))])
|
|
(test msg #rx"a: expected a keyword")
|
|
(test src (list arg)))
|
|
(let*-values ([(kw) (syntax-taint #'#:c)]
|
|
[(msg src) (msg-src (parse #`(a #:c 1 #:b 2 #,kw 3)))])
|
|
(test msg #rx"a: repeated keyword")
|
|
(test src (list kw)))
|
|
(let*-values ([(kw) (syntax-taint #'#:c)]
|
|
[(msg src) (msg-src (parse #`(a #:b #,kw 3)))])
|
|
(test msg #rx"a: expected an argument expression")
|
|
(test src (list kw)))
|
|
(let*-values ([(kw) (syntax-taint #'#:typo)]
|
|
[(msg src) (msg-src (parse #`(a #:b 3 #,kw 4)))])
|
|
(test msg #rx"a: invalid keyword")
|
|
(test src (list kw))))))
|
|
|
|
(define-namespace-anchor test-module)
|
|
|
|
(let* ([default #'3]
|
|
[formals `((#:a ,default (,#'(-> number? string?) "#:a arg")))]
|
|
[form 'test-form]
|
|
[parse (λ (actuals) (parse-kw-args formals actuals actuals form))])
|
|
(test (first (parse #'())) default)
|
|
(define arg
|
|
(eval (first (parse #'(#:a (λ (x) 3))))
|
|
(namespace-anchor->namespace test-module)))
|
|
(test-contract-violation
|
|
(arg 3)
|
|
#:blaming "keyword-macros-test"
|
|
#:message "#:a arg")
|
|
(test-contract-violation
|
|
(arg "NaN")
|
|
#:blaming (format "~a" form)
|
|
#:message "#:a arg"))
|
|
|
|
(print-tests-passed 'keyword-macros-test.rkt)
|