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

Test for begin at label phase

Browse Source
This commit is contained in:
Asumu Takikawa 2014-07-22 18:08:14 -04:00
parent a95e279219
commit ad677478ab
2 changed files with 4 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
pkgs/racket-pkgs/racket-test/tests/syntax/flatten-begin.rkt
View File

@ -14,6 +14,8 @@
(check-exn exn:fail:syntax? (λ () (flatten-all-begins #'(1 2 3))))
(check-equal-datum? (flatten-all-begins #'(begin 1 2 3))
(list #'1 #'2 #'3))
(check-equal-datum? (flatten-all-begins (syntax-shift-phase-level #'(begin 1 2 3) 2))
(list #'1 #'2 #'3))
(check-equal-datum? (flatten-all-begins #'(begin (begin 1 2) 3))
(list #'1 #'2 #'3))
(check-equal-datum? (flatten-all-begins #'(begin (begin 1 2) (+ 3 4) 5))

4
racket/collects/syntax/flatten-begin.rkt
View File

@ -20,7 +20,7 @@
(unless (and (pair? val)
(not (null? val))
(identifier? (car val))
(free-identifier=? (car val) #'begin))
(free-identifier=? (car val) #'begin #f #f))
(raise-syntax-error
#f
"not a begin expression"
@ -29,6 +29,6 @@
(define lst (syntax->list stx))
(if (and lst
(not (null? lst))
(free-identifier=? (car lst) #'begin))
(free-identifier=? (car lst) #'begin #f #f))
(apply append (map loop (cdr lst)))
(list (syntax-track-origin stx orig-stx #'begin)))))