diff --git a/pkgs/racket-test/tests/stxparse/function-header.rkt b/pkgs/racket-test/tests/stxparse/function-header.rkt new file mode 100644 index 0000000000..1dd16666ed --- /dev/null +++ b/pkgs/racket-test/tests/stxparse/function-header.rkt @@ -0,0 +1,80 @@ +#lang racket + +(require syntax/parse + syntax/parse/lib/function-header + rackunit) + +(define-binary-check (syntax-check-equal? actual expected) + (check-equal? (syntax->datum actual) + (syntax->datum expected))) + +(syntax-check-equal? + (syntax-parse #'(b) + [(a:arg) #'t]) + #'t) + +(syntax-check-equal? + (syntax-parse #'(b) + [(a:arg) #'(a.name a.kw a.default)]) + #'(b #f #f)) + +(syntax-check-equal? + (syntax-parse #'(#:keyword argument) + [(a:arg) #'(a.name a.kw a.default)]) + #'(argument #:keyword #f)) + +(syntax-check-equal? + (syntax-parse #'(#:keyword [optional argument]) + [(a:arg) #'(a.name a.kw a.default)]) + #'(optional #:keyword argument)) + +(syntax-check-equal? + (syntax-parse #'([optional argument]) + [(a:arg) #'(a.name a.kw a.default)]) + #'(optional #f argument)) + +(syntax-check-equal? + (syntax-parse #'(a b) + [(a:arg) #'f] + [_ #'t]) + #'t) + +(syntax-check-equal? + (syntax-parse #'(#:keyword) + [(a:arg) #'f] + [_ #'t]) + #'t) + +(syntax-check-equal? + (syntax-parse #'(a b c) + [a:args #'(a a.params)]) + #'((a b c) (a b c))) + +(syntax-check-equal? + (syntax-parse #'(a #:keyword arg #:optional [keyword arg] . rest) + [a:args #'(a a.params)]) + #'((a #:keyword arg #:optional [keyword arg] . rest) + (a arg keyword rest))) + +(syntax-check-equal? + (syntax-parse #'([optional before] required) + [a:args #'f] + [_ #'t]) + #'t) + +(syntax-check-equal? + (syntax-parse #'(a [optional arg] . rest) + [a:args #'(a a.params)]) + #'((a [optional arg] . rest) + (a optional rest))) + +(syntax-check-equal? + (syntax-parse #'(f a b c) + [a:function-header #'(a a.params)]) + #'((f a b c) (a b c))) + +(syntax-check-equal? + (syntax-parse #'((f doing) currying) + [a:function-header #'(a a.params)]) + #'(((f doing) currying) + (doing currying)))