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

Changing test phase

Browse Source
This commit is contained in:
Jay McCarthy 2011-08-30 08:52:34 -06:00
parent 936b51adf1
commit 2dc0098d86
1 changed files with 23 additions and 16 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

39
collects/tests/unstable/syntax.rkt
View File

@ -4,6 +4,7 @@
rackunit
rackunit/text-ui
racket/syntax
(for-syntax unstable/syntax)
unstable/syntax
"helpers.rkt")
@ -56,19 +57,25 @@
(with-syntax* ([a #'id] [b #'a]) #'b)
#'id))))
(test-suite "syntax-within?"
(let* ([a #'a]
[b #'b]
[c #'(a b c)]
[c1 (car (syntax->list c))]
[c2 (cadr (syntax->list c))])
(test-case "reflexive"
(check-equal? (syntax-within? a a) #t))
(test-case "unrelated"
(check-equal? (syntax-within? a b) #f))
(test-case "child"
(check-equal? (syntax-within? c1 c) #t))
(test-case "parent"
(check-equal? (syntax-within? c c1) #f))
(test-case "sibling"
(check-equal? (syntax-within? c2 c1) #f))))))
(let ()
(define-syntax a #'a)
(define-syntax b #'b)
(define-syntax c #'(a b c))
(define-syntax c1 (car (syntax->list (syntax-local-value #'c))))
(define-syntax c2 (cadr (syntax->list (syntax-local-value #'c))))
(define-syntax (*syntax-within? stx)
(syntax-case stx ()
[(_ x y)
#`#,(syntax-within? (syntax-local-value #'x)
(syntax-local-value #'y))]))
(test-suite "syntax-within?"
(test-case "reflexive"
(check-equal? (*syntax-within? a a) #t))
(test-case "unrelated"
(check-equal? (*syntax-within? a b) #f))
(test-case "child"
(check-equal? (*syntax-within? c1 c) #t))
(test-case "parent"
(check-equal? (*syntax-within? c c1) #f))
(test-case "sibling"
(check-equal? (*syntax-within? c2 c1) #f))))))