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

Fixing another problem discover because of Galler

Browse Source
This commit is contained in:
Jay McCarthy 2012-02-06 09:12:33 -07:00
parent 30239514a3
commit 078540b17c
2 changed files with 16 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
collects/tests/web-server/lang-test.rkt
View File

@ -39,8 +39,20 @@
(let ([f (let ([m 7]) m)]) (let ([f (let ([m 7]) m)])
(+ f initial)))))]) (+ f initial)))))])
(check = 8 (test-m00.4 '(dispatch-start start 1))))) (check = 8 (test-m00.4 '(dispatch-start start 1)))))
(test-case
"set!"
(let-values ([(test-m00.4)
(make-module-eval
(module m00.4 (lib "lang.rkt" "web-server")
(provide start)
(define x 1)
(define (start initial)
(set! x (add1 x))
x)))])
(check = 2 (test-m00.4 '(dispatch-start start #f)))
(check = 3 (test-m00.4 '(dispatch-start start #f)))))
(test-case (test-case
"Embedded Definitions" "Embedded Definitions"
(let-values ([(test-m00.4) (let-values ([(test-m00.4)
@ -589,6 +601,4 @@
(module test (lib "lang.rkt" "web-server") (module test (lib "lang.rkt" "web-server")
(define (show-user) (define (show-user)
(define-values (point i) (values #t 1)) (define-values (point i) (values #t 1))
i))))))) i)))))))))
))

2
collects/web-server/lang/elim-letrec.rkt
View File

@ -25,7 +25,7 @@
(with-syntax ([(be ...) (map (elim-letrec ids) (syntax->list #'(be ...)))]) (with-syntax ([(be ...) (map (elim-letrec ids) (syntax->list #'(be ...)))])
(syntax/loc stx (syntax/loc stx
(begin0 be ...)))] (begin0 be ...)))]
[(set! v ve) [(set! id ve)
(with-syntax ([ve ((elim-letrec ids) #'ve)]) (with-syntax ([ve ((elim-letrec ids) #'ve)])
(if (bound-identifier-member? #'id ids) (if (bound-identifier-member? #'id ids)
(syntax/loc stx (#%plain-app set-box! id ve)) (syntax/loc stx (#%plain-app set-box! id ve))