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

fix stx tests for revised let-syntaxes expansion

Browse Source 
svn: r5827
This commit is contained in:
Matthew Flatt 2007-03-25 21:54:29 +00:00
parent 87f93ea412
commit da6e732918
1 changed files with 29 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

33
collects/tests/mzscheme/stx.ss
View File

@ -637,8 +637,8 @@
;; Disappearing syntax decls: ;; Disappearing syntax decls:
(test #t has-stx-property? (expand #'(let () (define-syntax x 1) (define y 12) 10)) 'letrec-values 'x 'disappeared-binding) (test #t has-stx-property? (expand #'(let () (define-syntax x 1) (define y 12) 10)) 'letrec-values 'x 'disappeared-binding)
(test #t has-stx-property? (expand #'(let () (define-struct s (x)) 10)) 'letrec-values 's 'disappeared-binding) (test #t has-stx-property? (expand #'(let () (define-struct s (x)) 10)) 'letrec-values 's 'disappeared-binding)
(test #t has-stx-property? (expand #'(let () (define-syntax x 1) 10)) 'begin 'x 'disappeared-binding) (test #t has-stx-property? (expand #'(let () (define-syntax x 1) 10)) 'let-values 'x 'disappeared-binding)
(test #f has-stx-property? (expand #'(fluid-let-syntax ([x 1]) 10)) 'begin 'x 'disappeared-binding) (test #f has-stx-property? (expand #'(fluid-let-syntax ([x 1]) 10)) 'let-values 'x 'disappeared-binding)
;; Disappearing use: ;; Disappearing use:
(test #t has-stx-property? (expand #'(let () (define-struct a (x)) (define-struct (b a) (z)) 10)) (test #t has-stx-property? (expand #'(let () (define-struct a (x)) (define-struct (b a) (z)) 10))
@ -655,9 +655,9 @@
(printf "~s\n" (syntax-object->datum #'beg)) (printf "~s\n" (syntax-object->datum #'beg))
(let-values ([(bg e) (let-values ([(bg e)
(syntax-case #'beg (#%app #%top list) (syntax-case #'beg (#%app #%top list)
[(bg (#%app (#%top . list) e)) [(bg () (#%app (#%top . list) e))
(values #'bg #'e)] (values #'bg #'e)]
[(bg e) [(bg () e)
(values #'bg #'e)])]) (values #'bg #'e)])])
(let ([o (syntax-property e 'origin)]) (let ([o (syntax-property e 'origin)])
(test #t (lambda (db o) (test #t (lambda (db o)
@ -1180,6 +1180,31 @@
(require @-n) (require @-n)
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Propagating inactive certificates through a transparent macro-expansion result:
(module @!m mzscheme
(provide define-x)
(define-syntax (define-x stx)
(syntax-case stx ()
[(_ x)
#'(define-syntax (x stx)
#'(begin
(define-y y 10)))]))
(define-syntax define-y
(syntax-rules ()
[(_ id v)
(define id v)])))
(module @!n mzscheme
(require @!m)
(define-x def-y)
(def-y))
;; If we get here, then macro expansion didn't fail.
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(report-errs) (report-errs)