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

checkpoint delim cont tests

Browse Source 
svn: r4571
This commit is contained in:
Matthew Flatt 2006-10-12 22:17:56 +00:00
parent d09e743d8c
commit 949beaa30f
1 changed files with 36 additions and 25 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

61
collects/tests/mzscheme/prompt.ss
View File

@ -1154,7 +1154,7 @@
;; Check unwinding of runstack overflows on prompt escape ;; Check unwinding of runstack overflows on prompt escape
(let ([try (let ([try
(lambda (thread m-top n-top do-abort) (lambda (thread m-top n-top do-mid-stream do-abort)
(let ([result #f]) (let ([result #f])
(thread-wait (thread-wait
(thread (thread
@ -1163,38 +1163,49 @@
(let pre-loop ([m m-top]) (let pre-loop ([m m-top])
(if (zero? m) (if (zero? m)
(list (list
(call-with-continuation-prompt (do-mid-stream
(lambda () (lambda ()
(let loop ([n n-top]) (call-with-continuation-prompt
(if (zero? n) (lambda ()
(do-abort (let loop ([n n-top])
(lambda () (if (zero? n)
(abort-current-continuation (do-abort
(default-continuation-prompt-tag) (lambda ()
5000))) (abort-current-continuation
(+ (loop (sub1 n)))))))) (default-continuation-prompt-tag)
5000)))
(+ (loop (sub1 n))))))))))
(list (car (pre-loop (sub1 m)))))))))) (list (car (pre-loop (sub1 m))))))))))
(test '(5000) values result)))]) (test '(5000) values result)))])
(try thread 5000 10000 (lambda (abort) (abort))) (try thread 5000 10000 (lambda (mid) (mid)) (lambda (abort) (abort)))
(try thread 5000 10000 (lambda (abort) ((call-with-continuation-prompt (try thread 5000 10000 (lambda (mid) (mid))
(lambda () (lambda (abort) ((call-with-continuation-prompt
((call-with-composable-continuation (lambda ()
(lambda (k) (lambda () k)))))) ((call-with-composable-continuation
(lambda () 5000)))) (lambda (k) (lambda () k))))))
(try thread 5000 10000 (lambda (abort) ((call-with-continuation-prompt (lambda () 5000))))
(lambda () (try thread 5000 10000 (lambda (mid) (mid))
((call/cc (lambda (abort) ((call-with-continuation-prompt
(lambda (k) (lambda () k)))))) (lambda ()
(lambda () 5000)))) ((call/cc
(try thread 5000 10000 (lambda (abort) (((call/cc (lambda (k) (lambda () k))))))
(lambda (k) (lambda () k)))) (lambda () 5000))))
(lambda () (lambda (x) 5000))))) (try thread 5000 10000 (lambda (mid) (mid))
(lambda (abort) (((call/cc
(lambda (k) (lambda () k))))
(lambda () (lambda (x) 5000)))))
(try thread 5000 10000
(lambda (mid) (call-with-continuation-barrier mid))
(lambda (abort) (((call/cc
(lambda (k) (lambda () k))))
(lambda () (lambda (x) 5000)))))
(let ([p (make-continuation-prompt-tag 'p)]) (let ([p (make-continuation-prompt-tag 'p)])
(try (lambda (f) (try (lambda (f)
(thread (thread
(lambda () (lambda ()
(call-with-continuation-prompt f p)))) (call-with-continuation-prompt f p))))
5000 10000 5000 10000
(lambda (mid) (mid))
(lambda (abort) (lambda (abort)
((call/cc ((call/cc
(lambda (k) (lambda (k)