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

fix test

Browse Source 
Some tests failed after commit 6e80609998, which adjusted the macro
system's handling of use-site scopes so that they're preserved by
`quote-syntax`. Those scopes get in the way of the test, which
is using macros to juggle syntax objects that include pieces
used as bindings via `eval`.
This commit is contained in:
Matthew Flatt 2015-10-02 14:51:16 -06:00
parent fb9aba2b8d
commit c28d032620
1 changed files with 24 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

28
compatibility-test/tests/racket/package.rkt
View File

@ -1,5 +1,8 @@
#lang racket/load #lang racket/load
(require rackunit racket/package (for-syntax racket/base)) (require rackunit
racket/package
syntax/strip-context
(for-syntax racket/base))
(define-syntax test (define-syntax test
(syntax-rules () (syntax-rules ()
@ -14,6 +17,21 @@
[(_ e) (check-exn exn:fail? (λ () e))] [(_ e) (check-exn exn:fail? (λ () e))]
[(_ e ty?) (check-exn ty? (λ () e))])) [(_ e ty?) (check-exn ty? (λ () e))]))
;; Need to remove use-site scopes on syntax objects
;; that we're going to pass on to `eval`.
(define-for-syntax (remove-use-site stx)
(cond
[(identifier? stx) (syntax-local-identifier-as-binding stx)]
[(syntax? stx)
(datum->syntax (syntax-local-identifier-as-binding (datum->syntax stx 'x))
(remove-use-site (syntax-e stx))
stx
stx)]
[(pair? stx)
(cons (remove-use-site (car stx))
(remove-use-site (cdr stx)))]
[else stx]))
(define-syntax (test-pack-seq stx) (define-syntax (test-pack-seq stx)
(syntax-case stx () (syntax-case stx ()
[(_ result form ...) [(_ result form ...)
@ -21,13 +39,15 @@
[pre null]) [pre null])
(syntax-case forms () (syntax-case forms ()
[([#:fail expr exn?]) [([#:fail expr exn?])
(with-syntax ([(form ...) (reverse pre)]) (with-syntax ([(form ...) (reverse pre)]
[expr (remove-use-site #'expr)])
#`(test-pack-seq* (list (quote-syntax form) ...) #`(test-pack-seq* (list (quote-syntax form) ...)
(quote-syntax [#:fail expr]) (quote-syntax [#:fail expr])
'expr 'expr
exn?))] exn?))]
[(expr) [(expr)
(with-syntax ([(form ...) (reverse pre)]) (with-syntax ([(form ...) (reverse pre)]
[expr (remove-use-site #'expr)])
#`(test-pack-seq* (list (quote-syntax form) ...) #`(test-pack-seq* (list (quote-syntax form) ...)
(quote-syntax expr) (quote-syntax expr)
'expr 'expr
@ -37,7 +57,7 @@
#,(loop #'([#:fail expr exn?]) pre) #,(loop #'([#:fail expr exn?]) pre)
#,(loop #'more pre))] #,(loop #'more pre))]
[(form . more) [(form . more)
(loop #'more (cons #'form pre))]))])) (loop #'more (cons (remove-use-site #'form) pre))]))]))
(define (fail? e) (define (fail? e)
(syntax-case e () (syntax-case e ()