commit f0fcc2b16997c76e0e1b270a70b58a73c374a84f parent 8e501ebeb6d95fe5d1a0717dae6a6b8f4bb51538 Author: Georges Dupéron <georges.duperon@gmail.com> Date: Tue, 30 Aug 2016 12:39:14 +0200 Make ?-expander? allow any value, so that (~var exp (static foo-expander? "a foo expander")) can safely be used with syntax-parse. Diffstat:
| M | private/define-expanders.rkt | | | 3 | ++- |
| A | test/test-foo-mixin-expander-predicate.rkt | | | 62 | ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ |
2 files changed, 64 insertions(+), 1 deletion(-)
diff --git a/private/define-expanders.rkt b/private/define-expanders.rkt @@ -27,7 +27,8 @@ (define-for-syntax (make-?-expander transformer) (expander ?-expander-type transformer)) (define-for-syntax (?-expander? v) - (expander-of-type? ?-expander-type v)) + (and (expander? v) + (expander-of-type? ?-expander-type v))) (define-syntax define-?-expander (syntax-parser [(_ expander-name:id transformer:expr) diff --git a/test/test-foo-mixin-expander-predicate.rkt b/test/test-foo-mixin-expander-predicate.rkt @@ -0,0 +1,61 @@ +#lang racket + +(require generic-syntax-expanders + (for-syntax syntax/parse + rackunit)) +(require (for-syntax generic-syntax-expanders)) +(define-expander-type foo) +(define-expander-type other) +(define-foo-expander foo-exp (λ (stx) #''foo-exp-is-a-foo-expander)) +(define-other-expander other-exp (λ (stx) #''other-exp-is-not-a-foo-expander)) +(define-syntax not-an-expander 'syntax-local-value-is-not-an-expander) +(begin-for-syntax + (test-not-exn + "Check that foo-expander? can be passed any value, not just an expander?" + (λ () + (foo-expander? 123) + (void))) + + (test-false + "Check that (static foo-expander?) rejects syntax that is not an identifier?" + (syntax-parse #'(definitely not-a-foo-expander) + [(~var exp (static foo-expander? "a foo expander")) #t] + [_ #f])) + + (test-false + "Check that (static foo-expander?) rejects an id without syntax-local-value" + (syntax-parse #'no-syntax-local-value + [(~var exp (static foo-expander? "a foo expander")) #t] + [_ #f])) + + (test-begin + (test-false + "Check that foo-expander? rejects an id which is not an expander?" + (foo-expander? (syntax-local-value #'not-an-expander))) + (test-false + "Check that foo-expander? rejects an id which is not an expander?" + (syntax-parse #'not-an-expander + [(~var exp (static foo-expander? "a foo expander")) #t] + [_ #f]))) + + (test-begin + (test-false + (string-append "Check that foo-expander? rejects an id which is an" + " expander? but not a foo-expander?") + (foo-expander? (syntax-local-value #'other-exp))) + (test-false + (string-append "Check that foo-expander? rejects an id which is an" + " expander? but not a foo-expander?") + (syntax-parse #'other-exp + [(~var exp (static foo-expander? "a foo expander")) #t] + [_ #f]))) + + (test-begin + (test-true + "Check that foo-expander? accepts an id which is a foo-expander?" + (foo-expander? (syntax-local-value #'foo-exp))) + (test-true + "Check that foo-expander? accepts an id which is a foo-expander?" + (syntax-parse #'foo-exp + [(~var exp (static foo-expander? "a foo expander")) #t] + [_ #f])))) +\ No newline at end of file