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

more tests for 'disappeared-binding info for letrecs generated by internal definitions

Browse Source 
svn: r4694
This commit is contained in:
Matthew Flatt 2006-10-28 23:55:54 +00:00
parent 900a53da25
commit 3c215723c3
1 changed files with 23 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -652,23 +652,33 @@
(syntax-case e ()
[(lv (bind ...) beg)
(let ([db (syntax-property #'beg 'disappeared-binding)])
(syntax-case #'beg ()
[(bg e)
(let ([o (syntax-property #'e 'origin)])
(test #t (lambda (db o)
(and (list? db)
(list? o)
(= 1 (length db))
(= 1 (length o))
(identifier? (car db))
(identifier? (car o))
(bound-identifier=? (car db) (car o))))
db o))]))])))])
(printf "~s\n" (syntax-object->datum #'beg))
(let-values ([(bg e)
(syntax-case #'beg (#%app #%top list)
[(bg (#%app (#%top . list) e))
(values #'bg #'e)]
[(bg e)
(values #'bg #'e)])])
(let ([o (syntax-property e 'origin)])
(test #t (lambda (db o)
(and (list? db)
(list? o)
(<= 1 (length db) 2)
(= 1 (length o))
(andmap identifier? db)
(identifier? (car o))
(ormap (lambda (db) (bound-identifier=? db (car o))) db)))
db o))))])))])
(check-expr #'(let () (letrec-syntaxes+values ([(x) (lambda (stx) #'(quote y))]) () x)))
(check-expr #'(let () (letrec-syntaxes+values ([(x) (lambda (stx) #'(quote y))]) () (list x))))
(check-expr #'(let-values () (define-syntax (x stx) #'(quote y)) x))
(check-expr #'(let-values () (define-syntax (x stx) #'(quote y)) (list x)))
(check-expr #'(let-values ([(y) 2]) (define-syntax (x stx) #'(quote y)) x))
(check-expr #'(let-values ([(y) 2]) (define-syntax (x stx) #'(quote y)) (list x)))
(check-expr #'(let () (define-syntax (x stx) #'(quote y)) x))
(check-expr #'(let ([z 45]) (define-syntax (x stx) #'(quote y)) x)))
(check-expr #'(let () (define-syntax (x stx) #'(quote y)) (list x)))
(check-expr #'(let ([z 45]) (define-syntax (x stx) #'(quote y)) x))
(check-expr #'(let ([z 45]) (define-syntax (x stx) #'(quote y)) (list x))))
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; protected identifiers