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

starting to re-enable call/cc tests

Browse Source
This commit is contained in:
Danny Yoo 2011-04-01 23:33:24 -04:00
parent 1f012fb570
commit 868711dae8
2 changed files with 19 additions and 20 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
compile.rkt
View File

@ -877,8 +877,7 @@
`(,(make-PushControlFrame proc-return) `(,(make-PushControlFrame proc-return)
,(make-AssignPrimOpStatement 'val (make-GetCompiledProcedureEntry)) ,(make-AssignPrimOpStatement 'val (make-GetCompiledProcedureEntry))
,(make-GotoStatement entry-point) ,(make-GotoStatement entry-point)
,proc-return ,proc-return)))]
#;,(make-PopEnvironment n 0))))]
[else [else
;; This case happens for evaluating arguments, since the ;; This case happens for evaluating arguments, since the

36
test-compiler.rkt
View File

@ -606,42 +606,42 @@
#;(test '(let ([x 16]) (test '(let ([x 16])
(call/cc (lambda (k) (+ x x)))) (call/cc (lambda (k) (+ x x))))
32 32
#:with-bootstrapping? #t) #:with-bootstrapping? #t)
#;(test '(add1 (let ([x 16]) (test '(add1 (let ([x 16])
(call/cc (lambda (k) (call/cc (lambda (k)
(k 0) (k 0)
(+ x x))))) (+ x x)))))
1 1
#:with-bootstrapping? #t) #:with-bootstrapping? #t)
;; Reference: http://lists.racket-lang.org/users/archive/2009-January/029812.html ;; Reference: http://lists.racket-lang.org/users/archive/2009-January/029812.html
#;(let ([op (open-output-string)]) (let ([op (open-output-string)])
(parameterize ([current-simulated-output-port op]) (parameterize ([current-simulated-output-port op])
(test '(begin (define program (lambda () (test '(begin (define program (lambda ()
(let ((y (call/cc (lambda (c) c)))) (let ((y (call/cc (lambda (c) c))))
(display 1) (display 1)
(call/cc (lambda (c) (y c))) (call/cc (lambda (c) (y c)))
(display 2) (display 2)
(call/cc (lambda (c) (y c))) (call/cc (lambda (c) (y c)))
(display 3)))) (display 3))))
(program)) (program))
(void) (void)
#:with-bootstrapping? #t) #:with-bootstrapping? #t)
(unless (string=? (get-output-string op) (unless (string=? (get-output-string op)
"11213") "11213")
(error "puzzle failed: ~s" (get-output-string op))))) (error "puzzle failed: ~s" (get-output-string op)))))
;; ctak ;; ctak
#;(test '(begin (test '(begin
(define (ctak x y z) (define (ctak x y z)
(call-with-current-continuation (call-with-current-continuation
(lambda (k) (lambda (k)